git.iko.soy/Idris-dev
on master help sign in
Left and arithmetic right shifts on big integers under LLVM codegen
a4325c0Benjamin Saunders
src/IRTS/CodegenLLVM.hs+15
compare with master
unifiedsplit
@@ -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
@@ -867,6 +870,8 @@ cgOp (LAnd ITBig) [x,y] = mpzBin "and" x y
867cgOp (LOr ITBig) [x,y] = mpzBin "ior" x y
870cgOp (LOr ITBig) [x,y] = mpzBin "ior" x y
868cgOp (LXOr ITBig) [x,y] = mpzBin "xor" x y
871cgOp (LXOr ITBig) [x,y] = mpzBin "xor" x y
869cgOp (LCompl ITBig) [x] = mpzUn "com" x
872cgOp (LCompl ITBig) [x] = mpzUn "com" x
873+cgOp (LSHL ITBig) [x,y] = mpzBit "mul_2exp" x y
874+cgOp (LASHR ITBig) [x,y] = mpzBit "fdiv_q_2exp" x y
870
875
871cgOp (LTrunc ITNative (ITFixed to)) [x]
876cgOp (LTrunc ITNative (ITFixed to)) [x]
872 | 32 >= nativeTyWidth to = iCoerce Trunc IT32 to x
877 | 32 >= nativeTyWidth to = iCoerce Trunc IT32 to x
@@ -1106,6 +1111,16 @@ mpzBin name x y = do
1106 inst' $ simpleCall ("__gmpz_" ++ name) [nz, nx, ny]
1111 inst' $ simpleCall ("__gmpz_" ++ name) [nz, nx, ny]
1107 box (FArith (ATInt ITBig)) nz
1112 box (FArith (ATInt ITBig)) nz
1108
1113
1114+mpzBit :: String -> Operand -> Operand -> Codegen Operand
1115+mpzBit name x y = do
1116+ nx <- unbox (FArith (ATInt ITBig)) x
1117+ ny <- unbox (FArith (ATInt ITBig)) y
1118+ bitcnt <- inst $ simpleCall "__gmpz_get_ui" [ny]
1119+ nz <- alloc mpzTy
1120+ inst' $ simpleCall "__gmpz_init" [nz]
1121+ inst' $ simpleCall ("__gmpz_" ++ name) [nz, nx, bitcnt]
1122+ box (FArith (ATInt ITBig)) nz
1123+
1109mpzUn :: String -> Operand -> Codegen Operand
1124mpzUn :: String -> Operand -> Codegen Operand
1110mpzUn name x = do
1125mpzUn name x = do
1111 nx <- unbox (FArith (ATInt ITBig)) x
1126 nx <- unbox (FArith (ATInt ITBig)) x