2 % (c) The GRASP Project, Glasgow University, 1992-1998
4 \section[CgCon]{Code generation for constructors}
6 This module provides the support code for @StgToAbstractC@ to deal
7 with {\em constructors} on the RHSs of let(rec)s. See also
8 @CgClosure@, which deals with closures.
12 cgTopRhsCon, buildDynCon,
13 bindConArgs, bindUnboxedTupleComponents,
18 #include "HsVersions.h"
23 import CgBindery ( getArgAmodes, bindNewToNode,
24 bindArgsToRegs, idInfoToAmode, stableIdInfo,
25 heapIdInfo, CgIdInfo, bindArgsToStack
27 import CgStackery ( mkVirtStkOffsets, freeStackSlots,
28 getRealSp, getVirtSp, setRealAndVirtualSp )
29 import CgUtils ( addIdReps, cmmLabelOffW, emitRODataLits, emitDataLits )
30 import CgCallConv ( assignReturnRegs )
31 import CgHeapery ( allocDynClosure, layOutDynConstr,
32 layOutStaticConstr, mkStaticClosureFields )
33 import CgTailCall ( performReturn, emitKnownConReturnCode, returnUnboxedTuple )
34 import CgProf ( mkCCostCentreStack, ldvEnter, curCCS )
36 import CgInfoTbls ( emitClosureCodeAndInfoTable, dataConTagZ )
38 import ClosureInfo ( mkConLFInfo, mkLFArgument )
39 import CmmUtils ( mkLblExpr )
41 import SMRep ( WordOff, CgRep, separateByPtrFollowness,
42 fixedHdrSize, typeCgRep )
43 import CostCentre ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
45 import Constants ( mIN_INTLIKE, mAX_INTLIKE, mIN_CHARLIKE, mAX_CHARLIKE )
46 import TyCon ( TyCon, tyConDataCons, isEnumerationTyCon, tyConName )
47 import DataCon ( DataCon, dataConRepArgTys, isNullaryRepDataCon,
48 isUnboxedTupleCon, dataConWorkId,
49 dataConName, dataConRepArity
51 import Id ( Id, idName, isDeadBinder )
53 import PrelInfo ( maybeCharLikeCon, maybeIntLikeCon )
55 import Util ( lengthIs )
56 import ListSetOps ( assocMaybe )
60 %************************************************************************
62 \subsection[toplevel-constructors]{Top-level constructors}
64 %************************************************************************
67 cgTopRhsCon :: Id -- Name of thing bound to this RHS
70 -> FCode (Id, CgIdInfo)
71 cgTopRhsCon id con args
73 ; this_pkg <- getThisPackage
75 -- Windows DLLs have a problem with static cross-DLL refs.
76 ; ASSERT( not (isDllConApp this_pkg con args) ) return ()
78 ; ASSERT( args `lengthIs` dataConRepArity con ) return ()
81 ; amodes <- getArgAmodes args
85 lf_info = mkConLFInfo con
86 closure_label = mkClosureLabel this_pkg name
87 caffy = any stgArgHasCafRefs args
88 (closure_info, amodes_w_offsets) = layOutStaticConstr this_pkg con amodes
89 closure_rep = mkStaticClosureFields
91 dontCareCCS -- Because it's static data
95 payload = map get_lit amodes_w_offsets
96 get_lit (CmmLit lit, _offset) = lit
97 get_lit other = pprPanic "CgCon.get_lit" (ppr other)
98 -- NB1: amodes_w_offsets is sorted into ptrs first, then non-ptrs
99 -- NB2: all the amodes should be Lits!
102 ; emitDataLits closure_label closure_rep
105 ; returnFC (id, stableIdInfo id (mkLblExpr closure_label) lf_info) }
108 %************************************************************************
110 %* non-top-level constructors *
112 %************************************************************************
113 \subsection[code-for-constructors]{The code for constructors}
116 buildDynCon :: Id -- Name of the thing to which this constr will
118 -> CostCentreStack -- Where to grab cost centre from;
119 -- current CCS if currentOrSubsumedCCS
120 -> DataCon -- The data constructor
121 -> [(CgRep,CmmExpr)] -- Its args
122 -> FCode CgIdInfo -- Return details about how to find it
124 -- We used to pass a boolean indicating whether all the
125 -- args were of size zero, so we could use a static
126 -- construtor; but I concluded that it just isn't worth it.
127 -- Now I/O uses unboxed tuples there just aren't any constructors
128 -- with all size-zero args.
130 -- The reason for having a separate argument, rather than looking at
131 -- the addr modes of the args is that we may be in a "knot", and
132 -- premature looking at the args will cause the compiler to black-hole!
135 First we deal with the case of zero-arity constructors. Now, they
136 will probably be unfolded, so we don't expect to see this case much,
137 if at all, but it does no harm, and sets the scene for characters.
139 In the case of zero-arity constructors, or, more accurately, those
140 which have exclusively size-zero (VoidRep) args, we generate no code
144 buildDynCon binder cc con []
145 = do this_pkg <- getThisPackage
146 returnFC (stableIdInfo binder
147 (mkLblExpr (mkClosureLabel this_pkg (dataConName con)))
151 The following three paragraphs about @Char@-like and @Int@-like
152 closures are obsolete, but I don't understand the details well enough
153 to properly word them, sorry. I've changed the treatment of @Char@s to
154 be analogous to @Int@s: only a subset is preallocated, because @Char@
155 has now 31 bits. Only literals are handled here. -- Qrczak
157 Now for @Char@-like closures. We generate an assignment of the
158 address of the closure to a temporary. It would be possible simply to
159 generate no code, and record the addressing mode in the environment,
160 but we'd have to be careful if the argument wasn't a constant --- so
161 for simplicity we just always asssign to a temporary.
163 Last special case: @Int@-like closures. We only special-case the
164 situation in which the argument is a literal in the range
165 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
166 work with any old argument, but for @Int@-like ones the argument has
167 to be a literal. Reason: @Char@ like closures have an argument type
168 which is guaranteed in range.
170 Because of this, we use can safely return an addressing mode.
173 buildDynCon binder cc con [arg_amode]
174 | maybeIntLikeCon con
175 , (_, CmmLit (CmmInt val _)) <- arg_amode
176 , let val_int = (fromIntegral val) :: Int
177 , val_int <= mAX_INTLIKE && val_int >= mIN_INTLIKE
178 = do { let intlike_lbl = mkRtsDataLabel SLIT("stg_INTLIKE_closure")
179 offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1)
180 -- INTLIKE closures consist of a header and one word payload
181 intlike_amode = CmmLit (cmmLabelOffW intlike_lbl offsetW)
182 ; returnFC (stableIdInfo binder intlike_amode (mkConLFInfo con)) }
184 buildDynCon binder cc con [arg_amode]
185 | maybeCharLikeCon con
186 , (_, CmmLit (CmmInt val _)) <- arg_amode
187 , let val_int = (fromIntegral val) :: Int
188 , val_int <= mAX_CHARLIKE && val_int >= mIN_CHARLIKE
189 = do { let charlike_lbl = mkRtsDataLabel SLIT("stg_CHARLIKE_closure")
190 offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize + 1)
191 -- CHARLIKE closures consist of a header and one word payload
192 charlike_amode = CmmLit (cmmLabelOffW charlike_lbl offsetW)
193 ; returnFC (stableIdInfo binder charlike_amode (mkConLFInfo con)) }
196 Now the general case.
199 buildDynCon binder ccs con args
201 ; this_pkg <- getThisPackage
203 (closure_info, amodes_w_offsets) = layOutDynConstr this_pkg con args
205 ; hp_off <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
206 ; returnFC (heapIdInfo binder hp_off lf_info) }
208 lf_info = mkConLFInfo con
210 use_cc -- cost-centre to stick in the object
211 | currentOrSubsumedCCS ccs = curCCS
212 | otherwise = CmmLit (mkCCostCentreStack ccs)
214 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
218 %************************************************************************
220 %* constructor-related utility function: *
221 %* bindConArgs is called from cgAlt of a case *
223 %************************************************************************
224 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
226 @bindConArgs@ $con args$ augments the environment with bindings for the
227 binders $args$, assuming that we have just returned from a @case@ which
231 bindConArgs :: DataCon -> [Id] -> Code
233 = do this_pkg <- getThisPackage
235 bind_arg (arg, offset) = bindNewToNode arg offset (mkLFArgument arg)
236 (_, args_w_offsets) = layOutDynConstr this_pkg con (addIdReps args)
238 ASSERT(not (isUnboxedTupleCon con)) return ()
239 mapCs bind_arg args_w_offsets
242 Unboxed tuples are handled slightly differently - the object is
243 returned in registers and on the stack instead of the heap.
246 bindUnboxedTupleComponents
248 -> FCode ([(Id,GlobalReg)], -- Regs assigned
249 WordOff, -- Number of pointer stack slots
250 WordOff, -- Number of non-pointer stack slots
251 VirtualSpOffset) -- Offset of return address slot
252 -- (= realSP on entry)
254 bindUnboxedTupleComponents args
259 -- Assign as many components as possible to registers
260 ; let (reg_args, stk_args) = assignReturnRegs (addIdReps args)
262 -- Separate the rest of the args into pointers and non-pointers
263 (ptr_args, nptr_args) = separateByPtrFollowness stk_args
265 -- Allocate the rest on the stack
266 -- The real SP points to the return address, above which any
267 -- leftover unboxed-tuple components will be allocated
268 (ptr_sp, ptr_offsets) = mkVirtStkOffsets rsp ptr_args
269 (nptr_sp, nptr_offsets) = mkVirtStkOffsets ptr_sp nptr_args
271 nptrs = nptr_sp - ptr_sp
273 -- The stack pointer points to the last stack-allocated component
274 ; setRealAndVirtualSp nptr_sp
276 -- We have just allocated slots starting at real SP + 1, and set the new
277 -- virtual SP to the topmost allocated slot.
278 -- If the virtual SP started *below* the real SP, we've just jumped over
279 -- some slots that won't be in the free-list, so put them there
280 -- This commonly happens because we've freed the return-address slot
281 -- (trimming back the virtual SP), but the real SP still points to that slot
282 ; freeStackSlots [vsp+1,vsp+2 .. rsp]
284 ; bindArgsToRegs reg_args
285 ; bindArgsToStack ptr_offsets
286 ; bindArgsToStack nptr_offsets
288 ; returnFC (reg_args, ptrs, nptrs, rsp) }
291 %************************************************************************
293 Actually generate code for a constructor return
295 %************************************************************************
298 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
299 sure the @amodes@ passed don't conflict with each other.
301 cgReturnDataCon :: DataCon -> [(CgRep, CmmExpr)] -> Code
303 cgReturnDataCon con amodes
304 = ASSERT( amodes `lengthIs` dataConRepArity con )
305 do { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
307 CaseAlts _ (Just (alts, deflt_lbl)) bndr _
308 -> -- Ho! We know the constructor so we can
309 -- go straight to the right alternative
310 case assocMaybe alts (dataConTagZ con) of {
311 Just join_lbl -> build_it_then (jump_to join_lbl);
313 -- Special case! We're returning a constructor to the default case
314 -- of an enclosing case. For example:
316 -- case (case e of (a,b) -> C a b) of
318 -- y -> ...<returning here!>...
321 -- if the default is a non-bind-default (ie does not use y),
322 -- then we should simply jump to the default join point;
324 | isDeadBinder bndr -> performReturn (jump_to deflt_lbl)
325 | otherwise -> build_it_then (jump_to deflt_lbl) }
327 other_sequel -- The usual case
328 | isUnboxedTupleCon con -> returnUnboxedTuple amodes
329 | otherwise -> build_it_then (emitKnownConReturnCode con)
332 jump_to lbl = stmtC (CmmJump (CmmLit lbl) [])
333 build_it_then return_code
334 = do { -- BUILD THE OBJECT IN THE HEAP
335 -- The first "con" says that the name bound to this
336 -- closure is "con", which is a bit of a fudge, but it only
339 -- This Id is also used to get a unique for a
340 -- temporary variable, if the closure is a CHARLIKE.
341 -- funnily enough, this makes the unique always come
343 tickyReturnNewCon (length amodes)
344 ; idinfo <- buildDynCon (dataConWorkId con) currentCCS con amodes
345 ; amode <- idInfoToAmode idinfo
346 ; checkedAbsC (CmmAssign nodeReg amode)
347 ; performReturn return_code }
351 %************************************************************************
353 Generating static stuff for algebraic data types
355 %************************************************************************
357 [These comments are rather out of date]
360 Info tbls & Macro & Kind of constructor \\
362 info & @CONST_INFO_TABLE@& Zero arity (no info -- compiler uses static closure)\\
363 info & @CHARLIKE_INFO_TABLE@& Charlike (no info -- compiler indexes fixed array)\\
364 info & @INTLIKE_INFO_TABLE@& Intlike; the one macro generates both info tbls\\
365 info & @SPEC_INFO_TABLE@& SPECish, and bigger than or equal to @MIN_UPD_SIZE@\\
366 info & @GEN_INFO_TABLE@& GENish (hence bigger than or equal to @MIN_UPD_SIZE@)\\
369 Possible info tables for constructor con:
373 Used for dynamically let(rec)-bound occurrences of
374 the constructor, and for updates. For constructors
375 which are int-like, char-like or nullary, when GC occurs,
376 the closure tries to get rid of itself.
378 \item[@_static_info@:]
379 Static occurrences of the constructor
380 macro: @STATIC_INFO_TABLE@.
383 For zero-arity constructors, \tr{con}, we NO LONGER generate a static closure;
384 it's place is taken by the top level defn of the constructor.
386 For charlike and intlike closures there is a fixed array of static
387 closures predeclared.
390 cgTyCon :: TyCon -> FCode [Cmm] -- each constructor gets a separate Cmm
392 = do { constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon)
394 -- Generate a table of static closures for an enumeration type
395 -- Put the table after the data constructor decls, because the
396 -- datatype closure table (for enumeration types)
397 -- to (say) PrelBase_$wTrue_closure, which is defined in code_stuff
399 if isEnumerationTyCon tycon then do
400 tbl <- getCmm (emitRODataLits (mkLocalClosureTableLabel
402 [ CmmLabel (mkLocalClosureLabel (dataConName con))
403 | con <- tyConDataCons tycon])
408 ; return (extra ++ constrs)
412 Generate the entry code, info tables, and (for niladic constructor) the
413 static closure, for a constructor.
416 cgDataCon :: DataCon -> Code
418 = do { -- Don't need any dynamic closure code for zero-arity constructors
419 this_pkg <- getThisPackage
422 -- To allow the debuggers, interpreters, etc to cope with
423 -- static data structures (ie those built at compile
424 -- time), we take care that info-table contains the
425 -- information we need.
426 (static_cl_info, _) =
427 layOutStaticConstr this_pkg data_con arg_reps
429 (dyn_cl_info, arg_things) =
430 layOutDynConstr this_pkg data_con arg_reps
432 emit_info cl_info ticky_code
433 = do { code_blks <- getCgStmts the_code
434 ; emitClosureCodeAndInfoTable cl_info [] code_blks }
436 the_code = do { ticky_code
437 ; ldvEnter (CmmReg nodeReg)
440 arg_reps :: [(CgRep, Type)]
441 arg_reps = [(typeCgRep ty, ty) | ty <- dataConRepArgTys data_con]
444 -- NB: We don't set CC when entering data (WDP 94/06)
445 tickyReturnOldCon (length arg_things)
446 ; performReturn (emitKnownConReturnCode data_con) }
447 -- noStmts: Ptr to thing already in Node
449 ; whenC (not (isNullaryRepDataCon data_con))
450 (emit_info dyn_cl_info tickyEnterDynCon)
452 -- Dynamic-Closure first, to reduce forward references
453 ; emit_info static_cl_info tickyEnterStaticCon }