~jojo/Carth

ref: 283eb4840fa8cbce85e1476e685c7d62443ff958 Carth/src/Compile.hs -rw-r--r-- 2.5 KiB
283eb484JoJo Remove not-really-needed deps llvm-hs-pretty & prettyprinter 2 years ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
module Compile (compile, CompileConfig(..), defaultCompileConfig) where

import LLVM.Context
import LLVM.Module
import LLVM.Target
import LLVM.Analysis
import Data.Maybe
import System.FilePath
import System.Process
import qualified LLVM.Relocation as Reloc
import qualified LLVM.CodeModel as CodeModel
import qualified LLVM.CodeGenOpt as CodeGenOpt

import qualified MonoAst
import Codegen

-- | Configuration for LLVM compilation and CC linking
data CompileConfig = CompileConfig
    -- | Path to C compiler to use for linking and compiling ".c" files
    { cc :: FilePath
    -- | Filepath to write the output item to. If none is supplied, a default
    --   name of "out" with the appropriate extension will be used.
    , outfile :: Maybe FilePath }

defaultCompileConfig :: CompileConfig
defaultCompileConfig = CompileConfig { cc = "cc", outfile = Nothing }

-- TODO: Verify w LLVM.Analysis.verify :: Module -> IO ()
-- TODO: CodeGenOpt level
compile :: FilePath -> CompileConfig -> MonoAst.Program -> IO ()
compile f cfg pgm = withContext $ \c -> withHostTargetMachinePIC $ \t -> do
    layout <- getTargetMachineDataLayout t
    putStrLn ("   Generating LLVM")
    let mod' = codegen layout f pgm
    withModuleFromAST c mod' (compileModule t cfg)

compileModule :: TargetMachine -> CompileConfig -> Module -> IO ()
compileModule t cfg m = do
    putStrLn ("   Compiling LLVM")
    let binfile = fromMaybe "out" (outfile cfg)
        llfile = replaceExtension binfile "ll"
        ofile = replaceExtension binfile "o"
    writeLLVMAssemblyToFile' (".dbg." ++ llfile) m
    verify m
    writeObjectToFile t (File ofile) m
    putStrLn ("   Linking")
    callProcess
        (cc cfg)
        [ "-o"
        , binfile
        , ofile
        , "-l:libcarth_foreign_core.a"
        , "-ldl"
        , "-lpthread"
        ]

-- | `writeLLVMAssemblyToFile` doesn't clear file contents before writing, so
--   this is a workaround.
--
--   If the file was previously 100 lines of data, and the new LLVM-assembly is
--   70 lines, the first 70 lines will be overwritten, but the remaining 30 will
--   be the same as in the old file, which will cause errors if we try to
--   compile it manually. So we have to clear file contents first manually if we
--   want these dumps to be useful for debugging.
writeLLVMAssemblyToFile' :: FilePath -> Module -> IO ()
writeLLVMAssemblyToFile' f m = do
    writeFile f ""
    writeLLVMAssemblyToFile (File f) m

withHostTargetMachinePIC :: (TargetMachine -> IO a) -> IO a
withHostTargetMachinePIC =
    withHostTargetMachine Reloc.PIC CodeModel.Default CodeGenOpt.None