on master help sign in
Object and executable outputs
93522bcBenjamin Saunders
@@ -53,6 +53,8 @@ cleanJavaLib verbosity
53 execPomExists <- doesFileExist ("java" </> "executable_pom.xml")
53 execPomExists <- doesFileExist ("java" </> "executable_pom.xml")
54 when pomExists $ removeFile ("java" </> "executable_pom.xml")
54 when pomExists $ removeFile ("java" </> "executable_pom.xml")
55
55
56+cleanLLVMLib verbosity = make verbosity ["-C", "llvm", "clean"]
57+
56installStdLib pkg local withoutEffects verbosity copy
58installStdLib pkg local withoutEffects verbosity copy
57 = do let dirs = L.absoluteInstallDirs pkg local copy
59 = do let dirs = L.absoluteInstallDirs pkg local copy
58 let idir = datadir dirs
60 let idir = datadir dirs
@@ -82,6 +84,10 @@ installStdLib pkg local withoutEffects verbosity copy
82 , "IDRIS=" ++ icmd
84 , "IDRIS=" ++ icmd
83 ]
85 ]
84
86
87+installLLVMLib verbosity pkg local copy =
88+ let idir = datadir $ L.absoluteInstallDirs pkg local copy in
89+ make verbosity ["-C", "llvm", "install", "TARGET=" ++ idir </> "llvm"]
90+
85installJavaLib pkg local verbosity copy version = do
91installJavaLib pkg local verbosity copy version = do
86 let rtsFile = "idris-" ++ display version ++ ".jar"
92 let rtsFile = "idris-" ++ display version ++ ".jar"
87 putStrLn $ "Installing java libraries"
93 putStrLn $ "Installing java libraries"
@@ -161,11 +167,13 @@ main = do
161 let withoutEffects = noEffectsFlag $ configFlags lbi
167 let withoutEffects = noEffectsFlag $ configFlags lbi
162 installStdLib pkg lbi withoutEffects verb
168 installStdLib pkg lbi withoutEffects verb
163 (S.fromFlag $ S.copyDest flags)
169 (S.fromFlag $ S.copyDest flags)
170+ installLLVMLib verb pkg lbi (S.fromFlag $ S.copyDest flags)
164 , postInst = \ _ flags pkg lbi -> do
171 , postInst = \ _ flags pkg lbi -> do
165 let verb = (S.fromFlag $ S.installVerbosity flags)
172 let verb = (S.fromFlag $ S.installVerbosity flags)
166 let withoutEffects = noEffectsFlag $ configFlags lbi
173 let withoutEffects = noEffectsFlag $ configFlags lbi
167 installStdLib pkg lbi withoutEffects verb
174 installStdLib pkg lbi withoutEffects verb
168 NoCopyDest
175 NoCopyDest
176+ installLLVMLib verb pkg lbi NoCopyDest
169 when (javaFlag $ configFlags lbi)
177 when (javaFlag $ configFlags lbi)
170 (installJavaLib pkg
178 (installJavaLib pkg
171 lbi
179 lbi
@@ -180,6 +188,7 @@ main = do
180 , postClean = \ _ flags _ _ -> do
188 , postClean = \ _ flags _ _ -> do
181 let verb = S.fromFlag $ S.cleanVerbosity flags
189 let verb = S.fromFlag $ S.cleanVerbosity flags
182 cleanStdLib verb
190 cleanStdLib verb
191+ cleanLLVMLib verb
183 cleanJavaLib verb
192 cleanJavaLib verb
184 , postBuild = \ _ flags _ lbi -> do
193 , postBuild = \ _ flags _ lbi -> do
185 let verb = S.fromFlag $ S.buildVerbosity flags
194 let verb = S.fromFlag $ S.buildVerbosity flags
llvm/defs.cnew file+5
@@ -0,0 +1,5 @@
1+#include <stdio.h>
2+
3+void putStr(const char *str) {
4+ fputs(str, stdout);
5+}
src/IRTS/CodegenLLVM.hs+30−1
@@ -6,6 +6,9 @@ import IRTS.Lang
6import IRTS.Simplified
6import IRTS.Simplified
7import qualified Core.TT as TT
7import qualified Core.TT as TT
8
8
9+import Util.System
10+import Paths_idris
11+
9import LLVM.General.Context
12import LLVM.General.Context
10import LLVM.General.Diagnostic
13import LLVM.General.Diagnostic
11import LLVM.General.AST
14import LLVM.General.AST
@@ -31,6 +34,11 @@ import Control.Monad.Writer
31import Control.Monad.State
34import Control.Monad.State
32
35
33import System.Info (arch)
36import System.Info (arch)
37+import System.IO
38+import System.Directory (removeFile)
39+import System.FilePath ((</>))
40+import System.Process (rawSystem)
41+import System.Exit (ExitCode(..))
34import Debug.Trace
42import Debug.Trace
35
43
36codegenLLVM :: [(TT.Name, SDecl)] ->
44codegenLLVM :: [(TT.Name, SDecl)] ->
@@ -39,11 +47,32 @@ codegenLLVM :: [(TT.Name, SDecl)] ->
39 IO ()
47 IO ()
40codegenLLVM defs file outty = withContext $ \context -> do
48codegenLLVM defs file outty = withContext $ \context -> do
41 let ast = codegen arch (map snd defs)
49 let ast = codegen arch (map snd defs)
42− result <- M.withModuleFromAST context ast (M.writeBitcodeToFile file)
50+ result <- M.withModuleFromAST context ast (outputModule file outty)
43 case result of
51 case result of
44 Right _ -> return ()
52 Right _ -> return ()
45 Left msg -> ierror msg
53 Left msg -> ierror msg
46
54
55+outputModule :: FilePath -> OutputType -> M.Module -> IO ()
56+outputModule file Raw m = M.writeBitcodeToFile file m
57+outputModule file Object m = withTmpFile $ \bc -> do
58+ outputModule bc Raw m
59+ exit <- rawSystem "llc" ["-filetype=obj", "--disable-fp-elim", "-o", file, bc]
60+ when (exit /= ExitSuccess) $ ierror "FAILURE: Object generation"
61+outputModule file Executable m = withTmpFile $ \obj -> do
62+ outputModule obj Object m
63+ cc <- getCC
64+ defs <- (</> "llvm" </> "libidris_rts.a") <$> getDataDir
65+ exit <- rawSystem cc [obj, defs, "-lm", "-lgmp", "-lgc", "-o", file]
66+ when (exit /= ExitSuccess) $ ierror "FAILURE: Linking"
67+
68+withTmpFile :: (FilePath -> IO a) -> IO a
69+withTmpFile f = do
70+ (path, handle) <- tempfile
71+ hClose handle
72+ result <- f path
73+ removeFile path
74+ return result
75+
47ierror :: String -> a
76ierror :: String -> a
48ierror msg = error $ "INTERNAL ERROR: IRTS.CodegenLLVM: " ++ msg
77ierror msg = error $ "INTERNAL ERROR: IRTS.CodegenLLVM: " ++ msg
49
78