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 Constants ( mAX_INTLIKE, mIN_INTLIKE, mAX_CHARLIKE, mIN_CHARLIKE )
32 import CgHeapery ( allocDynClosure, layOutDynConstr,
33 layOutStaticConstr, mkStaticClosureFields )
34 import CgTailCall ( performReturn, emitKnownConReturnCode, returnUnboxedTuple )
35 import CgProf ( mkCCostCentreStack, ldvEnter, curCCS )
37 import CgInfoTbls ( emitClosureCodeAndInfoTable, dataConTagZ )
38 import CLabel ( mkClosureLabel, mkRtsDataLabel, mkClosureTblLabel )
39 import ClosureInfo ( mkConLFInfo, mkLFArgument )
40 import CmmUtils ( mkLblExpr )
42 import SMRep ( WordOff, CgRep, separateByPtrFollowness,
43 fixedHdrSize, typeCgRep )
44 import CostCentre ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
46 import Constants ( mIN_INTLIKE, mAX_INTLIKE, mIN_CHARLIKE, mAX_CHARLIKE )
47 import TyCon ( TyCon, tyConDataCons, isEnumerationTyCon, tyConName )
48 import DataCon ( DataCon, dataConRepArgTys, isNullaryRepDataCon,
49 isUnboxedTupleCon, dataConWorkId,
50 dataConName, dataConRepArity
52 import Id ( Id, idName, isDeadBinder )
54 import PrelInfo ( maybeCharLikeCon, maybeIntLikeCon )
56 import Util ( lengthIs )
57 import ListSetOps ( assocMaybe )
61 %************************************************************************
63 \subsection[toplevel-constructors]{Top-level constructors}
65 %************************************************************************
68 cgTopRhsCon :: Id -- Name of thing bound to this RHS
71 -> FCode (Id, CgIdInfo)
72 cgTopRhsCon id con args
73 = ASSERT( not (isDllConApp con args) )
74 ASSERT( args `lengthIs` dataConRepArity con )
76 ; amodes <- getArgAmodes args
80 lf_info = mkConLFInfo con
81 closure_label = mkClosureLabel name
82 caffy = any stgArgHasCafRefs args
83 (closure_info, amodes_w_offsets) = layOutStaticConstr con amodes
84 closure_rep = mkStaticClosureFields
86 dontCareCCS -- Because it's static data
90 payload = map get_lit amodes_w_offsets
91 get_lit (CmmLit lit, _offset) = lit
92 get_lit other = pprPanic "CgCon.get_lit" (ppr other)
93 -- NB1: amodes_w_offsets is sorted into ptrs first, then non-ptrs
94 -- NB2: all the amodes should be Lits!
97 ; emitDataLits closure_label closure_rep
100 ; returnFC (id, stableIdInfo id (mkLblExpr closure_label) lf_info) }
103 %************************************************************************
105 %* non-top-level constructors *
107 %************************************************************************
108 \subsection[code-for-constructors]{The code for constructors}
111 buildDynCon :: Id -- Name of the thing to which this constr will
113 -> CostCentreStack -- Where to grab cost centre from;
114 -- current CCS if currentOrSubsumedCCS
115 -> DataCon -- The data constructor
116 -> [(CgRep,CmmExpr)] -- Its args
117 -> FCode CgIdInfo -- Return details about how to find it
119 -- We used to pass a boolean indicating whether all the
120 -- args were of size zero, so we could use a static
121 -- construtor; but I concluded that it just isn't worth it.
122 -- Now I/O uses unboxed tuples there just aren't any constructors
123 -- with all size-zero args.
125 -- The reason for having a separate argument, rather than looking at
126 -- the addr modes of the args is that we may be in a "knot", and
127 -- premature looking at the args will cause the compiler to black-hole!
130 First we deal with the case of zero-arity constructors. Now, they
131 will probably be unfolded, so we don't expect to see this case much,
132 if at all, but it does no harm, and sets the scene for characters.
134 In the case of zero-arity constructors, or, more accurately, those
135 which have exclusively size-zero (VoidRep) args, we generate no code
139 buildDynCon binder cc con []
140 = returnFC (stableIdInfo binder
141 (mkLblExpr (mkClosureLabel (dataConName con)))
145 The following three paragraphs about @Char@-like and @Int@-like
146 closures are obsolete, but I don't understand the details well enough
147 to properly word them, sorry. I've changed the treatment of @Char@s to
148 be analogous to @Int@s: only a subset is preallocated, because @Char@
149 has now 31 bits. Only literals are handled here. -- Qrczak
151 Now for @Char@-like closures. We generate an assignment of the
152 address of the closure to a temporary. It would be possible simply to
153 generate no code, and record the addressing mode in the environment,
154 but we'd have to be careful if the argument wasn't a constant --- so
155 for simplicity we just always asssign to a temporary.
157 Last special case: @Int@-like closures. We only special-case the
158 situation in which the argument is a literal in the range
159 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
160 work with any old argument, but for @Int@-like ones the argument has
161 to be a literal. Reason: @Char@ like closures have an argument type
162 which is guaranteed in range.
164 Because of this, we use can safely return an addressing mode.
167 buildDynCon binder cc con [arg_amode]
168 | maybeIntLikeCon con
169 , (_, CmmLit (CmmInt val _)) <- arg_amode
170 , let val_int = (fromIntegral val) :: Int
171 , val_int <= mAX_INTLIKE && val_int >= mIN_INTLIKE
172 = do { let intlike_lbl = mkRtsDataLabel SLIT("stg_INTLIKE_closure")
173 offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1)
174 -- INTLIKE closures consist of a header and one word payload
175 intlike_amode = CmmLit (cmmLabelOffW intlike_lbl offsetW)
176 ; returnFC (stableIdInfo binder intlike_amode (mkConLFInfo con)) }
178 buildDynCon binder cc con [arg_amode]
179 | maybeCharLikeCon con
180 , (_, CmmLit (CmmInt val _)) <- arg_amode
181 , let val_int = (fromIntegral val) :: Int
182 , val_int <= mAX_CHARLIKE && val_int >= mIN_CHARLIKE
183 = do { let charlike_lbl = mkRtsDataLabel SLIT("stg_CHARLIKE_closure")
184 offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize + 1)
185 -- CHARLIKE closures consist of a header and one word payload
186 charlike_amode = CmmLit (cmmLabelOffW charlike_lbl offsetW)
187 ; returnFC (stableIdInfo binder charlike_amode (mkConLFInfo con)) }
190 Now the general case.
193 buildDynCon binder ccs con args
194 = do { hp_off <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
195 ; returnFC (heapIdInfo binder hp_off lf_info) }
197 lf_info = mkConLFInfo con
198 (closure_info, amodes_w_offsets) = layOutDynConstr con args
200 use_cc -- cost-centre to stick in the object
201 | currentOrSubsumedCCS ccs = curCCS
202 | otherwise = CmmLit (mkCCostCentreStack ccs)
204 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
208 %************************************************************************
210 %* constructor-related utility function: *
211 %* bindConArgs is called from cgAlt of a case *
213 %************************************************************************
214 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
216 @bindConArgs@ $con args$ augments the environment with bindings for the
217 binders $args$, assuming that we have just returned from a @case@ which
221 bindConArgs :: DataCon -> [Id] -> Code
223 = ASSERT(not (isUnboxedTupleCon con))
224 mapCs bind_arg args_w_offsets
226 bind_arg (arg, offset) = bindNewToNode arg offset (mkLFArgument arg)
227 (_, args_w_offsets) = layOutDynConstr con (addIdReps args)
230 Unboxed tuples are handled slightly differently - the object is
231 returned in registers and on the stack instead of the heap.
234 bindUnboxedTupleComponents
236 -> FCode ([(Id,GlobalReg)], -- Regs assigned
237 WordOff, -- Number of pointer stack slots
238 WordOff, -- Number of non-pointer stack slots
239 VirtualSpOffset) -- Offset of return address slot
240 -- (= realSP on entry)
242 bindUnboxedTupleComponents args
247 -- Assign as many components as possible to registers
248 ; let (reg_args, stk_args) = assignReturnRegs (addIdReps args)
250 -- Separate the rest of the args into pointers and non-pointers
251 (ptr_args, nptr_args) = separateByPtrFollowness stk_args
253 -- Allocate the rest on the stack
254 -- The real SP points to the return address, above which any
255 -- leftover unboxed-tuple components will be allocated
256 (ptr_sp, ptr_offsets) = mkVirtStkOffsets rsp ptr_args
257 (nptr_sp, nptr_offsets) = mkVirtStkOffsets ptr_sp nptr_args
259 nptrs = nptr_sp - ptr_sp
261 -- The stack pointer points to the last stack-allocated component
262 ; setRealAndVirtualSp nptr_sp
264 -- We have just allocated slots starting at real SP + 1, and set the new
265 -- virtual SP to the topmost allocated slot.
266 -- If the virtual SP started *below* the real SP, we've just jumped over
267 -- some slots that won't be in the free-list, so put them there
268 -- This commonly happens because we've freed the return-address slot
269 -- (trimming back the virtual SP), but the real SP still points to that slot
270 ; freeStackSlots [vsp+1,vsp+2 .. rsp]
272 ; bindArgsToRegs reg_args
273 ; bindArgsToStack ptr_offsets
274 ; bindArgsToStack nptr_offsets
276 ; returnFC (reg_args, ptrs, nptrs, rsp) }
279 %************************************************************************
281 Actually generate code for a constructor return
283 %************************************************************************
286 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
287 sure the @amodes@ passed don't conflict with each other.
289 cgReturnDataCon :: DataCon -> [(CgRep, CmmExpr)] -> Code
291 cgReturnDataCon con amodes
292 = ASSERT( amodes `lengthIs` dataConRepArity con )
293 do { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
295 CaseAlts _ (Just (alts, deflt_lbl)) bndr _
296 -> -- Ho! We know the constructor so we can
297 -- go straight to the right alternative
298 case assocMaybe alts (dataConTagZ con) of {
299 Just join_lbl -> build_it_then (jump_to join_lbl);
301 -- Special case! We're returning a constructor to the default case
302 -- of an enclosing case. For example:
304 -- case (case e of (a,b) -> C a b) of
306 -- y -> ...<returning here!>...
309 -- if the default is a non-bind-default (ie does not use y),
310 -- then we should simply jump to the default join point;
312 | isDeadBinder bndr -> performReturn (jump_to deflt_lbl)
313 | otherwise -> build_it_then (jump_to deflt_lbl) }
315 other_sequel -- The usual case
316 | isUnboxedTupleCon con -> returnUnboxedTuple amodes
317 | otherwise -> build_it_then (emitKnownConReturnCode con)
320 jump_to lbl = stmtC (CmmJump (CmmLit lbl) [])
321 build_it_then return_code
322 = do { -- BUILD THE OBJECT IN THE HEAP
323 -- The first "con" says that the name bound to this
324 -- closure is "con", which is a bit of a fudge, but it only
327 -- This Id is also used to get a unique for a
328 -- temporary variable, if the closure is a CHARLIKE.
329 -- funnily enough, this makes the unique always come
331 tickyReturnNewCon (length amodes)
332 ; idinfo <- buildDynCon (dataConWorkId con) currentCCS con amodes
333 ; amode <- idInfoToAmode idinfo
334 ; checkedAbsC (CmmAssign nodeReg amode)
335 ; performReturn return_code }
339 %************************************************************************
341 Generating static stuff for algebraic data types
343 %************************************************************************
345 [These comments are rather out of date]
348 Info tbls & Macro & Kind of constructor \\
350 info & @CONST_INFO_TABLE@& Zero arity (no info -- compiler uses static closure)\\
351 info & @CHARLIKE_INFO_TABLE@& Charlike (no info -- compiler indexes fixed array)\\
352 info & @INTLIKE_INFO_TABLE@& Intlike; the one macro generates both info tbls\\
353 info & @SPEC_INFO_TABLE@& SPECish, and bigger than or equal to @MIN_UPD_SIZE@\\
354 info & @GEN_INFO_TABLE@& GENish (hence bigger than or equal to @MIN_UPD_SIZE@)\\
357 Possible info tables for constructor con:
361 Used for dynamically let(rec)-bound occurrences of
362 the constructor, and for updates. For constructors
363 which are int-like, char-like or nullary, when GC occurs,
364 the closure tries to get rid of itself.
366 \item[@_static_info@:]
367 Static occurrences of the constructor
368 macro: @STATIC_INFO_TABLE@.
371 For zero-arity constructors, \tr{con}, we NO LONGER generate a static closure;
372 it's place is taken by the top level defn of the constructor.
374 For charlike and intlike closures there is a fixed array of static
375 closures predeclared.
378 cgTyCon :: TyCon -> FCode [Cmm] -- each constructor gets a separate Cmm
380 = do { constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon)
382 -- Generate a table of static closures for an enumeration type
383 -- Put the table after the data constructor decls, because the
384 -- datatype closure table (for enumeration types)
385 -- to (say) PrelBase_$wTrue_closure, which is defined in code_stuff
387 if isEnumerationTyCon tycon then do
388 tbl <- getCmm (emitRODataLits (mkClosureTblLabel
390 [ CmmLabel (mkClosureLabel (dataConName con))
391 | con <- tyConDataCons tycon])
396 ; return (extra ++ constrs)
400 Generate the entry code, info tables, and (for niladic constructor) the
401 static closure, for a constructor.
404 cgDataCon :: DataCon -> Code
406 = do { -- Don't need any dynamic closure code for zero-arity constructors
407 whenC (not (isNullaryRepDataCon data_con))
408 (emit_info dyn_cl_info tickyEnterDynCon)
410 -- Dynamic-Closure first, to reduce forward references
411 ; emit_info static_cl_info tickyEnterStaticCon }
414 emit_info cl_info ticky_code
415 = do { code_blks <- getCgStmts the_code
416 ; emitClosureCodeAndInfoTable cl_info [] code_blks }
418 the_code = do { ticky_code
419 ; ldvEnter (CmmReg nodeReg)
422 arg_reps :: [(CgRep, Type)]
423 arg_reps = [(typeCgRep ty, ty) | ty <- dataConRepArgTys data_con]
425 -- To allow the debuggers, interpreters, etc to cope with static
426 -- data structures (ie those built at compile time), we take care that
427 -- info-table contains the information we need.
428 (static_cl_info, _) = layOutStaticConstr data_con arg_reps
429 (dyn_cl_info, arg_things) = layOutDynConstr data_con arg_reps
431 body_code = do { -- NB: We don't set CC when entering data (WDP 94/06)
432 tickyReturnOldCon (length arg_things)
433 ; performReturn (emitKnownConReturnCode data_con) }
434 -- noStmts: Ptr to thing already in Node