Add a class HasDynFlags(getDynFlags)
[ghc.git] / compiler / codeGen / StgCmm.hs
1 -----------------------------------------------------------------------------
2 --
3 -- Stg to C-- code generation
4 --
5 -- (c) The University of Glasgow 2004-2006
6 --
7 -----------------------------------------------------------------------------
8
9 {-# OPTIONS -fno-warn-tabs #-}
10 -- The above warning supression flag is a temporary kludge.
11 -- While working on this module you are encouraged to remove it and
12 -- detab the module (please do the detabbing in a separate patch). See
13 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
14 -- for details
15
16 module StgCmm ( codeGen ) where
17
18 #define FAST_STRING_NOT_NEEDED
19 #include "HsVersions.h"
20
21 import StgCmmProf
22 import StgCmmMonad
23 import StgCmmEnv
24 import StgCmmBind
25 import StgCmmCon
26 import StgCmmLayout
27 import StgCmmUtils
28 import StgCmmClosure
29 import StgCmmHpc
30 import StgCmmTicky
31
32 import Cmm
33 import CLabel
34
35 import StgSyn
36 import DynFlags
37
38 import HscTypes
39 import CostCentre
40 import Id
41 import IdInfo
42 import Type
43 import DataCon
44 import Name
45 import TyCon
46 import Module
47 import ErrUtils
48 import Outputable
49
50 codeGen :: DynFlags
51 -> Module
52 -> [TyCon]
53 -> CollectedCCs -- (Local/global) cost-centres needing declaring/registering.
54 -> [(StgBinding,[(Id,[Id])])] -- Bindings to convert, with SRTs
55 -> HpcInfo
56 -> IO [CmmGroup] -- Output
57
58 codeGen dflags this_mod data_tycons
59 cost_centre_info stg_binds hpc_info
60 = do { showPass dflags "New CodeGen"
61
62 -- Why?
63 -- ; mapM_ (\x -> seq x (return ())) data_tycons
64
65 ; code_stuff <- initC dflags this_mod $ do
66 { cmm_binds <- mapM (getCmm . cgTopBinding dflags) stg_binds
67 ; cmm_tycons <- mapM cgTyCon data_tycons
68 ; cmm_init <- getCmm (mkModuleInit cost_centre_info
69 this_mod hpc_info)
70 ; return (cmm_init : cmm_binds ++ cmm_tycons)
71 }
72 -- Put datatype_stuff after code_stuff, because the
73 -- datatype closure table (for enumeration types) to
74 -- (say) PrelBase_True_closure, which is defined in
75 -- code_stuff
76
77 -- N.B. returning '[Cmm]' and not 'Cmm' here makes it
78 -- possible for object splitting to split up the
79 -- pieces later.
80
81 -- Note [codegen-split-init] the cmm_init block must
82 -- come FIRST. This is because when -split-objs is on
83 -- we need to combine this block with its
84 -- initialisation routines; see Note
85 -- [pipeline-split-init].
86
87 ; return code_stuff }
88
89
90 ---------------------------------------------------------------
91 -- Top-level bindings
92 ---------------------------------------------------------------
93
94 {- 'cgTopBinding' is only used for top-level bindings, since they need
95 to be allocated statically (not in the heap) and need to be labelled.
96 No unboxed bindings can happen at top level.
97
98 In the code below, the static bindings are accumulated in the
99 @MkCgState@, and transferred into the ``statics'' slot by @forkStatics@.
100 This is so that we can write the top level processing in a compositional
101 style, with the increasing static environment being plumbed as a state
102 variable. -}
103
104 cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> FCode ()
105 cgTopBinding dflags (StgNonRec id rhs, _srts)
106 = do { id' <- maybeExternaliseId dflags id
107 ; info <- cgTopRhs id' rhs
108 ; addBindC (cg_id info) info -- Add the *un-externalised* Id to the envt,
109 -- so we find it when we look up occurrences
110 }
111
112 cgTopBinding dflags (StgRec pairs, _srts)
113 = do { let (bndrs, rhss) = unzip pairs
114 ; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs
115 ; let pairs' = zip bndrs' rhss
116 ; fixC_(\ new_binds -> do
117 { addBindsC new_binds
118 ; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' })
119 ; return () }
120
121 -- Urgh! I tried moving the forkStatics call from the rhss of cgTopRhs
122 -- to enclose the listFCs in cgTopBinding, but that tickled the
123 -- statics "error" call in initC. I DON'T UNDERSTAND WHY!
124
125 cgTopRhs :: Id -> StgRhs -> FCode CgIdInfo
126 -- The Id is passed along for setting up a binding...
127 -- It's already been externalised if necessary
128
129 cgTopRhs bndr (StgRhsCon _cc con args)
130 = forkStatics (cgTopRhsCon bndr con args)
131
132 cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag srt args body)
133 = ASSERT(null fvs) -- There should be no free variables
134 setSRTLabel (mkSRTLabel (idName bndr) (idCafInfo bndr)) $
135 forkStatics (cgTopRhsClosure bndr cc bi upd_flag srt args body)
136
137
138 ---------------------------------------------------------------
139 -- Module initialisation code
140 ---------------------------------------------------------------
141
142 {- The module initialisation code looks like this, roughly:
143
144 FN(__stginit_Foo) {
145 JMP_(__stginit_Foo_1_p)
146 }
147
148 FN(__stginit_Foo_1_p) {
149 ...
150 }
151
152 We have one version of the init code with a module version and the
153 'way' attached to it. The version number helps to catch cases
154 where modules are not compiled in dependency order before being
155 linked: if a module has been compiled since any modules which depend on
156 it, then the latter modules will refer to a different version in their
157 init blocks and a link error will ensue.
158
159 The 'way' suffix helps to catch cases where modules compiled in different
160 ways are linked together (eg. profiled and non-profiled).
161
162 We provide a plain, unadorned, version of the module init code
163 which just jumps to the version with the label and way attached. The
164 reason for this is that when using foreign exports, the caller of
165 startupHaskell() must supply the name of the init function for the "top"
166 module in the program, and we don't want to require that this name
167 has the version and way info appended to it.
168
169 We initialise the module tree by keeping a work-stack,
170 * pointed to by Sp
171 * that grows downward
172 * Sp points to the last occupied slot
173 -}
174
175 mkModuleInit
176 :: CollectedCCs -- cost centre info
177 -> Module
178 -> HpcInfo
179 -> FCode ()
180
181 mkModuleInit cost_centre_info this_mod hpc_info
182 = do { initHpc this_mod hpc_info
183 ; initCostCentres cost_centre_info
184 -- For backwards compatibility: user code may refer to this
185 -- label for calling hs_add_root().
186 ; emitDecl (CmmData Data (Statics (mkPlainModuleInitLabel this_mod) []))
187 }
188
189 ---------------------------------------------------------------
190 -- Generating static stuff for algebraic data types
191 ---------------------------------------------------------------
192
193 {- [These comments are rather out of date]
194
195 Macro Kind of constructor
196 CONST_INFO_TABLE@ Zero arity (no info -- compiler uses static closure)
197 CHARLIKE_INFO_TABLE Charlike (no info -- compiler indexes fixed array)
198 INTLIKE_INFO_TABLE Intlike; the one macro generates both info tbls
199 SPEC_INFO_TABLE SPECish, and bigger than or equal to MIN_UPD_SIZE
200 GEN_INFO_TABLE GENish (hence bigger than or equal to MIN_UPD_SIZE@)
201
202 Possible info tables for constructor con:
203
204 * _con_info:
205 Used for dynamically let(rec)-bound occurrences of
206 the constructor, and for updates. For constructors
207 which are int-like, char-like or nullary, when GC occurs,
208 the closure tries to get rid of itself.
209
210 * _static_info:
211 Static occurrences of the constructor macro: STATIC_INFO_TABLE.
212
213 For zero-arity constructors, \tr{con}, we NO LONGER generate a static closure;
214 it's place is taken by the top level defn of the constructor.
215
216 For charlike and intlike closures there is a fixed array of static
217 closures predeclared.
218 -}
219
220 cgTyCon :: TyCon -> FCode CmmGroup -- All constructors merged together
221 cgTyCon tycon
222 = do { constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon)
223
224 -- Generate a table of static closures for an enumeration type
225 -- Put the table after the data constructor decls, because the
226 -- datatype closure table (for enumeration types)
227 -- to (say) PrelBase_$wTrue_closure, which is defined in code_stuff
228 -- Note that the closure pointers are tagged.
229
230 -- N.B. comment says to put table after constructor decls, but
231 -- code puts it before --- NR 16 Aug 2007
232 ; extra <- cgEnumerationTyCon tycon
233
234 ; return (concat (extra ++ constrs))
235 }
236
237 cgEnumerationTyCon :: TyCon -> FCode [CmmGroup]
238 cgEnumerationTyCon tycon
239 | isEnumerationTyCon tycon
240 = do { tbl <- getCmm $
241 emitRODataLits (mkLocalClosureTableLabel (tyConName tycon) NoCafRefs)
242 [ CmmLabelOff (mkLocalClosureLabel (dataConName con) NoCafRefs)
243 (tagForCon con)
244 | con <- tyConDataCons tycon]
245 ; return [tbl] }
246 | otherwise
247 = return []
248
249 cgDataCon :: DataCon -> FCode ()
250 -- Generate the entry code, info tables, and (for niladic constructor)
251 -- the static closure, for a constructor.
252 cgDataCon data_con
253 = do { let
254 (tot_wds, -- #ptr_wds + #nonptr_wds
255 ptr_wds, -- #ptr_wds
256 arg_things) = mkVirtConstrOffsets arg_reps
257
258 nonptr_wds = tot_wds - ptr_wds
259
260 sta_info_tbl = mkDataConInfoTable data_con True ptr_wds nonptr_wds
261 dyn_info_tbl = mkDataConInfoTable data_con False ptr_wds nonptr_wds
262
263 emit_info info_tbl ticky_code
264 = emitClosureAndInfoTable info_tbl NativeDirectCall []
265 $ mk_code ticky_code
266
267 mk_code ticky_code
268 = -- NB: We don't set CC when entering data (WDP 94/06)
269 do { _ <- ticky_code
270 ; ldvEnter (CmmReg nodeReg)
271 ; tickyReturnOldCon (length arg_things)
272 ; emitReturn [cmmOffsetB (CmmReg nodeReg)
273 (tagForCon data_con)] }
274 -- The case continuation code expects a tagged pointer
275
276 arg_reps :: [(PrimRep, Type)]
277 arg_reps = [(typePrimRep ty, ty) | ty <- dataConRepArgTys data_con]
278
279 -- Dynamic closure code for non-nullary constructors only
280 ; whenC (not (isNullaryRepDataCon data_con))
281 (emit_info dyn_info_tbl tickyEnterDynCon)
282
283 -- Dynamic-Closure first, to reduce forward references
284 ; emit_info sta_info_tbl tickyEnterStaticCon }
285
286
287 ---------------------------------------------------------------
288 -- Stuff to support splitting
289 ---------------------------------------------------------------
290
291 -- If we're splitting the object, we need to externalise all the
292 -- top-level names (and then make sure we only use the externalised
293 -- one in any C label we use which refers to this name).
294
295 maybeExternaliseId :: DynFlags -> Id -> FCode Id
296 maybeExternaliseId dflags id
297 | dopt Opt_SplitObjs dflags, -- Externalise the name for -split-objs
298 isInternalName name = do { mod <- getModuleName
299 ; returnFC (setIdName id (externalise mod)) }
300 | otherwise = returnFC id
301 where
302 externalise mod = mkExternalName uniq mod new_occ loc
303 name = idName id
304 uniq = nameUnique name
305 new_occ = mkLocalOcc uniq (nameOccName name)
306 loc = nameSrcSpan name
307 -- We want to conjure up a name that can't clash with any
308 -- existing name. So we generate
309 -- Mod_$L243foo
310 -- where 243 is the unique.