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