git.iko.soy/Idris-dev
on master help sign in
Add floating point primitives to LLVM backend
17de459Markus Pfeiffer
src/IRTS/CodegenLLVM.hs+123−24
compare with master
unifiedsplit
@@ -22,6 +22,7 @@ import LLVM.General.AST.DataLayout
22import qualified LLVM.General.PassManager as PM
22import qualified LLVM.General.PassManager as PM
23import qualified LLVM.General.Module as MO
23import qualified LLVM.General.Module as MO
24import qualified LLVM.General.AST.IntegerPredicate as IPred
24import qualified LLVM.General.AST.IntegerPredicate as IPred
25+import qualified LLVM.General.AST.FloatingPointPredicate as FPred
25import qualified LLVM.General.AST.Linkage as L
26import qualified LLVM.General.AST.Linkage as L
26import qualified LLVM.General.AST.Visibility as V
27import qualified LLVM.General.AST.Visibility as V
27import qualified LLVM.General.AST.CallingConvention as CC
28import qualified LLVM.General.AST.CallingConvention as CC
@@ -165,6 +166,38 @@ initDefs tgt =
165 ]
166 ]
166 (Do $ Ret (Just (LocalReference (UnName 1))) [])
167 (Do $ Ret (Just (LocalReference (UnName 1))) [])
167 ]
168 ]
169+ , GlobalDefinition $ globalVariableDefaults
170+ { G.name = Name "__idris_floatFmtStr"
171+ , G.linkage = L.Internal
172+ , G.isConstant = True
173+ , G.hasUnnamedAddr = True
174+ , G.type' = ArrayType 5 (IntegerType 8)
175+ , G.initializer = Just $ C.Array (IntegerType 8) (map (C.Int 8 . fromIntegral . fromEnum) "%g" ++ [C.Int 8 0])
176+ }
177+ , rtsFun "floatStr" ptrI8 [FloatingPointType 64 IEEE]
178+ [ BasicBlock (UnName 0)
179+ [ UnName 1 := simpleCall "GC_malloc_atomic" [ConstantOperand (C.Int (tgtWordSize tgt) 21)]
180+ , UnName 2 := simpleCall "snprintf"
181+ [ LocalReference (UnName 1)
182+ , ConstantOperand (C.Int (tgtWordSize tgt) 21)
183+ , ConstantOperand $ C.GetElementPtr True (C.GlobalReference . Name $ "__idris_floatFmtStr") [C.Int 32 0, C.Int 32 0]
184+ , LocalReference (UnName 0)
185+ ]
186+ ]
187+ (Do $ Ret (Just (LocalReference (UnName 1))) [])
188+ ]
189+ , exfun "llvm.sin.f64" (FloatingPointType 64 IEEE) [ FloatingPointType 64 IEEE ] False
190+ , exfun "llvm.cos.f64" (FloatingPointType 64 IEEE) [ FloatingPointType 64 IEEE ] False
191+ , exfun "llvm.pow.f64" (FloatingPointType 64 IEEE) [ FloatingPointType 64 IEEE ] False
192+ , exfun "llvm.ceil.f64" (FloatingPointType 64 IEEE) [ FloatingPointType 64 IEEE ] False
193+ , exfun "llvm.floor.f64" (FloatingPointType 64 IEEE) [ FloatingPointType 64 IEEE ] False
194+ , exfun "llvm.exp.f64" (FloatingPointType 64 IEEE) [ FloatingPointType 64 IEEE ] False
195+ , exfun "llvm.log.f64" (FloatingPointType 64 IEEE) [ FloatingPointType 64 IEEE ] False
196+ , exfun "llvm.sqrt.f64" (FloatingPointType 64 IEEE) [ FloatingPointType 64 IEEE ] False
197+ , exfun "tan" (FloatingPointType 64 IEEE) [ FloatingPointType 64 IEEE ] False
198+ , exfun "asin" (FloatingPointType 64 IEEE) [ FloatingPointType 64 IEEE ] False
199+ , exfun "acos" (FloatingPointType 64 IEEE) [ FloatingPointType 64 IEEE ] False
200+ , exfun "atan" (FloatingPointType 64 IEEE) [ FloatingPointType 64 IEEE ] False
168 , exfun "llvm.trap" VoidType [] False
201 , exfun "llvm.trap" VoidType [] False
169 -- , exfun "llvm.llvm.memcpy.p0i8.p0i8.i32" VoidType [ptrI8, ptrI8, IntegerType 32, IntegerType 32, IntegerType 1] False
202 -- , exfun "llvm.llvm.memcpy.p0i8.p0i8.i32" VoidType [ptrI8, ptrI8, IntegerType 32, IntegerType 32, IntegerType 1] False
170 -- , exfun "llvm.llvm.memcpy.p0i8.p0i8.i64" VoidType [ptrI8, ptrI8, IntegerType 64, IntegerType 32, IntegerType 1] False
203 -- , exfun "llvm.llvm.memcpy.p0i8.p0i8.i64" VoidType [ptrI8, ptrI8, IntegerType 64, IntegerType 32, IntegerType 1] False
@@ -188,6 +221,8 @@ initDefs tgt =
188 , exfun "__gmpz_cmp" (IntegerType 32) [pmpz, pmpz] False
221 , exfun "__gmpz_cmp" (IntegerType 32) [pmpz, pmpz] False
189 , exfun "__gmpz_fdiv_q_2exp" VoidType [pmpz, pmpz, intPtr] False
222 , exfun "__gmpz_fdiv_q_2exp" VoidType [pmpz, pmpz, intPtr] False
190 , exfun "__gmpz_mul_2exp" VoidType [pmpz, pmpz, intPtr] False
223 , exfun "__gmpz_mul_2exp" VoidType [pmpz, pmpz, intPtr] False
224+ , exfun "__gmpz_get_d" (FloatingPointType 64 IEEE) [pmpz] False
225+ , exfun "__gmpz_set_d" VoidType [pmpz, FloatingPointType 64 IEEE] False
191 , exfun "mpz_get_ull" (IntegerType 64) [pmpz] False
226 , exfun "mpz_get_ull" (IntegerType 64) [pmpz] False
192 , exfun "mpz_init_set_ull" VoidType [pmpz, IntegerType 64] False
227 , exfun "mpz_init_set_ull" VoidType [pmpz, IntegerType 64] False
193 , exfun "mpz_init_set_sll" VoidType [pmpz, IntegerType 64] False
228 , exfun "mpz_init_set_sll" VoidType [pmpz, IntegerType 64] False
@@ -843,10 +878,10 @@ ftyToTy (FArith (ATInt (ITFixed ty))) = IntegerType (fromIntegral $ nativeTyWidt
843ftyToTy (FArith (ATInt (ITVec e c)))
878ftyToTy (FArith (ATInt (ITVec e c)))
844 = VectorType (fromIntegral c) (IntegerType (fromIntegral $ nativeTyWidth e))
879 = VectorType (fromIntegral c) (IntegerType (fromIntegral $ nativeTyWidth e))
845ftyToTy (FArith (ATInt ITChar)) = IntegerType 32
880ftyToTy (FArith (ATInt ITChar)) = IntegerType 32
881+ftyToTy (FArith ATFloat) = FloatingPointType 64 IEEE
846ftyToTy FString = PointerType (IntegerType 8) (AddrSpace 0)
882ftyToTy FString = PointerType (IntegerType 8) (AddrSpace 0)
847ftyToTy FUnit = VoidType
883ftyToTy FUnit = VoidType
848ftyToTy FPtr = PointerType (IntegerType 8) (AddrSpace 0)
884ftyToTy FPtr = PointerType (IntegerType 8) (AddrSpace 0)
849−ftyToTy (FArith ATFloat) = FloatingPointType 64 IEEE
850ftyToTy FAny = valueType
885ftyToTy FAny = valueType
851
886
852-- Only use when known not to be ITBig
887-- Only use when known not to be ITBig
@@ -938,20 +973,69 @@ cgOp (LSGe (ATInt ity)) [x,y] = iCmp ity IPred.SGE x y
938cgOp (LSGt (ATInt ity)) [x,y] = iCmp ity IPred.SGT x y
973cgOp (LSGt (ATInt ity)) [x,y] = iCmp ity IPred.SGT x y
939cgOp (LGe ity) [x,y] = iCmp ity IPred.UGE x y
974cgOp (LGe ity) [x,y] = iCmp ity IPred.UGE x y
940cgOp (LGt ity) [x,y] = iCmp ity IPred.UGT x y
975cgOp (LGt ity) [x,y] = iCmp ity IPred.UGT x y
941−cgOp (LPlus (ATInt ity)) [x,y] = ibin ity x y (Add False False)
976+cgOp (LPlus ty@(ATInt _)) [x,y] = binary ty x y (Add False False)
942−cgOp (LMinus (ATInt ity)) [x,y] = ibin ity x y (Sub False False)
977+cgOp (LMinus ty@(ATInt _)) [x,y] = binary ty x y (Sub False False)
943−cgOp (LTimes (ATInt ity)) [x,y] = ibin ity x y (Mul False False)
978+cgOp (LTimes ty@(ATInt _)) [x,y] = binary ty x y (Mul False False)
944−cgOp (LSDiv (ATInt ity)) [x,y] = ibin ity x y (SDiv False)
979+cgOp (LSDiv ty@(ATInt _)) [x,y] = binary ty x y (SDiv False)
945−cgOp (LSRem (ATInt ity)) [x,y] = ibin ity x y SRem
980+cgOp (LSRem ty@(ATInt _)) [x,y] = binary ty x y SRem
946−cgOp (LUDiv ity) [x,y] = ibin ity x y (UDiv False)
981+cgOp (LUDiv ity) [x,y] = binary (ATInt ity) x y (UDiv False)
947−cgOp (LURem ity) [x,y] = ibin ity x y URem
982+cgOp (LURem ity) [x,y] = binary (ATInt ity) x y URem
948−cgOp (LAnd ity) [x,y] = ibin ity x y And
983+cgOp (LAnd ity) [x,y] = binary (ATInt ity) x y And
949−cgOp (LOr ity) [x,y] = ibin ity x y Or
984+cgOp (LOr ity) [x,y] = binary (ATInt ity) x y Or
950−cgOp (LXOr ity) [x,y] = ibin ity x y Xor
985+cgOp (LXOr ity) [x,y] = binary (ATInt ity) x y Xor
951−cgOp (LCompl ity) [x] = iun ity x (Xor . ConstantOperand $ itConst ity (-1))
986+cgOp (LCompl ity) [x] = unary (ATInt ity) x (Xor . ConstantOperand $ itConst ity (-1))
952−cgOp (LSHL ity) [x,y] = ibin ity x y (Shl False False)
987+cgOp (LSHL ity) [x,y] = binary (ATInt ity) x y (Shl False False)
953−cgOp (LLSHR ity) [x,y] = ibin ity x y (LShr False)
988+cgOp (LLSHR ity) [x,y] = binary (ATInt ity) x y (LShr False)
954−cgOp (LASHR ity) [x,y] = ibin ity x y (AShr False)
989+cgOp (LASHR ity) [x,y] = binary (ATInt ity) x y (AShr False)
990+
991+cgOp (LSLt ATFloat) [x,y] = fCmp FPred.OLT x y
992+cgOp (LSLe ATFloat) [x,y] = fCmp FPred.OLE x y
993+cgOp (LEq ATFloat) [x,y] = fCmp FPred.OEQ x y
994+cgOp (LSGe ATFloat) [x,y] = fCmp FPred.OGE x y
995+cgOp (LSGt ATFloat) [x,y] = fCmp FPred.OGT x y
996+cgOp (LPlus ATFloat) [x,y] = binary ATFloat x y FAdd
997+cgOp (LMinus ATFloat) [x,y] = binary ATFloat x y FSub
998+cgOp (LTimes ATFloat) [x,y] = binary ATFloat x y FMul
999+cgOp (LSDiv ATFloat) [x,y] = binary ATFloat x y FDiv
1000+
1001+cgOp LFExp [x] = nunary ATFloat "llvm.exp.f64" x
1002+cgOp LFLog [x] = nunary ATFloat "llvm.log.f64" x
1003+cgOp LFSin [x] = nunary ATFloat "llvm.sin.f64" x
1004+cgOp LFCos [x] = nunary ATFloat "llvm.cos.f64" x
1005+cgOp LFTan [x] = nunary ATFloat "tan" x
1006+cgOp LFASin [x] = nunary ATFloat "asin" x
1007+cgOp LFACos [x] = nunary ATFloat "acos" x
1008+cgOp LFATan [x] = nunary ATFloat "atan" x
1009+cgOp LFSqrt [x] = nunary ATFloat "llvm.sqrt.f64" x
1010+cgOp LFFloor [x] = nunary ATFloat "llvm.floor.f64" x
1011+cgOp LFCeil [x] = nunary ATFloat "llvm.ceil.f64" x
1012+
1013+cgOp (LIntFloat ITBig) [x] = do
1014+ x' <- unbox (FArith (ATInt ITBig)) x
1015+ uflt <- inst $ simpleCall "__gmpz_get_d" [ x' ]
1016+ box (FArith ATFloat) uflt
1017+
1018+cgOp (LIntFloat ity) [x] = do
1019+ x' <- unbox (FArith (ATInt ity)) x
1020+ x'' <- inst $ SIToFP x' (FloatingPointType 64 IEEE) []
1021+ box (FArith ATFloat) x''
1022+
1023+cgOp (LFloatInt ITBig) [x] = do
1024+ x' <- unbox (FArith ATFloat) x
1025+ z <- alloc mpzTy
1026+ inst' $ simpleCall "__gmpz_init" [z]
1027+ inst' $ simpleCall "__gmpz_set_d" [ z, x' ]
1028+ box (FArith (ATInt ITBig)) z
1029+
1030+cgOp (LFloatInt ity) [x] = do
1031+ x' <- unbox (FArith ATFloat) x
1032+ x'' <- inst $ FPToSI x' (ftyToTy $ cmpResultTy ity) []
1033+ box (FArith (ATInt ity)) x''
1034+
1035+cgOp LFloatStr [x] = do
1036+ x' <- unbox (FArith ATFloat) x
1037+ ustr <- inst (idrCall "__idris_floatStr" [x'])
1038+ box FString ustr
955
1039
956cgOp LNoOp xs = return $ last xs
1040cgOp LNoOp xs = return $ last xs
957
1041
@@ -1119,19 +1203,27 @@ cgStrCat x y = do
1119 inst' $ Store False end (ConstantOperand (C.Int 8 0)) Nothing 0 []
1203 inst' $ Store False end (ConstantOperand (C.Int 8 0)) Nothing 0 []
1120 box FString mem
1204 box FString mem
1121
1205
1122−ibin :: IntTy -> Operand -> Operand
1206+binary :: ArithTy -> Operand -> Operand
1123 -> (Operand -> Operand -> InstructionMetadata -> Instruction) -> Codegen Operand
1207 -> (Operand -> Operand -> InstructionMetadata -> Instruction) -> Codegen Operand
1124−ibin ity x y instCon = do
1208+binary ty x y instCon = do
1125− nx <- unbox (FArith (ATInt ity)) x
1209+ nx <- unbox (FArith ty) x
1126− ny <- unbox (FArith (ATInt ity)) y
1210+ ny <- unbox (FArith ty) y
1127 nr <- inst $ instCon nx ny []
1211 nr <- inst $ instCon nx ny []
1128− box (FArith (ATInt ity)) nr
1212+ box (FArith ty) nr
1129
1213
1214+unary :: ArithTy -> Operand
1130−iun :: IntTy -> Operand -> (Operand -> InstructionMetadata -> Instruction) -> Codegen Operand
1215+ -> (Operand -> InstructionMetadata -> Instruction) -> Codegen Operand
1131−iun ity x instCon = do
1216+unary ty x instCon = do
1132− nx <- unbox (FArith (ATInt ity)) x
1217+ nx <- unbox (FArith ty) x
1133 nr <- inst $ instCon nx []
1218 nr <- inst $ instCon nx []
1134− box (FArith (ATInt ity)) nr
1219+ box (FArith ty) nr
1220+
1221+nunary :: ArithTy -> String
1222+ -> Operand -> Codegen Operand
1223+nunary ty name x = do
1224+ nx <- unbox (FArith ty) x
1225+ nr <- inst $ simpleCall name [nx]
1226+ box (FArith ty) nr
1135
1227
1136iCmp :: IntTy -> IPred.IntegerPredicate -> Operand -> Operand -> Codegen Operand
1228iCmp :: IntTy -> IPred.IntegerPredicate -> Operand -> Operand -> Codegen Operand
1137iCmp ity pred x y = do
1229iCmp ity pred x y = do
@@ -1141,6 +1233,13 @@ iCmp ity pred x y = do
1141 nr' <- inst $ SExt nr (ftyToTy $ cmpResultTy ity) []
1233 nr' <- inst $ SExt nr (ftyToTy $ cmpResultTy ity) []
1142 box (cmpResultTy ity) nr'
1234 box (cmpResultTy ity) nr'
1143
1235
1236+fCmp :: FPred.FloatingPointPredicate -> Operand -> Operand -> Codegen Operand
1237+fCmp pred x y = do
1238+ nx <- unbox (FArith ATFloat) x
1239+ ny <- unbox (FArith ATFloat) y
1240+ nr <- inst $ FCmp pred nx ny []
1241+ box (FArith (ATInt (ITFixed IT32))) nr
1242+
1144cmpResultTy :: IntTy -> FType
1243cmpResultTy :: IntTy -> FType
1145cmpResultTy v@(ITVec _ _) = FArith (ATInt v)
1244cmpResultTy v@(ITVec _ _) = FArith (ATInt v)
1146cmpResultTy _ = FArith (ATInt (ITFixed IT32))
1245cmpResultTy _ = FArith (ATInt (ITFixed IT32))
test/Makefile+1
@@ -93,6 +93,7 @@ test_llvm:
93 @perl ./runtest.pl test029 --codegen llvm
93 @perl ./runtest.pl test029 --codegen llvm
94 @perl ./runtest.pl test030 --codegen llvm
94 @perl ./runtest.pl test030 --codegen llvm
95 @perl ./runtest.pl test031 --codegen llvm
95 @perl ./runtest.pl test031 --codegen llvm
96+ @perl ./runtest.pl test034 --codegen llvm
96
97
97update:
98update:
98 /usr/bin/env perl ./runtest.pl all -u
99 /usr/bin/env perl ./runtest.pl all -u
test/README+1
@@ -33,6 +33,7 @@ Tests:
33031: error reflection
33031: error reflection
34032: control idris via stdin
34032: control idris via stdin
35033: null pointer creation and check
35033: null pointer creation and check
36+034: presence of floating point primitives in backends
36
37
37regxxx: various regression tests
38regxxx: various regression tests
38reg020: working strlen
39reg020: working strlen
test/test034/expectednew file+44
@@ -0,0 +1,44 @@
1+prim__floatToStr 0.0
2+0.0
3+prim__strToFloat "0.0"
4+0.0
5+prim__addFloat 1.0 1.0
6+2.0
7+prim__subFloat 1.0 1.0
8+0.0
9+prim__mulFloat 1.0 1.0
10+1.0
11+prim__divFloat 1.0 1.0
12+1.0
13+prim__slteFloat 1.0 1.0
14+1
15+prim__sltFloat 1.0 1.0
16+0
17+prim__sgteFloat 1.0 1.0
18+1
19+prim__sgtFloat 1.0 1.0
20+0
21+prim__eqFloat 1.0 1.0
22+1
23+prim__floatACos 1.0
24+0.0
25+prim__floatATan 1.0
26+0.7853981633974483
27+prim__floatCos 1.0
28+0.5403023058681398
29+prim__floatFloor 1.0
30+1.0
31+prim__floatSin 1.0
32+0.8414709848078965
33+prim__floatTan 1.0
34+1.5574077246549023
35+prim__floatASin 1.0
36+1.5707963267948966
37+prim__floatCeil 1.0
38+1.0
39+prim__floatExp 1.0
40+2.718281828459045
41+prim__floatLog 1.0
42+0.0
43+prim__floatSqrt 1.0
44+1.0
test/test034/runnew file+49
@@ -0,0 +1,49 @@
1+#!/usr/bin/env bash
2+
3+HEAD="module Main
4+
5+import Data.Float
6+
7+main : IO ()"
8+
9+TESTS=("prim__floatToStr 0.0"
10+"prim__strToFloat \"0.0\""
11+"prim__addFloat 1.0 1.0"
12+"prim__subFloat 1.0 1.0"
13+"prim__mulFloat 1.0 1.0"
14+"prim__divFloat 1.0 1.0"
15+"prim__slteFloat 1.0 1.0"
16+"prim__sltFloat 1.0 1.0"
17+"prim__sgteFloat 1.0 1.0"
18+"prim__sgtFloat 1.0 1.0"
19+"prim__eqFloat 1.0 1.0"
20+"prim__floatACos 1.0"
21+"prim__floatATan 1.0"
22+"prim__floatCos 1.0"
23+"prim__floatFloor 1.0"
24+"prim__floatSin 1.0"
25+"prim__floatTan 1.0"
26+"prim__floatASin 1.0"
27+"prim__floatCeil 1.0"
28+"prim__floatExp 1.0"
29+"prim__floatLog 1.0"
30+"prim__floatSqrt 1.0"
31+)
32+
33+generate_testfile()
34+{
35+cat <<EOF > $1
36+${HEAD}
37+main = do
38+ putStrLn $ show $ $2
39+EOF
40+}
41+
42+for T in "${TESTS[@]}"
43+do
44+ echo ${T}
45+ generate_testfile "tmptest.idr" "${T}"
46+ idris $@ --quiet tmptest.idr -o tmptest || echo "missing primitive in ${CG}"
47+ ./tmptest
48+ rm tmptest.idr tmptest.ibc tmptest
49+done