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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
-- -----------------------------------------------------------------------------
-- | This is the top-level module in the LLVM code generator.
--
module LlvmCodeGen ( llvmCodeGen, llvmFixupAsm ) where
#include "HsVersions.h"
import Llvm
import LlvmCodeGen.Base
import LlvmCodeGen.CodeGen
import LlvmCodeGen.Data
import LlvmCodeGen.Ppr
import LlvmMangler
import CgUtils ( fixStgRegisters )
import OldCmm
import OldPprCmm
import BufWrite
import DynFlags
import ErrUtils
import FastString
import Outputable
import qualified Pretty as Prt
import UniqSupply
import Util
import SysTools ( figureLlvmVersion )
import Data.IORef ( writeIORef )
import Data.Maybe ( fromMaybe )
import System.IO
-- -----------------------------------------------------------------------------
-- | Top-level of the LLVM Code generator
--
llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmmGroup] -> IO ()
llvmCodeGen dflags h us cmms
= let cmm = concat cmms
(cdata,env) = {-# SCC "llvm_split" #-}
foldr split ([], initLlvmEnv dflags) cmm
split (CmmData s d' ) (d,e) = ((s,d'):d,e)
split (CmmProc i l _) (d,e) =
let lbl = strCLabel_llvm env $ case i of
Nothing -> l
Just (Statics info_lbl _) -> info_lbl
env' = funInsert lbl llvmFunTy e
in (d,env')
in do
showPass dflags "LlVM CodeGen"
dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" $ docToSDoc pprLlvmHeader
bufh <- newBufHandle h
Prt.bufLeftRender bufh $ pprLlvmHeader
ver <- (fromMaybe defaultLlvmVersion) `fmap` figureLlvmVersion dflags
-- cache llvm version for later use
writeIORef (llvmVersion dflags) ver
env' <- {-# SCC "llvm_datas_gen" #-}
cmmDataLlvmGens dflags bufh (setLlvmVer ver env) cdata []
{-# SCC "llvm_procs_gen" #-}
cmmProcLlvmGens dflags bufh us env' cmm 1 []
bFlush bufh
return ()
-- -----------------------------------------------------------------------------
-- | Do LLVM code generation on all these Cmms data sections.
--
cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [(Section,CmmStatics)]
-> [LlvmUnresData] -> IO ( LlvmEnv )
cmmDataLlvmGens dflags h env [] lmdata
= let (env', lmdata') = {-# SCC "llvm_resolve" #-}
resolveLlvmDatas env lmdata
lmdoc = {-# SCC "llvm_data_ppr" #-}
Prt.vcat $ map pprLlvmData lmdata'
in do
dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" $ docToSDoc lmdoc
{-# SCC "llvm_data_out" #-}
Prt.bufLeftRender h lmdoc
return env'
cmmDataLlvmGens dflags h env (cmm:cmms) lmdata
= let lm@(l, _, ty, _) = {-# SCC "llvm_data_gen" #-}
genLlvmData env cmm
env' = {-# SCC "llvm_data_insert" #-}
funInsert (strCLabel_llvm env l) ty env
lmdata' = {-# SCC "llvm_data_append" #-}
lm:lmdata
in cmmDataLlvmGens dflags h env' cmms lmdata'
-- -----------------------------------------------------------------------------
-- | Do LLVM code generation on all these Cmms procs.
--
cmmProcLlvmGens :: DynFlags -> BufHandle -> UniqSupply -> LlvmEnv -> [RawCmmDecl]
-> Int -- ^ count, used for generating unique subsections
-> [[LlvmVar]] -- ^ info tables that need to be marked as 'used'
-> IO ()
cmmProcLlvmGens _ _ _ _ [] _ []
= return ()
cmmProcLlvmGens _ h _ _ [] _ ivars
= let ivars' = concat ivars
cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr
ty = (LMArray (length ivars') i8Ptr)
usedArray = LMStaticArray (map cast ivars') ty
lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending
(Just $ fsLit "llvm.metadata") Nothing False, Just usedArray)
in Prt.bufLeftRender h $ {-# SCC "llvm_used_ppr" #-}
pprLlvmData ([lmUsed], [])
cmmProcLlvmGens dflags h us env ((CmmData _ _) : cmms) count ivars
= cmmProcLlvmGens dflags h us env cmms count ivars
cmmProcLlvmGens dflags h us env ((CmmProc _ _ (ListGraph [])) : cmms) count ivars
= cmmProcLlvmGens dflags h us env cmms count ivars
cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars = do
(us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm
let (docs, ivar) = mapAndUnzip (pprLlvmCmmDecl env' count) llvm
Prt.bufLeftRender h $ {-# SCC "llvm_proc_ppr" #-} Prt.vcat docs
cmmProcLlvmGens dflags h us' env' cmms (count + 2) (ivar ++ ivars)
-- | Complete LLVM code generation phase for a single top-level chunk of Cmm.
cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmDecl
-> IO ( UniqSupply, LlvmEnv, [LlvmCmmDecl] )
cmmLlvmGen dflags us env cmm = do
-- rewrite assignments to global regs
let fixed_cmm = {-# SCC "llvm_fix_regs" #-}
fixStgRegisters cmm
dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm"
(pprCmmGroup (targetPlatform dflags) [fixed_cmm])
-- generate llvm code from cmm
let ((env', llvmBC), usGen) = {-# SCC "llvm_proc_gen" #-}
initUs us $ genLlvmProc env fixed_cmm
dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code"
(vcat $ map (docToSDoc . fst . pprLlvmCmmDecl env' 0) llvmBC)
return (usGen, env', llvmBC)
|
