1 -- -----------------------------------------------------------------------------
2 -- | This is the top-level module in the LLVM code generator.
5 module LlvmCodeGen ( llvmCodeGen ) where
7 #include "HsVersions.h"
9 import LlvmCodeGen.Base
10 import LlvmCodeGen.CodeGen
11 import LlvmCodeGen.Data
12 import LlvmCodeGen.Ppr
15 import CgUtils ( fixStgRegisters )
22 import qualified Pretty as Prt
27 -- -----------------------------------------------------------------------------
28 -- | Top-level of the llvm codegen
30 llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmm] -> IO ()
31 llvmCodeGen dflags h us cmms
33 let cmm = concat $ map extractRawCmm cmms
35 bufh <- newBufHandle h
37 Prt.bufLeftRender bufh $ pprLlvmHeader
39 env <- cmmDataLlvmGens dflags bufh cmm
40 cmmProcLlvmGens dflags bufh us env cmm
46 where extractRawCmm (Cmm tops) = tops
49 -- -----------------------------------------------------------------------------
50 -- | Do llvm code generation on all these cmms data sections.
58 cmmDataLlvmGens _ _ []
59 = return ( initLlvmEnv )
61 cmmDataLlvmGens dflags h cmm =
62 let exData (CmmData s d) = [(s,d)]
65 exProclbl (CmmProc _ l _ _) = [(strCLabel_llvm l)]
68 cdata = concat $ map exData cmm
69 -- put the functions into the enviornment
70 cproc = concat $ map exProclbl cmm
71 env = foldl (\e l -> funInsert l llvmFunTy e) initLlvmEnv cproc
72 in cmmDataLlvmGens' dflags h env cdata []
78 -> [(Section, [CmmStatic])]
82 cmmDataLlvmGens' dflags h env [] lmdata
84 let (env', lmdata') = resolveLlvmDatas dflags env lmdata []
85 let lmdoc = Prt.vcat $ map (pprLlvmData dflags) lmdata'
87 dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" $ docToSDoc lmdoc
89 Prt.bufLeftRender h lmdoc
92 cmmDataLlvmGens' dflags h env (cmm:cmms) lmdata
94 let lmdata'@(l, ty, _) = genLlvmData dflags cmm
95 let env' = funInsert (strCLabel_llvm l) ty env
96 cmmDataLlvmGens' dflags h env' cmms (lmdata ++ [lmdata'])
99 -- -----------------------------------------------------------------------------
100 -- | Do llvm code generation on all these cmms procs.
110 cmmProcLlvmGens _ _ _ _ []
113 cmmProcLlvmGens dflags h us env (cmm : cmms)
115 (us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm
117 Prt.bufLeftRender h $ Prt.vcat $ map (pprLlvmCmmTop dflags) llvm
119 cmmProcLlvmGens dflags h us' env' cmms
122 -- | Complete llvm code generation phase for a single top-level chunk of Cmm.
127 -> RawCmmTop -- ^ the cmm to generate code for
130 [LlvmCmmTop] ) -- llvm code
132 cmmLlvmGen dflags us env cmm
134 -- rewrite assignments to global regs
135 let fixed_cmm = fixStgRegisters cmm
137 dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm"
138 (pprCmm $ Cmm [fixed_cmm])
140 -- generate llvm code from cmm
141 let ((env', llvmBC), usGen) = initUs us $ genLlvmCode dflags env fixed_cmm
143 dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code"
144 (vcat $ map (docToSDoc . pprLlvmCmmTop dflags) llvmBC)
146 return (usGen, env', llvmBC)
149 -- -----------------------------------------------------------------------------
150 -- | Instruction selection
156 -> UniqSM (LlvmEnv, [LlvmCmmTop])
158 genLlvmCode _ env (CmmData _ _)
161 genLlvmCode _ env (CmmProc _ _ _ (ListGraph []))
164 genLlvmCode _ env cp@(CmmProc _ _ _ _)