1 -----------------------------------------------------------------------------
3 -- Stg to C-- code generation
5 -- (c) The University of Glasgow 2004-2006
7 -----------------------------------------------------------------------------
9 module StgCmm ( codeGen ) where
11 #define FAST_STRING_NOT_NEEDED
12 #include "HsVersions.h"
49 -> CollectedCCs -- (Local/global) cost-centres needing declaring/registering.
50 -> [(StgBinding,[(Id,[Id])])] -- Bindings to convert, with SRTs
54 codeGen dflags this_mod data_tycons
55 cost_centre_info stg_binds hpc_info
56 = do { showPass dflags "New CodeGen"
59 -- ; mapM_ (\x -> seq x (return ())) data_tycons
61 ; code_stuff <- initC dflags this_mod $ do
62 { cmm_binds <- mapM (getCmm . cgTopBinding dflags) stg_binds
63 ; cmm_tycons <- mapM cgTyCon data_tycons
64 ; cmm_init <- getCmm (mkModuleInit cost_centre_info
66 ; return (cmm_init : cmm_binds ++ concat cmm_tycons)
68 -- Put datatype_stuff after code_stuff, because the
69 -- datatype closure table (for enumeration types) to
70 -- (say) PrelBase_True_closure, which is defined in
73 -- N.B. returning '[Cmm]' and not 'Cmm' here makes it
74 -- possible for object splitting to split up the
77 -- Note [codegen-split-init] the cmm_init block must
78 -- come FIRST. This is because when -split-objs is on
79 -- we need to combine this block with its
80 -- initialisation routines; see Note
81 -- [pipeline-split-init].
83 ; dumpIfSet_dyn dflags Opt_D_dump_cmmz "New Cmm" (pprCmms code_stuff)
88 ---------------------------------------------------------------
90 ---------------------------------------------------------------
92 {- 'cgTopBinding' is only used for top-level bindings, since they need
93 to be allocated statically (not in the heap) and need to be labelled.
94 No unboxed bindings can happen at top level.
96 In the code below, the static bindings are accumulated in the
97 @MkCgState@, and transferred into the ``statics'' slot by @forkStatics@.
98 This is so that we can write the top level processing in a compositional
99 style, with the increasing static environment being plumbed as a state
102 cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> FCode ()
103 cgTopBinding dflags (StgNonRec id rhs, _srts)
104 = do { id' <- maybeExternaliseId dflags id
105 ; info <- cgTopRhs id' rhs
106 ; addBindC (cg_id info) info -- Add the *un-externalised* Id to the envt,
107 -- so we find it when we look up occurrences
110 cgTopBinding dflags (StgRec pairs, _srts)
111 = do { let (bndrs, rhss) = unzip pairs
112 ; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs
113 ; let pairs' = zip bndrs' rhss
114 ; fixC_(\ new_binds -> do
115 { addBindsC new_binds
116 ; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' })
119 -- Urgh! I tried moving the forkStatics call from the rhss of cgTopRhs
120 -- to enclose the listFCs in cgTopBinding, but that tickled the
121 -- statics "error" call in initC. I DON'T UNDERSTAND WHY!
123 cgTopRhs :: Id -> StgRhs -> FCode CgIdInfo
124 -- The Id is passed along for setting up a binding...
125 -- It's already been externalised if necessary
127 cgTopRhs bndr (StgRhsCon _cc con args)
128 = forkStatics (cgTopRhsCon bndr con args)
130 cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag srt args body)
131 = ASSERT(null fvs) -- There should be no free variables
132 setSRTLabel (mkSRTLabel (idName bndr) (idCafInfo bndr)) $
133 forkStatics (cgTopRhsClosure bndr cc bi upd_flag srt args body)
136 ---------------------------------------------------------------
137 -- Module initialisation code
138 ---------------------------------------------------------------
140 {- The module initialisation code looks like this, roughly:
143 JMP_(__stginit_Foo_1_p)
146 FN(__stginit_Foo_1_p) {
150 We have one version of the init code with a module version and the
151 'way' attached to it. The version number helps to catch cases
152 where modules are not compiled in dependency order before being
153 linked: if a module has been compiled since any modules which depend on
154 it, then the latter modules will refer to a different version in their
155 init blocks and a link error will ensue.
157 The 'way' suffix helps to catch cases where modules compiled in different
158 ways are linked together (eg. profiled and non-profiled).
160 We provide a plain, unadorned, version of the module init code
161 which just jumps to the version with the label and way attached. The
162 reason for this is that when using foreign exports, the caller of
163 startupHaskell() must supply the name of the init function for the "top"
164 module in the program, and we don't want to require that this name
165 has the version and way info appended to it.
167 We initialise the module tree by keeping a work-stack,
169 * that grows downward
170 * Sp points to the last occupied slot
174 :: CollectedCCs -- cost centre info
179 mkModuleInit cost_centre_info this_mod hpc_info
180 = do { initHpc this_mod hpc_info
181 ; initCostCentres cost_centre_info
182 -- For backwards compatibility: user code may refer to this
183 -- label for calling hs_add_root().
184 ; emitSimpleProc (mkPlainModuleInitLabel this_mod) $ emptyAGraph
187 ---------------------------------------------------------------
188 -- Generating static stuff for algebraic data types
189 ---------------------------------------------------------------
191 {- [These comments are rather out of date]
193 Macro Kind of constructor
194 CONST_INFO_TABLE@ Zero arity (no info -- compiler uses static closure)
195 CHARLIKE_INFO_TABLE Charlike (no info -- compiler indexes fixed array)
196 INTLIKE_INFO_TABLE Intlike; the one macro generates both info tbls
197 SPEC_INFO_TABLE SPECish, and bigger than or equal to MIN_UPD_SIZE
198 GEN_INFO_TABLE GENish (hence bigger than or equal to MIN_UPD_SIZE@)
200 Possible info tables for constructor con:
203 Used for dynamically let(rec)-bound occurrences of
204 the constructor, and for updates. For constructors
205 which are int-like, char-like or nullary, when GC occurs,
206 the closure tries to get rid of itself.
209 Static occurrences of the constructor macro: STATIC_INFO_TABLE.
211 For zero-arity constructors, \tr{con}, we NO LONGER generate a static closure;
212 it's place is taken by the top level defn of the constructor.
214 For charlike and intlike closures there is a fixed array of static
215 closures predeclared.
218 cgTyCon :: TyCon -> FCode [Cmm] -- All constructors merged together
220 = do { constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon)
222 -- Generate a table of static closures for an enumeration type
223 -- Put the table after the data constructor decls, because the
224 -- datatype closure table (for enumeration types)
225 -- to (say) PrelBase_$wTrue_closure, which is defined in code_stuff
226 -- Note that the closure pointers are tagged.
228 -- N.B. comment says to put table after constructor decls, but
229 -- code puts it before --- NR 16 Aug 2007
230 ; extra <- cgEnumerationTyCon tycon
232 ; return (extra ++ constrs)
235 cgEnumerationTyCon :: TyCon -> FCode [Cmm]
236 cgEnumerationTyCon tycon
237 | isEnumerationTyCon tycon
238 = do { tbl <- getCmm $
239 emitRODataLits (mkLocalClosureTableLabel (tyConName tycon) NoCafRefs)
240 [ CmmLabelOff (mkLocalClosureLabel (dataConName con) NoCafRefs)
242 | con <- tyConDataCons tycon]
247 cgDataCon :: DataCon -> FCode ()
248 -- Generate the entry code, info tables, and (for niladic constructor)
249 -- the static closure, for a constructor.
252 -- To allow the debuggers, interpreters, etc to cope with
253 -- static data structures (ie those built at compile
254 -- time), we take care that info-table contains the
255 -- information we need.
256 (static_cl_info, _) = layOutStaticConstr data_con arg_reps
257 (dyn_cl_info, arg_things) = layOutDynConstr data_con arg_reps
259 emit_info cl_info ticky_code
260 = emitClosureAndInfoTable cl_info NativeDirectCall []
264 = -- NB: We don't set CC when entering data (WDP 94/06)
266 ; ldvEnter (CmmReg nodeReg)
267 ; tickyReturnOldCon (length arg_things)
268 ; emitReturn [cmmOffsetB (CmmReg nodeReg)
269 (tagForCon data_con)] }
270 -- The case continuation code expects a tagged pointer
272 arg_reps :: [(PrimRep, Type)]
273 arg_reps = [(typePrimRep ty, ty) | ty <- dataConRepArgTys data_con]
275 -- Dynamic closure code for non-nullary constructors only
276 ; whenC (not (isNullaryRepDataCon data_con))
277 (emit_info dyn_cl_info tickyEnterDynCon)
279 -- Dynamic-Closure first, to reduce forward references
280 ; emit_info static_cl_info tickyEnterStaticCon }
283 ---------------------------------------------------------------
284 -- Stuff to support splitting
285 ---------------------------------------------------------------
287 -- If we're splitting the object, we need to externalise all the
288 -- top-level names (and then make sure we only use the externalised
289 -- one in any C label we use which refers to this name).
291 maybeExternaliseId :: DynFlags -> Id -> FCode Id
292 maybeExternaliseId dflags id
293 | dopt Opt_SplitObjs dflags, -- Externalise the name for -split-objs
294 isInternalName name = do { mod <- getModuleName
295 ; returnFC (setIdName id (externalise mod)) }
296 | otherwise = returnFC id
298 externalise mod = mkExternalName uniq mod new_occ loc
300 uniq = nameUnique name
301 new_occ = mkLocalOcc uniq (nameOccName name)
302 loc = nameSrcSpan name
303 -- We want to conjure up a name that can't clash with any
304 -- existing name. So we generate
306 -- where 243 is the unique.