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 )
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
74 ; dflags <- getDynFlags
75 ; ASSERT( not (isDllConApp dflags con args) ) return ()
76 ; ASSERT( args `lengthIs` dataConRepArity con ) return ()
79 ; amodes <- getArgAmodes args
83 lf_info = mkConLFInfo con
84 closure_label = mkClosureLabel dflags name
85 caffy = any stgArgHasCafRefs args
86 (closure_info, amodes_w_offsets) = layOutStaticConstr dflags con amodes
87 closure_rep = mkStaticClosureFields
89 dontCareCCS -- Because it's static data
93 payload = map get_lit amodes_w_offsets
94 get_lit (CmmLit lit, _offset) = lit
95 get_lit other = pprPanic "CgCon.get_lit" (ppr other)
96 -- NB1: amodes_w_offsets is sorted into ptrs first, then non-ptrs
97 -- NB2: all the amodes should be Lits!
100 ; emitDataLits closure_label closure_rep
103 ; returnFC (id, stableIdInfo id (mkLblExpr closure_label) lf_info) }
106 %************************************************************************
108 %* non-top-level constructors *
110 %************************************************************************
111 \subsection[code-for-constructors]{The code for constructors}
114 buildDynCon :: Id -- Name of the thing to which this constr will
116 -> CostCentreStack -- Where to grab cost centre from;
117 -- current CCS if currentOrSubsumedCCS
118 -> DataCon -- The data constructor
119 -> [(CgRep,CmmExpr)] -- Its args
120 -> FCode CgIdInfo -- Return details about how to find it
122 -- We used to pass a boolean indicating whether all the
123 -- args were of size zero, so we could use a static
124 -- construtor; but I concluded that it just isn't worth it.
125 -- Now I/O uses unboxed tuples there just aren't any constructors
126 -- with all size-zero args.
128 -- The reason for having a separate argument, rather than looking at
129 -- the addr modes of the args is that we may be in a "knot", and
130 -- premature looking at the args will cause the compiler to black-hole!
133 First we deal with the case of zero-arity constructors. Now, they
134 will probably be unfolded, so we don't expect to see this case much,
135 if at all, but it does no harm, and sets the scene for characters.
137 In the case of zero-arity constructors, or, more accurately, those
138 which have exclusively size-zero (VoidRep) args, we generate no code
142 buildDynCon binder cc con []
143 = do dflags <- getDynFlags
144 returnFC (stableIdInfo binder
145 (mkLblExpr (mkClosureLabel dflags (dataConName con)))
149 The following three paragraphs about @Char@-like and @Int@-like
150 closures are obsolete, but I don't understand the details well enough
151 to properly word them, sorry. I've changed the treatment of @Char@s to
152 be analogous to @Int@s: only a subset is preallocated, because @Char@
153 has now 31 bits. Only literals are handled here. -- Qrczak
155 Now for @Char@-like closures. We generate an assignment of the
156 address of the closure to a temporary. It would be possible simply to
157 generate no code, and record the addressing mode in the environment,
158 but we'd have to be careful if the argument wasn't a constant --- so
159 for simplicity we just always asssign to a temporary.
161 Last special case: @Int@-like closures. We only special-case the
162 situation in which the argument is a literal in the range
163 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
164 work with any old argument, but for @Int@-like ones the argument has
165 to be a literal. Reason: @Char@ like closures have an argument type
166 which is guaranteed in range.
168 Because of this, we use can safely return an addressing mode.
171 buildDynCon binder cc con [arg_amode]
172 | maybeIntLikeCon con
173 , (_, CmmLit (CmmInt val _)) <- arg_amode
174 , let val_int = (fromIntegral val) :: Int
175 , val_int <= mAX_INTLIKE && val_int >= mIN_INTLIKE
176 = do { let intlike_lbl = mkRtsDataLabel SLIT("stg_INTLIKE_closure")
177 offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1)
178 -- INTLIKE closures consist of a header and one word payload
179 intlike_amode = CmmLit (cmmLabelOffW intlike_lbl offsetW)
180 ; returnFC (stableIdInfo binder intlike_amode (mkConLFInfo con)) }
182 buildDynCon binder cc con [arg_amode]
183 | maybeCharLikeCon con
184 , (_, CmmLit (CmmInt val _)) <- arg_amode
185 , let val_int = (fromIntegral val) :: Int
186 , val_int <= mAX_CHARLIKE && val_int >= mIN_CHARLIKE
187 = do { let charlike_lbl = mkRtsDataLabel SLIT("stg_CHARLIKE_closure")
188 offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize + 1)
189 -- CHARLIKE closures consist of a header and one word payload
190 charlike_amode = CmmLit (cmmLabelOffW charlike_lbl offsetW)
191 ; returnFC (stableIdInfo binder charlike_amode (mkConLFInfo con)) }
194 Now the general case.
197 buildDynCon binder ccs con args
199 ; dflags <- getDynFlags
201 (closure_info, amodes_w_offsets) = layOutDynConstr dflags con args
203 ; hp_off <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
204 ; returnFC (heapIdInfo binder hp_off lf_info) }
206 lf_info = mkConLFInfo con
208 use_cc -- cost-centre to stick in the object
209 | currentOrSubsumedCCS ccs = curCCS
210 | otherwise = CmmLit (mkCCostCentreStack ccs)
212 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
216 %************************************************************************
218 %* constructor-related utility function: *
219 %* bindConArgs is called from cgAlt of a case *
221 %************************************************************************
222 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
224 @bindConArgs@ $con args$ augments the environment with bindings for the
225 binders $args$, assuming that we have just returned from a @case@ which
229 bindConArgs :: DataCon -> [Id] -> Code
231 = do dflags <- getDynFlags
233 bind_arg (arg, offset) = bindNewToNode arg offset (mkLFArgument arg)
234 (_, args_w_offsets) = layOutDynConstr dflags con (addIdReps args)
236 ASSERT(not (isUnboxedTupleCon con)) return ()
237 mapCs bind_arg args_w_offsets
240 Unboxed tuples are handled slightly differently - the object is
241 returned in registers and on the stack instead of the heap.
244 bindUnboxedTupleComponents
246 -> FCode ([(Id,GlobalReg)], -- Regs assigned
247 WordOff, -- Number of pointer stack slots
248 WordOff, -- Number of non-pointer stack slots
249 VirtualSpOffset) -- Offset of return address slot
250 -- (= realSP on entry)
252 bindUnboxedTupleComponents args
257 -- Assign as many components as possible to registers
258 ; let (reg_args, stk_args) = assignReturnRegs (addIdReps args)
260 -- Separate the rest of the args into pointers and non-pointers
261 (ptr_args, nptr_args) = separateByPtrFollowness stk_args
263 -- Allocate the rest on the stack
264 -- The real SP points to the return address, above which any
265 -- leftover unboxed-tuple components will be allocated
266 (ptr_sp, ptr_offsets) = mkVirtStkOffsets rsp ptr_args
267 (nptr_sp, nptr_offsets) = mkVirtStkOffsets ptr_sp nptr_args
269 nptrs = nptr_sp - ptr_sp
271 -- The stack pointer points to the last stack-allocated component
272 ; setRealAndVirtualSp nptr_sp
274 -- We have just allocated slots starting at real SP + 1, and set the new
275 -- virtual SP to the topmost allocated slot.
276 -- If the virtual SP started *below* the real SP, we've just jumped over
277 -- some slots that won't be in the free-list, so put them there
278 -- This commonly happens because we've freed the return-address slot
279 -- (trimming back the virtual SP), but the real SP still points to that slot
280 ; freeStackSlots [vsp+1,vsp+2 .. rsp]
282 ; bindArgsToRegs reg_args
283 ; bindArgsToStack ptr_offsets
284 ; bindArgsToStack nptr_offsets
286 ; returnFC (reg_args, ptrs, nptrs, rsp) }
289 %************************************************************************
291 Actually generate code for a constructor return
293 %************************************************************************
296 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
297 sure the @amodes@ passed don't conflict with each other.
299 cgReturnDataCon :: DataCon -> [(CgRep, CmmExpr)] -> Code
301 cgReturnDataCon con amodes
302 = ASSERT( amodes `lengthIs` dataConRepArity con )
303 do { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
305 CaseAlts _ (Just (alts, deflt_lbl)) bndr _
306 -> -- Ho! We know the constructor so we can
307 -- go straight to the right alternative
308 case assocMaybe alts (dataConTagZ con) of {
309 Just join_lbl -> build_it_then (jump_to join_lbl);
311 -- Special case! We're returning a constructor to the default case
312 -- of an enclosing case. For example:
314 -- case (case e of (a,b) -> C a b) of
316 -- y -> ...<returning here!>...
319 -- if the default is a non-bind-default (ie does not use y),
320 -- then we should simply jump to the default join point;
322 | isDeadBinder bndr -> performReturn (jump_to deflt_lbl)
323 | otherwise -> build_it_then (jump_to deflt_lbl) }
325 other_sequel -- The usual case
326 | isUnboxedTupleCon con -> returnUnboxedTuple amodes
327 | otherwise -> build_it_then (emitKnownConReturnCode con)
330 jump_to lbl = stmtC (CmmJump (CmmLit lbl) [])
331 build_it_then return_code
332 = do { -- BUILD THE OBJECT IN THE HEAP
333 -- The first "con" says that the name bound to this
334 -- closure is "con", which is a bit of a fudge, but it only
337 -- This Id is also used to get a unique for a
338 -- temporary variable, if the closure is a CHARLIKE.
339 -- funnily enough, this makes the unique always come
341 tickyReturnNewCon (length amodes)
342 ; idinfo <- buildDynCon (dataConWorkId con) currentCCS con amodes
343 ; amode <- idInfoToAmode idinfo
344 ; checkedAbsC (CmmAssign nodeReg amode)
345 ; performReturn return_code }
349 %************************************************************************
351 Generating static stuff for algebraic data types
353 %************************************************************************
355 [These comments are rather out of date]
358 Info tbls & Macro & Kind of constructor \\
360 info & @CONST_INFO_TABLE@& Zero arity (no info -- compiler uses static closure)\\
361 info & @CHARLIKE_INFO_TABLE@& Charlike (no info -- compiler indexes fixed array)\\
362 info & @INTLIKE_INFO_TABLE@& Intlike; the one macro generates both info tbls\\
363 info & @SPEC_INFO_TABLE@& SPECish, and bigger than or equal to @MIN_UPD_SIZE@\\
364 info & @GEN_INFO_TABLE@& GENish (hence bigger than or equal to @MIN_UPD_SIZE@)\\
367 Possible info tables for constructor con:
371 Used for dynamically let(rec)-bound occurrences of
372 the constructor, and for updates. For constructors
373 which are int-like, char-like or nullary, when GC occurs,
374 the closure tries to get rid of itself.
376 \item[@_static_info@:]
377 Static occurrences of the constructor
378 macro: @STATIC_INFO_TABLE@.
381 For zero-arity constructors, \tr{con}, we NO LONGER generate a static closure;
382 it's place is taken by the top level defn of the constructor.
384 For charlike and intlike closures there is a fixed array of static
385 closures predeclared.
388 cgTyCon :: TyCon -> FCode [Cmm] -- each constructor gets a separate Cmm
390 = do { constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon)
392 -- Generate a table of static closures for an enumeration type
393 -- Put the table after the data constructor decls, because the
394 -- datatype closure table (for enumeration types)
395 -- to (say) PrelBase_$wTrue_closure, which is defined in code_stuff
397 if isEnumerationTyCon tycon then do
398 tbl <- getCmm (emitRODataLits (mkLocalClosureTableLabel
400 [ CmmLabel (mkLocalClosureLabel (dataConName con))
401 | con <- tyConDataCons tycon])
406 ; return (extra ++ constrs)
410 Generate the entry code, info tables, and (for niladic constructor) the
411 static closure, for a constructor.
414 cgDataCon :: DataCon -> Code
416 = do { -- Don't need any dynamic closure code for zero-arity constructors
417 dflags <- getDynFlags
420 -- To allow the debuggers, interpreters, etc to cope with
421 -- static data structures (ie those built at compile
422 -- time), we take care that info-table contains the
423 -- information we need.
424 (static_cl_info, _) =
425 layOutStaticConstr dflags data_con arg_reps
427 (dyn_cl_info, arg_things) =
428 layOutDynConstr dflags data_con arg_reps
430 emit_info cl_info ticky_code
431 = do { code_blks <- getCgStmts the_code
432 ; emitClosureCodeAndInfoTable cl_info [] code_blks }
434 the_code = do { ticky_code
435 ; ldvEnter (CmmReg nodeReg)
438 arg_reps :: [(CgRep, Type)]
439 arg_reps = [(typeCgRep ty, ty) | ty <- dataConRepArgTys data_con]
442 -- NB: We don't set CC when entering data (WDP 94/06)
443 tickyReturnOldCon (length arg_things)
444 ; performReturn (emitKnownConReturnCode data_con) }
445 -- noStmts: Ptr to thing already in Node
447 ; whenC (not (isNullaryRepDataCon data_con))
448 (emit_info dyn_cl_info tickyEnterDynCon)
450 -- Dynamic-Closure first, to reduce forward references
451 ; emit_info static_cl_info tickyEnterStaticCon }