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