b7a1059 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Fixed and extended C backend integer operations

b7a1059Benjamin Saunders13 years ago

rts/idris_gmp.c+28

compare with master

unifiedsplit

@@ -52,6 +52,34 @@ VAL MKBIGMc(VM* vm, void* big) {

52 return cl;

53}

55+VAL MKBIGUI(VM* vm, unsigned long val) {

56+ mpz_t* bigint;

57+ VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*) +

58+ sizeof(mpz_t), 0);

59+ bigint = (mpz_t*)(((char*)cl) + sizeof(ClosureType) + sizeof(void*));

60+

61+ mpz_init_set_ui(*bigint, val);

62+

63+ SETTY(cl, BIGINT);

64+ cl -> info.ptr = (void*)bigint;

65+

66+ return cl;

67+}

68+

69+VAL MKBIGSI(VM* vm, signed long val) {

70+ mpz_t* bigint;

71+ VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*) +

72+ sizeof(mpz_t), 0);

73+ bigint = (mpz_t*)(((char*)cl) + sizeof(ClosureType) + sizeof(void*));

74+

75+ mpz_init_set_si(*bigint, val);

76+

77+ SETTY(cl, BIGINT);

78+ cl -> info.ptr = (void*)bigint;

79+

80+ return cl;

81+}

82+

55VAL GETBIG(VM * vm, VAL x) {

83VAL GETBIG(VM * vm, VAL x) {

56 if (ISINT(x)) {

84 if (ISINT(x)) {

57 mpz_t* bigint;

85 mpz_t* bigint;

rts/idris_gmp.h+2

@@ -5,6 +5,8 @@ VAL MKBIGI(int val);

5VAL MKBIGC(VM* vm, char* bigint);

6VAL MKBIGM(VM* vm, void* bigint);

7VAL MKBIGMc(VM* vm, void* bigint);

8+VAL MKBIGUI(VM* vm, unsigned long val);

9+VAL MKBIGSI(VM* vm, signed long val);

9VAL idris_bigPlus(VM*, VAL x, VAL y);

11VAL idris_bigPlus(VM*, VAL x, VAL y);

10VAL idris_bigMinus(VM*, VAL x, VAL y);

12VAL idris_bigMinus(VM*, VAL x, VAL y);

src/IRTS/CodegenC.hs+12−4

@@ -252,6 +252,9 @@ bitOp v op ty args = v ++ "idris_b" ++ show (intTyWidth ty) ++ op ++ "(vm, " ++

252bitCoerce v op input output arg

253 = v ++ "idris_b" ++ show (intTyWidth input) ++ op ++ show (intTyWidth output) ++ "(vm, " ++ creg arg ++ ")"

254

255+signedTy :: IntTy -> String

256+signedTy t = "int" ++ show (intTyWidth t) ++ "_t"

257+

255doOp v (LPlus ITNative) [l, r] = v ++ "ADD(" ++ creg l ++ ", " ++ creg r ++ ")"

258doOp v (LPlus ITNative) [l, r] = v ++ "ADD(" ++ creg l ++ ", " ++ creg r ++ ")"

256doOp v (LMinus ITNative) [l, r] = v ++ "INTOP(-," ++ creg l ++ ", " ++ creg r ++ ")"

259doOp v (LMinus ITNative) [l, r] = v ++ "INTOP(-," ++ creg l ++ ", " ++ creg r ++ ")"

257doOp v (LTimes ITNative) [l, r] = v ++ "MULT(" ++ creg l ++ ", " ++ creg r ++ ")"

260doOp v (LTimes ITNative) [l, r] = v ++ "MULT(" ++ creg l ++ ", " ++ creg r ++ ")"

@@ -335,14 +338,19 @@ doOp v (LSDiv ty) [x, y] = bitOp v "SDiv" ty [x, y]

335doOp v (LURem ty) [x, y] = bitOp v "URem" ty [x, y]

338doOp v (LURem ty) [x, y] = bitOp v "URem" ty [x, y]

336doOp v (LSRem ty) [x, y] = bitOp v "SRem" ty [x, y]

339doOp v (LSRem ty) [x, y] = bitOp v "SRem" ty [x, y]

337

340

341+doOp v (LSExt from ITBig) [x] = v ++ "MKBIGSI(vm, (" ++ signedTy from ++ ")" ++ creg x ++ "->info.bits" ++ show (intTyWidth from) ++ ")"

342+doOp v (LSExt ITNative to) [x] = v ++ "idris_b" ++ show (intTyWidth to) ++ "const(vm, GETINT(" ++ creg x ++ "))"

343+doOp v (LSExt from ITNative) [x] = v ++ "MKINT((i_int)((" ++ signedTy from ++ ")" ++ creg x ++ "->info.bits" ++ show (intTyWidth from) ++ "))"

338doOp v (LSExt from to) [x]

344doOp v (LSExt from to) [x]

339 | intTyWidth from < intTyWidth to = bitCoerce v "S" from to x

345 | intTyWidth from < intTyWidth to = bitCoerce v "S" from to x

340−doOp v (LZExt ITNative to) [x] = v ++ "idris_b" ++ show (intTyWidth to) ++ "(vm, " ++ creg x ++ ")"

346+doOp v (LZExt ITNative to) [x] = v ++ "idris_b" ++ show (intTyWidth to) ++ "const(vm, (uintptr_t)GETINT(" ++ creg x ++ ")"

341−doOp v (LZExt IT32 ITNative) [x] = v ++ "idris_castB32Int(vm, " ++ creg x ++ ")"

347+doOp v (LZExt from ITNative) [x] = v ++ "MKINT((i_int)" ++ creg x ++ "->info.bits" ++ show (intTyWidth from) ++ ")"

348+doOp v (LZExt from ITBig) [x] = v ++ "MKBIGUI(vm, " ++ creg x ++ "->info.bits" ++ show (intTyWidth from) ++ ")"

342doOp v (LZExt from to) [x]

349doOp v (LZExt from to) [x]

343 | intTyWidth from < intTyWidth to = bitCoerce v "Z" from to x

350 | intTyWidth from < intTyWidth to = bitCoerce v "Z" from to x

344−doOp v (LTrunc ITNative to) [x] = v ++ "idris_b" ++ show (intTyWidth to) ++ "(vm, " ++ creg x ++ ")"

351+doOp v (LTrunc ITNative to) [x] = v ++ "idris_b" ++ show (intTyWidth to) ++ "const(vm, GETINT(" ++ creg x ++ "))"

345−doOp v (LTrunc IT32 ITNative) [x] = v ++ "idris_castB32Int(vm, " ++ creg x ++ ")"

352+doOp v (LTrunc from ITNative) [x] = v ++ "MKINT((i_int)" ++ creg x ++ "->info.bits" ++ show (intTyWidth from) ++ ")"

353+doOp v (LTrunc ITBig to) [x] = v ++ "idris_b" ++ show (intTyWidth to) ++ "const(vm, mpz_get_ui(GETMPZ(" ++ creg x ++ "))"

346doOp v (LTrunc from to) [x]

354doOp v (LTrunc from to) [x]

347 | intTyWidth from > intTyWidth to = bitCoerce v "T" from to x

355 | intTyWidth from > intTyWidth to = bitCoerce v "T" from to x

348

356