git.iko.soy/Idris-dev
on master help sign in
Merge pull request #417 from Ralith/bigint-shifts
10c9385Edwin Brady
llvm/defs.c+12
compare with master
unifiedsplit
@@ -146,3 +146,15 @@ void *__idris_gmpRealloc(void *ptr, size_t oldSize, size_t size) {
146void __idris_gmpFree(void *ptr, size_t oldSize) {
146void __idris_gmpFree(void *ptr, size_t oldSize) {
147 GC_free(ptr);
147 GC_free(ptr);
148}
148}
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 =
176 , exfun "__gmpz_init" VoidType [pmpz] False
176 , exfun "__gmpz_init" VoidType [pmpz] False
177 , exfun "__gmpz_init_set_str" (IntegerType 32) [pmpz, ptrI8, IntegerType 32] False
177 , exfun "__gmpz_init_set_str" (IntegerType 32) [pmpz, ptrI8, IntegerType 32] False
178 , exfun "__gmpz_get_str" ptrI8 [ptrI8, IntegerType 32, pmpz] False
178 , exfun "__gmpz_get_str" ptrI8 [ptrI8, IntegerType 32, pmpz] False
179+ , exfun "__gmpz_get_ui" intPtr [pmpz] False
179 , exfun "__gmpz_cmp" (IntegerType 32) [pmpz, pmpz] False
180 , 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
180 , exfun "mpz_get_ull" (IntegerType 64) [pmpz] False
183 , exfun "mpz_get_ull" (IntegerType 64) [pmpz] False
181 , exfun "mpz_init_set_ull" VoidType [pmpz, IntegerType 64] False
184 , exfun "mpz_init_set_ull" VoidType [pmpz, IntegerType 64] False
182 , exfun "mpz_init_set_sll" VoidType [pmpz, IntegerType 64] False
185 , exfun "mpz_init_set_sll" VoidType [pmpz, IntegerType 64] False
@@ -185,6 +188,7 @@ initDefs tgt =
185 , exfun "__idris_gmpMalloc" ptrI8 [intPtr] False
188 , exfun "__idris_gmpMalloc" ptrI8 [intPtr] False
186 , exfun "__idris_gmpRealloc" ptrI8 [ptrI8, intPtr, intPtr] False
189 , exfun "__idris_gmpRealloc" ptrI8 [ptrI8, intPtr, intPtr] False
187 , exfun "__idris_gmpFree" VoidType [ptrI8, intPtr] False
190 , exfun "__idris_gmpFree" VoidType [ptrI8, intPtr] False
191+ , exfun "__idris_strRev" ptrI8 [ptrI8] False
188 , exfun "strtoll" (IntegerType 64) [ptrI8, PointerType ptrI8 (AddrSpace 0), IntegerType 32] False
192 , exfun "strtoll" (IntegerType 64) [ptrI8, PointerType ptrI8 (AddrSpace 0), IntegerType 32] False
189 , exVar (stdinName tgt) ptrI8
193 , exVar (stdinName tgt) ptrI8
190 , exVar (stdoutName tgt) ptrI8
194 , exVar (stdoutName tgt) ptrI8
@@ -867,6 +871,8 @@ cgOp (LAnd ITBig) [x,y] = mpzBin "and" x y
867cgOp (LOr ITBig) [x,y] = mpzBin "ior" x y
871cgOp (LOr ITBig) [x,y] = mpzBin "ior" x y
868cgOp (LXOr ITBig) [x,y] = mpzBin "xor" x y
872cgOp (LXOr ITBig) [x,y] = mpzBin "xor" x y
869cgOp (LCompl ITBig) [x] = mpzUn "com" x
873cgOp (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
870
876
871cgOp (LTrunc ITNative (ITFixed to)) [x]
877cgOp (LTrunc ITNative (ITFixed to)) [x]
872 | 32 >= nativeTyWidth to = iCoerce Trunc IT32 to x
878 | 32 >= nativeTyWidth to = iCoerce Trunc IT32 to x
@@ -1022,6 +1028,10 @@ cgOp LStrLen [s] = do
1022 | x < 32 -> inst $ ZExt len (IntegerType 32) []
1028 | x < 32 -> inst $ ZExt len (IntegerType 32) []
1023 box (FArith (ATInt (ITFixed IT32))) len'
1029 box (FArith (ATInt (ITFixed IT32))) len'
1024
1030
1031+cgOp LStrRev [s] = do
1032+ ns <- unbox FString s
1033+ box FString =<< inst (simpleCall "__idris_strRev" [ns])
1034+
1025cgOp LReadStr [p] = do
1035cgOp LReadStr [p] = do
1026 np <- unbox FPtr p
1036 np <- unbox FPtr p
1027 s <- inst $ simpleCall "__idris_readStr" [np]
1037 s <- inst $ simpleCall "__idris_readStr" [np]
@@ -1106,6 +1116,16 @@ mpzBin name x y = do
1106 inst' $ simpleCall ("__gmpz_" ++ name) [nz, nx, ny]
1116 inst' $ simpleCall ("__gmpz_" ++ name) [nz, nx, ny]
1107 box (FArith (ATInt ITBig)) nz
1117 box (FArith (ATInt ITBig)) nz
1108
1118
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+
1109mpzUn :: String -> Operand -> Codegen Operand
1129mpzUn :: String -> Operand -> Codegen Operand
1110mpzUn name x = do
1130mpzUn name x = do
1111 nx <- unbox (FArith (ATInt ITBig)) x
1131 nx <- unbox (FArith (ATInt ITBig)) x