@@ -22,6 +22,7 @@ import LLVM.General.AST.DataLayout
2222import qualified LLVM.General.PassManager as PM
2323import qualified LLVM.General.Module as MO
2424import qualified LLVM.General.AST.IntegerPredicate as IPred
25+import qualified LLVM.General.AST.FloatingPointPredicate as FPred
2526import qualified LLVM.General.AST.Linkage as L
2627import qualified LLVM.General.AST.Visibility as V
2728import qualified LLVM.General.AST.CallingConvention as CC
@@ -165,6 +166,38 @@ initDefs tgt =
165166 ]
166167 (Do $ Ret (Just (LocalReference (UnName 1))) [])
167168 ]
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
168201 , exfun "llvm.trap" VoidType [] False
169202 -- , exfun "llvm.llvm.memcpy.p0i8.p0i8.i32" VoidType [ptrI8, ptrI8, IntegerType 32, IntegerType 32, IntegerType 1] False
170203 -- , exfun "llvm.llvm.memcpy.p0i8.p0i8.i64" VoidType [ptrI8, ptrI8, IntegerType 64, IntegerType 32, IntegerType 1] False
@@ -188,6 +221,8 @@ initDefs tgt =
188221 , exfun "__gmpz_cmp" (IntegerType 32) [pmpz, pmpz] False
189222 , exfun "__gmpz_fdiv_q_2exp" VoidType [pmpz, pmpz, intPtr] False
190223 , 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
191226 , exfun "mpz_get_ull" (IntegerType 64) [pmpz] False
192227 , exfun "mpz_init_set_ull" VoidType [pmpz, IntegerType 64] False
193228 , exfun "mpz_init_set_sll" VoidType [pmpz, IntegerType 64] False
@@ -843,10 +878,10 @@ ftyToTy (FArith (ATInt (ITFixed ty))) = IntegerType (fromIntegral $ nativeTyWidt
843878ftyToTy (FArith (ATInt (ITVec e c)))
844879 = VectorType (fromIntegral c) (IntegerType (fromIntegral $ nativeTyWidth e))
845880ftyToTy (FArith (ATInt ITChar)) = IntegerType 32
881+ftyToTy (FArith ATFloat) = FloatingPointType 64 IEEE
846882ftyToTy FString = PointerType (IntegerType 8) (AddrSpace 0)
847883ftyToTy FUnit = VoidType
848884ftyToTy FPtr = PointerType (IntegerType 8) (AddrSpace 0)
849−ftyToTy (FArith ATFloat) = FloatingPointType 64 IEEE
850885ftyToTy FAny = valueType
851886
852887-- Only use when known not to be ITBig
@@ -938,20 +973,69 @@ cgOp (LSGe (ATInt ity)) [x,y] = iCmp ity IPred.SGE x y
938973cgOp (LSGt (ATInt ity)) [x,y] = iCmp ity IPred.SGT x y
939974cgOp (LGe ity) [x,y] = iCmp ity IPred.UGE x y
940975cgOp (LGt ity) [x,y] = iCmp ity IPred.UGT x y
941−cgOp (LPlus (ATInt ity)) [x,y] = ibin ity x y (Add False False)
942−cgOp (LMinus (ATInt ity)) [x,y] = ibin ity x y (Sub False False)
943−cgOp (LTimes (ATInt ity)) [x,y] = ibin ity x y (Mul False False)
944−cgOp (LSDiv (ATInt ity)) [x,y] = ibin ity x y (SDiv False)
945−cgOp (LSRem (ATInt ity)) [x,y] = ibin ity x y SRem
946−cgOp (LUDiv ity) [x,y] = ibin ity x y (UDiv False)
947−cgOp (LURem ity) [x,y] = ibin ity x y URem
948−cgOp (LAnd ity) [x,y] = ibin ity x y And
949−cgOp (LOr ity) [x,y] = ibin ity x y Or
950−cgOp (LXOr ity) [x,y] = ibin ity x y Xor
951−cgOp (LCompl ity) [x] = iun ity x (Xor . ConstantOperand $ itConst ity (-1))
952−cgOp (LSHL ity) [x,y] = ibin ity x y (Shl False False)
953−cgOp (LLSHR ity) [x,y] = ibin ity x y (LShr False)
954−cgOp (LASHR ity) [x,y] = ibin ity x y (AShr False)
976+cgOp (LPlus ty@(ATInt _)) [x,y] = binary ty x y (Add False False)
977+cgOp (LMinus ty@(ATInt _)) [x,y] = binary ty x y (Sub False False)
978+cgOp (LTimes ty@(ATInt _)) [x,y] = binary ty x y (Mul False False)
979+cgOp (LSDiv ty@(ATInt _)) [x,y] = binary ty x y (SDiv False)
980+cgOp (LSRem ty@(ATInt _)) [x,y] = binary ty x y SRem
981+cgOp (LUDiv ity) [x,y] = binary (ATInt ity) x y (UDiv False)
982+cgOp (LURem ity) [x,y] = binary (ATInt ity) x y URem
983+cgOp (LAnd ity) [x,y] = binary (ATInt ity) x y And
984+cgOp (LOr ity) [x,y] = binary (ATInt ity) x y Or
985+cgOp (LXOr ity) [x,y] = binary (ATInt ity) x y Xor
986+cgOp (LCompl ity) [x] = unary (ATInt ity) x (Xor . ConstantOperand $ itConst ity (-1))
987+cgOp (LSHL ity) [x,y] = binary (ATInt ity) x y (Shl False False)
988+cgOp (LLSHR ity) [x,y] = binary (ATInt ity) x y (LShr 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
9551039
9561040cgOp LNoOp xs = return $ last xs
9571041
@@ -1119,19 +1203,27 @@ cgStrCat x y = do
11191203 inst' $ Store False end (ConstantOperand (C.Int 8 0)) Nothing 0 []
11201204 box FString mem
11211205
1122−ibin :: IntTy -> Operand -> Operand
1206+binary :: ArithTy -> Operand -> Operand
11231207 -> (Operand -> Operand -> InstructionMetadata -> Instruction) -> Codegen Operand
1124−ibin ity x y instCon = do
1125− nx <- unbox (FArith (ATInt ity)) x
1126− ny <- unbox (FArith (ATInt ity)) y
1208+binary ty x y instCon = do
1209+ nx <- unbox (FArith ty) x
1210+ ny <- unbox (FArith ty) y
11271211 nr <- inst $ instCon nx ny []
1128− box (FArith (ATInt ity)) nr
1212+ box (FArith ty) nr
11291213
1130−iun :: IntTy -> Operand -> (Operand -> InstructionMetadata -> Instruction) -> Codegen Operand
1131−iun ity x instCon = do
1132− nx <- unbox (FArith (ATInt ity)) x
1214+unary :: ArithTy -> Operand
1215+ -> (Operand -> InstructionMetadata -> Instruction) -> Codegen Operand
1216+unary ty x instCon = do
1217+ nx <- unbox (FArith ty) x
11331218 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
11351227
11361228iCmp :: IntTy -> IPred.IntegerPredicate -> Operand -> Operand -> Codegen Operand
11371229iCmp ity pred x y = do
@@ -1141,6 +1233,13 @@ iCmp ity pred x y = do
11411233 nr' <- inst $ SExt nr (ftyToTy $ cmpResultTy ity) []
11421234 box (cmpResultTy ity) nr'
11431235
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+
11441243cmpResultTy :: IntTy -> FType
11451244cmpResultTy v@(ITVec _ _) = FArith (ATInt v)
11461245cmpResultTy _ = FArith (ATInt (ITFixed IT32))