git.iko.soy/Idris-dev
on master help sign in
Fix comparison return values and implement Integer truncation
commit25d1e1f5205d3462df46338b428f227b65872c5b authorBenjamin Saunders <besaunde@sfu.ca> dateTue 25 Jun 2013, 20:03 (13 years ago) parent114221a
2 files changed+46−8
compare with master
unifiedsplit
llvm/defs.c+25 src/IRTS/CodegenLLVM.hs+21−8
llvm/defs.c+25
@@ -1,5 +1,30 @@
11#include <stdio.h>
2+#include <gmp.h>
23
34void putStr(const char *str) {
45 fputs(str, stdout);
56}
7+
8+void mpz_set_ull(mpz_t n, unsigned long long ull)
9+{
10+ mpz_set_ui(n, (unsigned int)(ull >> 32)); /* n = (unsigned int)(ull >> 32) */
11+ mpz_mul_2exp(n, n, 32); /* n <<= 32 */
12+ mpz_add_ui(n, n, (unsigned int)ull); /* n += (unsigned int)ull */
13+}
14+
15+unsigned long long mpz_get_ull(mpz_t n)
16+{
17+ unsigned int lo, hi;
18+ mpz_t tmp;
19+
20+ mpz_init( tmp );
21+ mpz_mod_2exp( tmp, n, 64 ); /* tmp = (lower 64 bits of n) */
22+
23+ lo = mpz_get_ui( tmp ); /* lo = tmp & 0xffffffff */
24+ mpz_div_2exp( tmp, tmp, 32 ); /* tmp >>= 32 */
25+ hi = mpz_get_ui( tmp ); /* hi = tmp & 0xffffffff */
26+
27+ mpz_clear( tmp );
28+
29+ return (((unsigned long long)hi) << 32) + lo;
30+}
src/IRTS/CodegenLLVM.hs+21−8
@@ -52,6 +52,10 @@ codegenLLVM defs file outty = withContext $ \context -> do
5252 Right _ -> return ()
5353 Left msg -> ierror msg
5454
55+itWidth :: IntTy -> Word32
56+itWidth ITNative = 32
57+itWidth x = fromIntegral $ intTyWidth x
58+
5559outputModule :: FilePath -> OutputType -> M.Module -> IO ()
5660outputModule file Raw m = M.writeBitcodeToFile file m
5761outputModule file Object m = withTmpFile $ \bc -> do
@@ -135,6 +139,7 @@ initDefs tgt =
135139 , exfun "__gmpz_init_set_str" (IntegerType 32) [pmpz, ptrI8, IntegerType 32] False
136140 , exfun "__gmpz_get_str" ptrI8 [ptrI8, IntegerType 32, pmpz] False
137141 , exfun "__gmpz_cmp" (IntegerType 32) [pmpz, pmpz] False
142+ , exfun "mpz_get_ull" (IntegerType 64) [pmpz] False
138143 , GlobalDefinition mainDef
139144 ] ++ map mpzBinFun ["add", "sub", "mul", "fdiv_q", "fdiv_r", "and", "ior", "xor"]
140145 where
@@ -318,15 +323,15 @@ alloc ty = do
318323sizeOf :: Type -> Codegen Operand
319324sizeOf ty = ConstantOperand . C.PtrToInt
320325 (C.GetElementPtr True (C.Null (PointerType ty (AddrSpace 0))) [C.Int 32 1])
321− . IntegerType . fromIntegral <$> wordSize
326+ . IntegerType . fromIntegral <$> getWordSize
322327
323328tgtWordSize :: String -> Integer
324329tgtWordSize tgt = case tgt of
325330 "x86_64" -> 64
326331 "i386" -> 32
327332
328−wordSize :: Codegen Integer
329−wordSize = tgtWordSize <$> asks target
333+getWordSize :: Codegen Integer
334+getWordSize = tgtWordSize <$> asks target
330335
331336cgExpr :: SExp -> Codegen (Maybe Operand)
332337cgExpr (SV v) = var v
@@ -706,7 +711,7 @@ ffunDecl name rty argtys =
706711ftyToTy :: FType -> Type
707712ftyToTy (FInt ITNative) = IntegerType 32
708713ftyToTy (FInt ITBig) = PointerType mpzTy (AddrSpace 0)
709−ftyToTy (FInt ty) = IntegerType (fromIntegral (intTyWidth ty))
714+ftyToTy (FInt ty) = IntegerType (fromIntegral (itWidth ty))
710715ftyToTy FChar = IntegerType 32
711716ftyToTy FString = PointerType (IntegerType 8) (AddrSpace 0)
712717ftyToTy FUnit = VoidType
@@ -715,6 +720,14 @@ ftyToTy FDouble = FloatingPointType 64 IEEE
715720ftyToTy FAny = valueType
716721
717722cgOp :: PrimFn -> [Operand] -> Codegen Operand
723+cgOp (LTrunc ITBig ity) [x] = do
724+ nx <- unbox (FInt ITBig) x
725+ val <- inst $ simpleCall "mpz_get_ull" [nx]
726+ v <- case ity of
727+ IT64 -> return val
728+ _ -> inst $ Trunc val (IntegerType . fromIntegral $ itWidth ity) []
729+ box (FInt ity) v
730+
718731cgOp (LLt ITBig) [x,y] = mpzCmp IPred.SLT x y
719732cgOp (LLe ITBig) [x,y] = mpzCmp IPred.SLE x y
720733cgOp (LEq ITBig) [x,y] = mpzCmp IPred.EQ x y
@@ -763,7 +776,7 @@ cgOp (LIntStr ITBig) [x] = do
763776 box FString ustr
764777cgOp (LIntStr ity) [x] = do
765778 x' <- unbox (FInt ity) x
766− x'' <- if ity == ITNative || intTyWidth ity < 64
779+ x'' <- if itWidth ity < 64
767780 then inst $ SExt x' (IntegerType 64) []
768781 else return x'
769782 box FString =<< inst (idrCall "__idris_intStr" [x''])
@@ -779,7 +792,7 @@ cgStrCat x y = do
779792 xlen <- inst $ simpleCall "strlen" [x']
780793 ylen <- inst $ simpleCall "strlen" [y']
781794 zlen <- inst $ Add False True xlen ylen []
782− ws <- fromIntegral <$> wordSize
795+ ws <- fromIntegral <$> getWordSize
783796 total <- inst $ Add False True zlen (ConstantOperand (C.Int ws 1)) []
784797 mem <- allocAtomic total
785798 inst $ simpleCall "memcpy" [mem, x', xlen]
@@ -806,8 +819,8 @@ iCmp ity pred x y = do
806819 nx <- unbox (FInt ity) x
807820 ny <- unbox (FInt ity) y
808821 nr <- inst $ ICmp pred nx ny []
809− nr' <- inst $ ZExt nr (IntegerType . fromIntegral $ intTyWidth ity) []
810− box (FInt ity) nr'
822+ nr' <- inst $ ZExt nr (IntegerType 32) []
823+ box (FInt IT32) nr'
811824
812825mpzBin :: String -> Operand -> Operand -> Codegen Operand
813826mpzBin name x y = do