1 -- -----------------------------------------------------------------------------
2 -- | This is the top-level module in the LLVM code generator.
5 module LlvmCodeGen ( llvmCodeGen, llvmFixupAsm ) where
7 #include "HsVersions.h"
11 import LlvmCodeGen.Base
12 import LlvmCodeGen.CodeGen
13 import LlvmCodeGen.Data
14 import LlvmCodeGen.Ppr
20 import CgUtils ( fixStgRegisters )
28 import qualified Pretty as Prt
34 -- -----------------------------------------------------------------------------
35 -- | Top-level of the LLVM Code generator
37 llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmm] -> IO ()
38 llvmCodeGen dflags h us cmms
39 = let cmm = concat $ map (\(Cmm top) -> top) cmms
40 (cdata,env) = foldr split ([],initLlvmEnv) cmm
41 split (CmmData s d' ) (d,e) = ((s,d'):d,e)
42 split (CmmProc i l _ _) (d,e) =
43 let lbl = strCLabel_llvm $ if not (null i)
44 then entryLblToInfoLbl l
46 env' = funInsert lbl llvmFunTy e
49 bufh <- newBufHandle h
50 Prt.bufLeftRender bufh $ pprLlvmHeader
52 env' <- cmmDataLlvmGens dflags bufh env cdata []
53 cmmProcLlvmGens dflags bufh us env' cmm 1 []
59 -- -----------------------------------------------------------------------------
60 -- | Do LLVM code generation on all these Cmms data sections.
62 cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [(Section,[CmmStatic])]
63 -> [LlvmUnresData] -> IO ( LlvmEnv )
65 cmmDataLlvmGens dflags h env [] lmdata
66 = let (env', lmdata') = resolveLlvmDatas env lmdata []
67 lmdoc = Prt.vcat $ map pprLlvmData lmdata'
69 dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" $ docToSDoc lmdoc
70 Prt.bufLeftRender h lmdoc
73 cmmDataLlvmGens dflags h env (cmm:cmms) lmdata
74 = let lmdata'@(l, _, ty, _) = genLlvmData cmm
75 env' = funInsert (strCLabel_llvm l) ty env
76 in cmmDataLlvmGens dflags h env' cmms (lmdata ++ [lmdata'])
79 -- -----------------------------------------------------------------------------
80 -- | Do LLVM code generation on all these Cmms procs.
82 cmmProcLlvmGens :: DynFlags -> BufHandle -> UniqSupply -> LlvmEnv -> [RawCmmTop]
83 -> Int -- ^ count, used for generating unique subsections
84 -> [LlvmVar] -- ^ info tables that need to be marked as 'used'
87 cmmProcLlvmGens _ _ _ _ [] _ []
90 cmmProcLlvmGens _ h _ _ [] _ ivars
91 = let cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr
92 ty = (LMArray (length ivars) i8Ptr)
93 usedArray = LMStaticArray (map cast ivars) ty
94 lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending
95 (Just $ fsLit "llvm.metadata") Nothing False, Just usedArray)
96 in Prt.bufLeftRender h $ pprLlvmData ([lmUsed], [])
98 cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars
100 (us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm
102 let (docs, ivar) = mapAndUnzip (pprLlvmCmmTop env' count) llvm
103 Prt.bufLeftRender h $ Prt.vcat docs
105 cmmProcLlvmGens dflags h us' env' cmms (count + 2) (concat ivar ++ ivars)
108 -- | Complete LLVM code generation phase for a single top-level chunk of Cmm.
109 cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmTop
110 -> IO ( UniqSupply, LlvmEnv, [LlvmCmmTop] )
111 cmmLlvmGen dflags us env cmm
113 -- rewrite assignments to global regs
114 let fixed_cmm = fixStgRegisters cmm
116 dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm"
117 (pprCmm $ Cmm [fixed_cmm])
119 -- generate llvm code from cmm
120 let ((env', llvmBC), usGen) = initUs us $ genLlvmProc env fixed_cmm
122 dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code"
123 (vcat $ map (docToSDoc . fst . pprLlvmCmmTop env' 0) llvmBC)
125 return (usGen, env', llvmBC)