d52a696 · Idris-dev · git.iko.soy

rts/idris_gmp.c+13

compare with master

unifiedsplit

@@ -488,3 +488,16 @@ VAL idris_castBigStr(VM* vm, VAL i) {

488 return MKSTR(vm, str);

489}

490

491+// Get 64 bits out of a big int with special handling

492+// for systems that have 32-bit longs which needs two limbs to

493+// fill that.

494+uint64_t idris_truncBigB64(const mpz_t bi) {

495+ if (sizeof(mp_limb_t) == 8) {

496+ return mpz_get_ui(bi);

497+ }

498+ int64_t out = mpz_get_ui(bi);

499+ if (bi->_mp_size > 1 ) {

500+ out |= (uint64_t)bi->_mp_d[1] << 32;

501+ }

502+ return out;

503+}

rts/idris_gmp.h+2

@@ -43,6 +43,8 @@ VAL idris_bigOr(VM* vm, VAL x, VAL y);

43VAL idris_bigShiftLeft(VM* vm, VAL x, VAL y);

44VAL idris_bigShiftRight(VM* vm, VAL x, VAL y);

45

46+uint64_t idris_truncBigB64(const mpz_t bi);

47+

46#define GETMPZ(x) *((mpz_t*)((x)->info.ptr))

48#define GETMPZ(x) *((mpz_t*)((x)->info.ptr))

47

49

48#endif

50#endif

src/IRTS/CodegenC.hs+2

@@ -557,6 +557,8 @@ doOp v (LTrunc (ITFixed from) ITNative) [x]

557 = v ++ "MKINT((i_int)" ++ creg x ++ "->info.bits" ++ show (nativeTyWidth from) ++ ")"

558doOp v (LTrunc (ITFixed from) ITChar) [x]

559 = doOp v (LTrunc (ITFixed from) ITNative) [x]

560+doOp v (LTrunc ITBig (ITFixed IT64)) [x]

561+ = v ++ "idris_b64const(vm, ISINT(" ++ creg x ++ ") ? GETINT(" ++ creg x ++ ") : idris_truncBigB64(GETMPZ(" ++ creg x ++ ")))"

560doOp v (LTrunc ITBig (ITFixed to)) [x]

562doOp v (LTrunc ITBig (ITFixed to)) [x]

561 = v ++ "idris_b" ++ show (nativeTyWidth to) ++ "const(vm, ISINT(" ++ creg x ++ ") ? GETINT(" ++ creg x ++ ") : mpz_get_ui(GETMPZ(" ++ creg x ++ ")))"

563 = v ++ "idris_b" ++ show (nativeTyWidth to) ++ "const(vm, ISINT(" ++ creg x ++ ") ? GETINT(" ++ creg x ++ ") : mpz_get_ui(GETMPZ(" ++ creg x ++ ")))"

562doOp v (LTrunc (ITFixed from) (ITFixed to)) [x]

564doOp v (LTrunc (ITFixed from) (ITFixed to)) [x]