git.iko.soy/Idris-dev
on master help sign in
Merge pull request #523 from Ralith/fix-llvm-install
a068cb5Edwin Brady
.travis.yml+1−1
compare with master
unifiedsplit
@@ -13,4 +13,4 @@ script:
13 - cabal build
13 - cabal build
14 - cabal copy
14 - cabal copy
15 - make test
15 - make test
16−
16+ - make test_llvm
Makefile+3
@@ -19,6 +19,9 @@ test:
19test_java:
19test_java:
20 $(MAKE) -C test IDRIS=../dist/build/idris test_java
20 $(MAKE) -C test IDRIS=../dist/build/idris test_java
21
21
22+test_llvm:
23+ $(MAKE) -C test IDRIS=../dist/build/idris test_llvm
24+
22relib:
25relib:
23 $(MAKE) -C lib IDRIS=../dist/build/idris/idris RTS=../dist/build/rts/libidris_rts clean
26 $(MAKE) -C lib IDRIS=../dist/build/idris/idris RTS=../dist/build/rts/libidris_rts clean
24 $(MAKE) -C effects IDRIS=../dist/build/idris/idris RTS=../dist/build/rts/libidris_rts DIST=../dist/build clean
27 $(MAKE) -C effects IDRIS=../dist/build/idris/idris RTS=../dist/build/rts/libidris_rts DIST=../dist/build clean
Setup.hs+1−1
@@ -134,7 +134,7 @@ idrisInstall verbosity copy pkg local = do
134 installLLVM = do
134 installLLVM = do
135 let target' = target </> "llvm"
135 let target' = target </> "llvm"
136 putStrLn $ "Installing LLVM library in " ++ target
136 putStrLn $ "Installing LLVM library in " ++ target
137− makeInstall "llvm" target
137+ makeInstall "llvm" target'
138
138
139 makeInstall src target =
139 makeInstall src target =
140 make verbosity [ "-C", src, "install" , "TARGET=" ++ target, "IDRIS=" ++ idrisCmd local]
140 make verbosity [ "-C", src, "install" , "TARGET=" ++ target, "IDRIS=" ++ idrisCmd local]
llvm/defs.c+4
@@ -11,6 +11,10 @@ void putStr(const char *str) {
11 fputs(str, stdout);
11 fputs(str, stdout);
12}
12}
13
13
14+void putErr(const char *str) {
15+ fputs(str, stderr);
16+}
17+
14void mpz_init_set_ull(mpz_t n, unsigned long long ull)
18void mpz_init_set_ull(mpz_t n, unsigned long long ull)
15{
19{
16 mpz_init_set_ui(n, (unsigned int)(ull >> 32)); /* n = (unsigned int)(ull >> 32) */
20 mpz_init_set_ui(n, (unsigned int)(ull >> 32)); /* n = (unsigned int)(ull >> 32) */
src/IRTS/CodegenLLVM.hs+32−19
@@ -20,7 +20,7 @@ import LLVM.General.Target ( TargetMachine
20 )
20 )
21import LLVM.General.AST.DataLayout
21import LLVM.General.AST.DataLayout
22import qualified LLVM.General.PassManager as PM
22import qualified LLVM.General.PassManager as PM
23−import qualified LLVM.General.Module as M
23+import qualified LLVM.General.Module as MO
24import qualified LLVM.General.AST.IntegerPredicate as IPred
24import qualified LLVM.General.AST.IntegerPredicate as IPred
25import qualified LLVM.General.AST.Linkage as L
25import qualified LLVM.General.AST.Linkage as L
26import qualified LLVM.General.AST.Visibility as V
26import qualified LLVM.General.AST.Visibility as V
@@ -36,9 +36,9 @@ import qualified LLVM.General.CodeGenOpt as CGO
36import Data.List
36import Data.List
37import Data.Maybe
37import Data.Maybe
38import Data.Word
38import Data.Word
39−import Data.Set (Set)
39+import Data.Map (Map)
40−import qualified Data.Set as S
41import qualified Data.Map as M
40import qualified Data.Map as M
41+import qualified Data.Set as S
42import qualified Data.Vector.Unboxed as V
42import qualified Data.Vector.Unboxed as V
43import Control.Applicative
43import Control.Applicative
44import Control.Monad.RWS
44import Control.Monad.RWS
@@ -70,7 +70,7 @@ codegenLLVM defs triple cpu optimize file outty = withContext $ \context -> do
70 withTargetMachine target triple cpu S.empty options R.Default CM.Default CGO.Default $ \tm ->
70 withTargetMachine target triple cpu S.empty options R.Default CM.Default CGO.Default $ \tm ->
71 do layout <- getTargetMachineDataLayout tm
71 do layout <- getTargetMachineDataLayout tm
72 let ast = codegen (Target triple layout) (map snd defs)
72 let ast = codegen (Target triple layout) (map snd defs)
73− result <- runErrorT . M.withModuleFromAST context ast $ \m ->
73+ result <- runErrorT . MO.withModuleFromAST context ast $ \m ->
74 do let opts = PM.defaultCuratedPassSetSpec
74 do let opts = PM.defaultCuratedPassSetSpec
75 { PM.optLevel = Just optimize
75 { PM.optLevel = Just optimize
76 , PM.simplifyLibCalls = Just True
76 , PM.simplifyLibCalls = Just True
@@ -85,9 +85,9 @@ codegenLLVM defs triple cpu optimize file outty = withContext $ \context -> do
85failInIO :: ErrorT String IO a -> IO a
85failInIO :: ErrorT String IO a -> IO a
86failInIO = either fail return <=< runErrorT
86failInIO = either fail return <=< runErrorT
87
87
88−outputModule :: TargetMachine -> FilePath -> OutputType -> M.Module -> IO ()
88+outputModule :: TargetMachine -> FilePath -> OutputType -> MO.Module -> IO ()
89−outputModule _ file Raw m = failInIO $ M.writeBitcodeToFile file m
89+outputModule _ file Raw m = failInIO $ MO.writeBitcodeToFile file m
90−outputModule tm file Object m = failInIO $ M.writeObjectToFile tm file m
90+outputModule tm file Object m = failInIO $ MO.writeObjectToFile tm file m
91outputModule tm file Executable m = withTmpFile $ \obj -> do
91outputModule tm file Executable m = withTmpFile $ \obj -> do
92 outputModule tm obj Object m
92 outputModule tm obj Object m
93 cc <- getCC
93 cc <- getCC
@@ -193,6 +193,7 @@ initDefs tgt =
193 , exfun "__idris_gmpFree" VoidType [ptrI8, intPtr] False
193 , exfun "__idris_gmpFree" VoidType [ptrI8, intPtr] False
194 , exfun "__idris_strRev" ptrI8 [ptrI8] False
194 , exfun "__idris_strRev" ptrI8 [ptrI8] False
195 , exfun "strtoll" (IntegerType 64) [ptrI8, PointerType ptrI8 (AddrSpace 0), IntegerType 32] False
195 , exfun "strtoll" (IntegerType 64) [ptrI8, PointerType ptrI8 (AddrSpace 0), IntegerType 32] False
196+ , exfun "putErr" VoidType [ptrI8] False
196 , exVar (stdinName tgt) ptrI8
197 , exVar (stdinName tgt) ptrI8
197 , exVar (stdoutName tgt) ptrI8
198 , exVar (stdoutName tgt) ptrI8
198 , exVar (stderrName tgt) ptrI8
199 , exVar (stderrName tgt) ptrI8
@@ -244,7 +245,7 @@ getStdErr = ConstantOperand . C.GlobalReference . Name . stderrName <$> asks tar
244codegen :: Target -> [SDecl] -> Module
245codegen :: Target -> [SDecl] -> Module
245codegen tgt defs = Module "idris" (Just . dataLayout $ tgt) (Just . triple $ tgt) (initDefs tgt ++ globals ++ gendefs)
246codegen tgt defs = Module "idris" (Just . dataLayout $ tgt) (Just . triple $ tgt) (initDefs tgt ++ globals ++ gendefs)
246 where
247 where
247− (gendefs, _, globals) = runRWS (mapM cgDef defs) tgt 0
248+ (gendefs, _, globals) = runRWS (mapM cgDef defs) tgt initialMGS
248
249
249valueType :: Type
250valueType :: Type
250valueType = NamedTypeReference (Name "valTy")
251valueType = NamedTypeReference (Name "valTy")
@@ -264,24 +265,34 @@ conType nargs = StructureType False
264 , ArrayType nargs (PointerType valueType (AddrSpace 0))
265 , ArrayType nargs (PointerType valueType (AddrSpace 0))
265 ]
266 ]
266
267
268+data MGS = MGS { mgsNextGlobalName :: Word
269+ , mgsForeignSyms :: Map String (FType, [FType])
270+ }
271+
267−type Modgen = RWS Target [Definition] Word
272+type Modgen = RWS Target [Definition] MGS
273+
274+initialMGS :: MGS
275+initialMGS = MGS { mgsNextGlobalName = 0
276+ , mgsForeignSyms = M.empty
277+ }
268
278
269cgDef :: SDecl -> Modgen Definition
279cgDef :: SDecl -> Modgen Definition
270cgDef (SFun name argNames _ expr) = do
280cgDef (SFun name argNames _ expr) = do
271− nextGlobal <- get
281+ nextGlobal <- gets mgsNextGlobalName
282+ existingForeignSyms <- gets mgsForeignSyms
272 tgt <- ask
283 tgt <- ask
273− let (_, CGS { nextGlobalName = nextGlobal' }, (allocas, bbs, globals)) =
284+ let (_, CGS { nextGlobalName = nextGlobal', foreignSyms = foreignSyms' }, (allocas, bbs, globals)) =
274 runRWS (do r <- cgExpr expr
285 runRWS (do r <- cgExpr expr
275 case r of
286 case r of
276 Nothing -> terminate $ Unreachable []
287 Nothing -> terminate $ Unreachable []
277 Just r' -> terminate $ Ret (Just r') [])
288 Just r' -> terminate $ Ret (Just r') [])
278 (CGR tgt (show name))
289 (CGR tgt (show name))
279− (CGS 0 nextGlobal (Name "begin") [] (map (Just . LocalReference . Name . show) argNames) S.empty)
290+ (CGS 0 nextGlobal (Name "begin") [] (map (Just . LocalReference . Name . show) argNames) existingForeignSyms)
280 entryTerm = case bbs of
291 entryTerm = case bbs of
281 [] -> Do $ Ret Nothing []
292 [] -> Do $ Ret Nothing []
282 BasicBlock n _ _:_ -> Do $ Br n []
293 BasicBlock n _ _:_ -> Do $ Br n []
283 tell globals
294 tell globals
284− put nextGlobal'
295+ put (MGS { mgsNextGlobalName = nextGlobal', mgsForeignSyms = foreignSyms' })
285 return . GlobalDefinition $ functionDefaults
296 return . GlobalDefinition $ functionDefaults
286 { G.linkage = L.Internal
297 { G.linkage = L.Internal
287 , G.callingConvention = CC.Fast
298 , G.callingConvention = CC.Fast
@@ -306,7 +317,7 @@ data CGS = CGS { nextName :: Word
306 , currentBlockName :: Name
317 , currentBlockName :: Name
307 , instAccum :: [Named Instruction]
318 , instAccum :: [Named Instruction]
308 , lexenv :: Env
319 , lexenv :: Env
309− , foreignSyms :: Set String
320+ , foreignSyms :: Map String (FType, [FType])
310 }
321 }
311
322
312data CGR = CGR { target :: Target
323data CGR = CGR { target :: Target
@@ -524,10 +535,10 @@ cgExpr (SOp fn args) = do
524 Just ops -> Just <$> cgOp fn ops
535 Just ops -> Just <$> cgOp fn ops
525 Nothing -> return Nothing
536 Nothing -> return Nothing
526cgExpr SNothing = return . Just . ConstantOperand $ nullValue
537cgExpr SNothing = return . Just . ConstantOperand $ nullValue
527−cgExpr (SError msg) = do -- TODO: Print message
538+cgExpr (SError msg) = do
528 str <- addGlobal' (ArrayType (2 + fromIntegral (length msg)) (IntegerType 8))
539 str <- addGlobal' (ArrayType (2 + fromIntegral (length msg)) (IntegerType 8))
529 (cgConst' (TT.Str (msg ++ "\n")))
540 (cgConst' (TT.Str (msg ++ "\n")))
530− inst' $ simpleCall "putStr" [ConstantOperand $ C.GetElementPtr True str [ C.Int 32 0
541+ inst' $ simpleCall "putErr" [ConstantOperand $ C.GetElementPtr True str [ C.Int 32 0
531 , C.Int 32 0]]
542 , C.Int 32 0]]
532 inst' Call { isTailCall = True
543 inst' Call { isTailCall = True
533 , callingConvention = CC.C
544 , callingConvention = CC.C
@@ -799,9 +810,11 @@ addGlobal' ty val = do
799ensureCDecl :: String -> FType -> [FType] -> Codegen Operand
810ensureCDecl :: String -> FType -> [FType] -> Codegen Operand
800ensureCDecl name rty argtys = do
811ensureCDecl name rty argtys = do
801 syms <- gets foreignSyms
812 syms <- gets foreignSyms
802− unless (S.member name syms) $
813+ case M.lookup name syms of
803− do addGlobal (ffunDecl name rty argtys)
814+ Nothing -> do addGlobal (ffunDecl name rty argtys)
804− modify $ \s -> s { foreignSyms = S.insert name (foreignSyms s) }
815+ modify $ \s -> s { foreignSyms = M.insert name (rty, argtys) (foreignSyms s) }
816+ Just (rty', argtys') -> unless (rty == rty' && argtys == argtys') . fail $
817+ "Mismatched type declarations for foreign symbol \"" ++ name ++ "\": " ++ show (rty, argtys) ++ " vs " ++ show (rty', argtys')
805 return $ ConstantOperand (C.GlobalReference (Name name))
818 return $ ConstantOperand (C.GlobalReference (Name name))
806
819
807ffunDecl :: String -> FType -> [FType] -> Global
820ffunDecl :: String -> FType -> [FType] -> Global
test/Makefile+33
@@ -61,6 +61,39 @@ test_js:
61 @perl ./runtest.pl test030 --codegen node
61 @perl ./runtest.pl test030 --codegen node
62 @perl ./runtest.pl test031 --codegen node
62 @perl ./runtest.pl test031 --codegen node
63
63
64+test_llvm:
65+ @perl ./runtest.pl test001 --codegen llvm
66+ @perl ./runtest.pl test002 --codegen llvm
67+ @perl ./runtest.pl test003 --codegen llvm
68+ @perl ./runtest.pl test004 --codegen llvm
69+ @perl ./runtest.pl test005 --codegen llvm
70+ @perl ./runtest.pl test006 --codegen llvm
71+ @perl ./runtest.pl test007 --codegen llvm
72+ @perl ./runtest.pl test008 --codegen llvm
73+ @perl ./runtest.pl test009 --codegen llvm
74+ @perl ./runtest.pl test010 --codegen llvm
75+ @perl ./runtest.pl test011 --codegen llvm
76+ @perl ./runtest.pl test012 --codegen llvm
77+ @perl ./runtest.pl test013 --codegen llvm
78+ @perl ./runtest.pl test014 --codegen llvm
79+ @perl ./runtest.pl test015 --codegen llvm
80+ @perl ./runtest.pl test016 --codegen llvm
81+ @perl ./runtest.pl test017 --codegen llvm
82+ @#perl ./runtest.pl test018 --codegen llvm
83+ @perl ./runtest.pl test019 --codegen llvm
84+ @perl ./runtest.pl test020 --codegen llvm
85+ @perl ./runtest.pl test021 --codegen llvm
86+ @perl ./runtest.pl test022 --codegen llvm
87+ @perl ./runtest.pl test023 --codegen llvm
88+ @perl ./runtest.pl test024 --codegen llvm
89+ @perl ./runtest.pl test025 --codegen llvm
90+ @perl ./runtest.pl test026 --codegen llvm
91+ @perl ./runtest.pl test027 --codegen llvm
92+ @perl ./runtest.pl test028 --codegen llvm
93+ @perl ./runtest.pl test029 --codegen llvm
94+ @perl ./runtest.pl test030 --codegen llvm
95+ @perl ./runtest.pl test031 --codegen llvm
96+
64update:
97update:
65 perl ./runtest.pl all -u
98 perl ./runtest.pl all -u
66
99