git.iko.soy/Idris-dev
on master help sign in
Merge pull request #417 from Ralith/bigint-shifts

Left and arithmetic right shifts on big integers under LLVM codegen

commit10c938524075e510c9343c1920cc8973c569a926 authorEdwin Brady <edwin.brady@gmail.com> dateThu 25 Jul 2013, 03:27 (13 years ago) parent229070cdd51bf7
2 files changed+32
compare with master
unifiedsplit
llvm/defs.c+12 src/IRTS/CodegenLLVM.hs+20
llvm/defs.c+12
@@ -146,3 +146,15 @@ void *__idris_gmpRealloc(void *ptr, size_t oldSize, size_t size) {
146146void __idris_gmpFree(void *ptr, size_t oldSize) {
147147 GC_free(ptr);
148148}
149+
150+char *__idris_strRev(const char *s) {
151+ int x = strlen(s);
152+ int y = 0;
153+ char *t = GC_malloc(x+1);
154+
155+ t[x] = '\0';
156+ while(x>0) {
157+ t[y++] = s[--x];
158+ }
159+ return t;
160+}
src/IRTS/CodegenLLVM.hs+20
@@ -176,7 +176,10 @@ initDefs tgt =
176176 , exfun "__gmpz_init" VoidType [pmpz] False
177177 , exfun "__gmpz_init_set_str" (IntegerType 32) [pmpz, ptrI8, IntegerType 32] False
178178 , exfun "__gmpz_get_str" ptrI8 [ptrI8, IntegerType 32, pmpz] False
179+ , exfun "__gmpz_get_ui" intPtr [pmpz] False
179180 , exfun "__gmpz_cmp" (IntegerType 32) [pmpz, pmpz] False
181+ , exfun "__gmpz_fdiv_q_2exp" VoidType [pmpz, pmpz, intPtr] False
182+ , exfun "__gmpz_mul_2exp" VoidType [pmpz, pmpz, intPtr] False
180183 , exfun "mpz_get_ull" (IntegerType 64) [pmpz] False
181184 , exfun "mpz_init_set_ull" VoidType [pmpz, IntegerType 64] False
182185 , exfun "mpz_init_set_sll" VoidType [pmpz, IntegerType 64] False
@@ -185,6 +188,7 @@ initDefs tgt =
185188 , exfun "__idris_gmpMalloc" ptrI8 [intPtr] False
186189 , exfun "__idris_gmpRealloc" ptrI8 [ptrI8, intPtr, intPtr] False
187190 , exfun "__idris_gmpFree" VoidType [ptrI8, intPtr] False
191+ , exfun "__idris_strRev" ptrI8 [ptrI8] False
188192 , exfun "strtoll" (IntegerType 64) [ptrI8, PointerType ptrI8 (AddrSpace 0), IntegerType 32] False
189193 , exVar (stdinName tgt) ptrI8
190194 , exVar (stdoutName tgt) ptrI8
@@ -867,6 +871,8 @@ cgOp (LAnd ITBig) [x,y] = mpzBin "and" x y
867871cgOp (LOr ITBig) [x,y] = mpzBin "ior" x y
868872cgOp (LXOr ITBig) [x,y] = mpzBin "xor" x y
869873cgOp (LCompl ITBig) [x] = mpzUn "com" x
874+cgOp (LSHL ITBig) [x,y] = mpzBit "mul_2exp" x y
875+cgOp (LASHR ITBig) [x,y] = mpzBit "fdiv_q_2exp" x y
870876
871877cgOp (LTrunc ITNative (ITFixed to)) [x]
872878 | 32 >= nativeTyWidth to = iCoerce Trunc IT32 to x
@@ -1022,6 +1028,10 @@ cgOp LStrLen [s] = do
10221028 | x < 32 -> inst $ ZExt len (IntegerType 32) []
10231029 box (FArith (ATInt (ITFixed IT32))) len'
10241030
1031+cgOp LStrRev [s] = do
1032+ ns <- unbox FString s
1033+ box FString =<< inst (simpleCall "__idris_strRev" [ns])
1034+
10251035cgOp LReadStr [p] = do
10261036 np <- unbox FPtr p
10271037 s <- inst $ simpleCall "__idris_readStr" [np]
@@ -1106,6 +1116,16 @@ mpzBin name x y = do
11061116 inst' $ simpleCall ("__gmpz_" ++ name) [nz, nx, ny]
11071117 box (FArith (ATInt ITBig)) nz
11081118
1119+mpzBit :: String -> Operand -> Operand -> Codegen Operand
1120+mpzBit name x y = do
1121+ nx <- unbox (FArith (ATInt ITBig)) x
1122+ ny <- unbox (FArith (ATInt ITBig)) y
1123+ bitcnt <- inst $ simpleCall "__gmpz_get_ui" [ny]
1124+ nz <- alloc mpzTy
1125+ inst' $ simpleCall "__gmpz_init" [nz]
1126+ inst' $ simpleCall ("__gmpz_" ++ name) [nz, nx, bitcnt]
1127+ box (FArith (ATInt ITBig)) nz
1128+
11091129mpzUn :: String -> Operand -> Codegen Operand
11101130mpzUn name x = do
11111131 nx <- unbox (FArith (ATInt ITBig)) x