git.iko.soy/Idris-dev
on master help sign in
Fixed and extended C backend integer operations
commitb7a105935c7ac7021d74b8b78c1039374052e945 authorBenjamin Saunders <besaunde@sfu.ca> dateSat 11 May 2013, 17:14 (13 years ago) parent1ce70cc
3 files changed+42−4
compare with master
unifiedsplit
rts/idris_gmp.c+28 rts/idris_gmp.h+2 src/IRTS/CodegenC.hs+12−4
rts/idris_gmp.c+28
@@ -52,6 +52,34 @@ VAL MKBIGMc(VM* vm, void* big) {
5252 return cl;
5353}
5454
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+
5583VAL GETBIG(VM * vm, VAL x) {
5684 if (ISINT(x)) {
5785 mpz_t* bigint;
rts/idris_gmp.h+2
@@ -5,6 +5,8 @@ VAL MKBIGI(int val);
55VAL MKBIGC(VM* vm, char* bigint);
66VAL MKBIGM(VM* vm, void* bigint);
77VAL MKBIGMc(VM* vm, void* bigint);
8+VAL MKBIGUI(VM* vm, unsigned long val);
9+VAL MKBIGSI(VM* vm, signed long val);
810
911VAL idris_bigPlus(VM*, VAL x, VAL y);
1012VAL 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, " ++
252252bitCoerce v op input output arg
253253 = v ++ "idris_b" ++ show (intTyWidth input) ++ op ++ show (intTyWidth output) ++ "(vm, " ++ creg arg ++ ")"
254254
255+signedTy :: IntTy -> String
256+signedTy t = "int" ++ show (intTyWidth t) ++ "_t"
257+
255258doOp v (LPlus ITNative) [l, r] = v ++ "ADD(" ++ creg l ++ ", " ++ creg r ++ ")"
256259doOp v (LMinus ITNative) [l, r] = v ++ "INTOP(-," ++ creg l ++ ", " ++ creg r ++ ")"
257260doOp 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]
335338doOp v (LURem ty) [x, y] = bitOp v "URem" ty [x, y]
336339doOp v (LSRem ty) [x, y] = bitOp v "SRem" ty [x, y]
337340
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) ++ "))"
338344doOp v (LSExt from to) [x]
339345 | 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 ++ ")"
341−doOp v (LZExt IT32 ITNative) [x] = v ++ "idris_castB32Int(vm, " ++ creg x ++ ")"
346+doOp v (LZExt ITNative to) [x] = v ++ "idris_b" ++ show (intTyWidth to) ++ "const(vm, (uintptr_t)GETINT(" ++ 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) ++ ")"
342349doOp v (LZExt from to) [x]
343350 | 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 ++ ")"
345−doOp v (LTrunc IT32 ITNative) [x] = v ++ "idris_castB32Int(vm, " ++ creg x ++ ")"
351+doOp v (LTrunc ITNative to) [x] = v ++ "idris_b" ++ show (intTyWidth to) ++ "const(vm, GETINT(" ++ 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 ++ "))"
346354doOp v (LTrunc from to) [x]
347355 | intTyWidth from > intTyWidth to = bitCoerce v "T" from to x
348356