1 -- -----------------------------------------------------------------------------
2 -- | This is the top-level module in the LLVM code generator.
5 module LlvmCodeGen ( llvmCodeGen ) where
7 #include "HsVersions.h"
11 import LlvmCodeGen.Base
12 import LlvmCodeGen.CodeGen
13 import LlvmCodeGen.Data
14 import LlvmCodeGen.Ppr
18 import CgUtils ( fixStgRegisters )
26 import qualified Pretty as Prt
32 -- -----------------------------------------------------------------------------
33 -- | Top-level of the llvm codegen
35 llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmm] -> IO ()
36 llvmCodeGen dflags h us cmms
38 let cmm = concat $ map (\(Cmm top) -> top) cmms
40 bufh <- newBufHandle h
42 Prt.bufLeftRender bufh $ pprLlvmHeader
44 env <- cmmDataLlvmGens dflags bufh cmm
45 cmmProcLlvmGens dflags bufh us env cmm 1 []
52 -- -----------------------------------------------------------------------------
53 -- | Do llvm code generation on all these cmms data sections.
61 cmmDataLlvmGens _ _ []
62 = return ( initLlvmEnv )
64 cmmDataLlvmGens dflags h cmm =
65 let exData (CmmData s d) = [(s,d)]
68 exProclbl (CmmProc i l _ _)
69 | not (null i) = [strCLabel_llvm $ entryLblToInfoLbl l]
70 exProclbl (CmmProc _ l _ _) | otherwise = [strCLabel_llvm l]
73 cproc = concat $ map exProclbl cmm
74 cdata = concat $ map exData cmm
75 env = foldl (\e l -> funInsert l llvmFunTy e) initLlvmEnv cproc
76 in cmmDataLlvmGens' dflags h env cdata []
82 -> [(Section, [CmmStatic])]
86 cmmDataLlvmGens' dflags h env [] lmdata
88 let (env', lmdata') = resolveLlvmDatas dflags env lmdata []
89 let lmdoc = Prt.vcat $ map (pprLlvmData dflags) lmdata'
91 dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" $ docToSDoc lmdoc
93 Prt.bufLeftRender h lmdoc
96 cmmDataLlvmGens' dflags h env (cmm:cmms) lmdata
98 let lmdata'@(l, ty, _) = genLlvmData dflags cmm
99 let env' = funInsert (strCLabel_llvm l) ty env
100 cmmDataLlvmGens' dflags h env' cmms (lmdata ++ [lmdata'])
103 -- -----------------------------------------------------------------------------
104 -- | Do llvm code generation on all these cmms procs.
112 -> Int -- ^ count, used for generating unique subsections
113 -> [LlvmVar] -- ^ info tables that need to be marked as 'used'
116 cmmProcLlvmGens _ _ _ _ [] _ []
119 cmmProcLlvmGens dflags h _ _ [] _ ivars
121 let cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr
122 let ty = (LMArray (length ivars) i8Ptr)
123 let usedArray = LMStaticArray (map cast ivars) ty
124 let lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending
125 (Just $ fsLit "llvm.metadata") Nothing, Just usedArray)
126 Prt.bufLeftRender h $ pprLlvmData dflags ([lmUsed], [])
128 cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars
130 (us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm
132 let (docs, ivar) = mapAndUnzip (pprLlvmCmmTop dflags env' count) llvm
133 Prt.bufLeftRender h $ Prt.vcat docs
135 cmmProcLlvmGens dflags h us' env' cmms (count + 2) (concat ivar ++ ivars)
138 -- | Complete llvm code generation phase for a single top-level chunk of Cmm.
143 -> RawCmmTop -- ^ the cmm to generate code for
146 [LlvmCmmTop] ) -- llvm code
148 cmmLlvmGen dflags us env cmm
150 -- rewrite assignments to global regs
151 let fixed_cmm = fixStgRegisters cmm
153 dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm"
154 (pprCmm $ Cmm [fixed_cmm])
156 -- generate llvm code from cmm
157 let ((env', llvmBC), usGen) = initUs us $ genLlvmCode dflags env fixed_cmm
159 dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code"
160 (vcat $ map (docToSDoc . fst . pprLlvmCmmTop dflags env' 0) llvmBC)
162 return (usGen, env', llvmBC)
165 -- -----------------------------------------------------------------------------
166 -- | Instruction selection
172 -> UniqSM (LlvmEnv, [LlvmCmmTop])
174 genLlvmCode _ env (CmmData _ _)
177 genLlvmCode _ env (CmmProc _ _ _ (ListGraph []))
180 genLlvmCode _ env cp@(CmmProc _ _ _ _)