Add '-freg-liveness' flag to control if STG liveness information
[ghc.git] / compiler / llvmGen / LlvmCodeGen.hs
1 -- -----------------------------------------------------------------------------
2 -- | This is the top-level module in the LLVM code generator.
3 --
4
5 module LlvmCodeGen ( llvmCodeGen, llvmFixupAsm ) where
6
7 #include "HsVersions.h"
8
9 import Llvm
10 import LlvmCodeGen.Base
11 import LlvmCodeGen.CodeGen
12 import LlvmCodeGen.Data
13 import LlvmCodeGen.Ppr
14 import LlvmMangler
15
16 import CgUtils ( fixStgRegisters )
17 import OldCmm
18 import OldPprCmm
19
20 import BufWrite
21 import DynFlags
22 import ErrUtils
23 import FastString
24 import Outputable
25 import qualified Pretty as Prt
26 import UniqSupply
27 import Util
28 import SysTools ( figureLlvmVersion )
29
30 import Data.Maybe ( fromMaybe )
31 import System.IO
32
33 -- -----------------------------------------------------------------------------
34 -- | Top-level of the LLVM Code generator
35 --
36 llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmmGroup] -> IO ()
37 llvmCodeGen dflags h us cmms
38 = let cmm = concat cmms
39 (cdata,env) = {-# SCC "llvm_split" #-}
40 foldr split ([], initLlvmEnv dflags) cmm
41 split (CmmData s d' ) (d,e) = ((s,d'):d,e)
42 split (CmmProc i l _) (d,e) =
43 let lbl = strCLabel_llvm env $ case i of
44 Nothing -> l
45 Just (Statics info_lbl _) -> info_lbl
46 env' = funInsert lbl llvmFunTy e
47 in (d,env')
48 in do
49 showPass dflags "LlVM CodeGen"
50 bufh <- newBufHandle h
51 dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" $ docToSDoc pprLlvmHeader
52 Prt.bufLeftRender bufh $ pprLlvmHeader
53 ver <- (fromMaybe defaultLlvmVersion) `fmap` figureLlvmVersion dflags
54 env' <- {-# SCC "llvm_datas_gen" #-}
55 cmmDataLlvmGens dflags bufh (setLlvmVer ver env) cdata []
56 {-# SCC "llvm_procs_gen" #-}
57 cmmProcLlvmGens dflags bufh us env' cmm 1 []
58 bFlush bufh
59 return ()
60
61
62 -- -----------------------------------------------------------------------------
63 -- | Do LLVM code generation on all these Cmms data sections.
64 --
65 cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [(Section,CmmStatics)]
66 -> [LlvmUnresData] -> IO ( LlvmEnv )
67
68 cmmDataLlvmGens dflags h env [] lmdata
69 = let (env', lmdata') = {-# SCC "llvm_resolve" #-}
70 resolveLlvmDatas env lmdata
71 lmdoc = {-# SCC "llvm_data_ppr" #-}
72 Prt.vcat $ map pprLlvmData lmdata'
73 in do
74 dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" $ docToSDoc lmdoc
75 {-# SCC "llvm_data_out" #-}
76 Prt.bufLeftRender h lmdoc
77 return env'
78
79 cmmDataLlvmGens dflags h env (cmm:cmms) lmdata
80 = let lm@(l, _, ty, _) = {-# SCC "llvm_data_gen" #-}
81 genLlvmData env cmm
82 env' = {-# SCC "llvm_data_insert" #-}
83 funInsert (strCLabel_llvm env l) ty env
84 lmdata' = {-# SCC "llvm_data_append" #-}
85 lm:lmdata
86 in cmmDataLlvmGens dflags h env' cmms lmdata'
87
88
89 -- -----------------------------------------------------------------------------
90 -- | Do LLVM code generation on all these Cmms procs.
91 --
92 cmmProcLlvmGens :: DynFlags -> BufHandle -> UniqSupply -> LlvmEnv -> [RawCmmDecl]
93 -> Int -- ^ count, used for generating unique subsections
94 -> [[LlvmVar]] -- ^ info tables that need to be marked as 'used'
95 -> IO ()
96
97 cmmProcLlvmGens _ _ _ _ [] _ []
98 = return ()
99
100 cmmProcLlvmGens _ h _ _ [] _ ivars
101 = let ivars' = concat ivars
102 cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr
103 ty = (LMArray (length ivars') i8Ptr)
104 usedArray = LMStaticArray (map cast ivars') ty
105 lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending
106 (Just $ fsLit "llvm.metadata") Nothing False, Just usedArray)
107 in Prt.bufLeftRender h $ {-# SCC "llvm_used_ppr" #-}
108 pprLlvmData ([lmUsed], [])
109
110 cmmProcLlvmGens dflags h us env ((CmmData _ _) : cmms) count ivars
111 = cmmProcLlvmGens dflags h us env cmms count ivars
112
113 cmmProcLlvmGens dflags h us env ((CmmProc _ _ (ListGraph [])) : cmms) count ivars
114 = cmmProcLlvmGens dflags h us env cmms count ivars
115
116 cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars = do
117 (us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm
118 let (docs, ivar) = mapAndUnzip (pprLlvmCmmDecl env' count) llvm
119 Prt.bufLeftRender h $ {-# SCC "llvm_proc_ppr" #-} Prt.vcat docs
120 cmmProcLlvmGens dflags h us' env' cmms (count + 2) (ivar ++ ivars)
121
122
123 -- | Complete LLVM code generation phase for a single top-level chunk of Cmm.
124 cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmDecl
125 -> IO ( UniqSupply, LlvmEnv, [LlvmCmmDecl] )
126 cmmLlvmGen dflags us env cmm = do
127 -- rewrite assignments to global regs
128 let fixed_cmm = {-# SCC "llvm_fix_regs" #-}
129 fixStgRegisters cmm
130
131 dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm"
132 (pprCmmGroup (targetPlatform dflags) [fixed_cmm])
133
134 -- generate llvm code from cmm
135 let ((env', llvmBC), usGen) = {-# SCC "llvm_proc_gen" #-}
136 initUs us $ genLlvmProc env fixed_cmm
137
138 dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code"
139 (vcat $ map (docToSDoc . fst . pprLlvmCmmDecl env' 0) llvmBC)
140
141 return (usGen, env', llvmBC)
142