2 % (c) The University of Glasgow 2006
3 % (c) The GRASP Project, Glasgow University, 1992-1998
5 \section[CgCon]{Code generation for constructors}
7 This module provides the support code for @StgToAbstractC@ to deal
8 with {\em constructors} on the RHSs of let(rec)s. See also
9 @CgClosure@, which deals with closures.
13 cgTopRhsCon, buildDynCon,
14 bindConArgs, bindUnboxedTupleComponents,
19 #include "HsVersions.h"
53 %************************************************************************
55 \subsection[toplevel-constructors]{Top-level constructors}
57 %************************************************************************
60 cgTopRhsCon :: Id -- Name of thing bound to this RHS
63 -> FCode (Id, CgIdInfo)
64 cgTopRhsCon id con args
67 -- Windows DLLs have a problem with static cross-DLL refs.
68 ; this_pkg <- getThisPackage
69 ; ASSERT( not (isDllConApp this_pkg con args) ) return ()
71 ; ASSERT( args `lengthIs` dataConRepArity con ) return ()
74 ; amodes <- getArgAmodes args
78 lf_info = mkConLFInfo con
79 closure_label = mkClosureLabel name $ idCafInfo id
80 caffy = any stgArgHasCafRefs args
81 (closure_info, amodes_w_offsets) = layOutStaticConstr con amodes
82 closure_rep = mkStaticClosureFields
84 dontCareCCS -- Because it's static data
88 payload = map get_lit amodes_w_offsets
89 get_lit (CmmLit lit, _offset) = lit
90 get_lit other = pprPanic "CgCon.get_lit" (ppr other)
91 -- NB1: amodes_w_offsets is sorted into ptrs first, then non-ptrs
92 -- NB2: all the amodes should be Lits!
95 ; emitDataLits closure_label closure_rep
98 ; returnFC (id, taggedStableIdInfo id (mkLblExpr closure_label) lf_info con) }
101 %************************************************************************
103 %* non-top-level constructors *
105 %************************************************************************
106 \subsection[code-for-constructors]{The code for constructors}
109 buildDynCon :: Id -- Name of the thing to which this constr will
111 -> CostCentreStack -- Where to grab cost centre from;
112 -- current CCS if currentOrSubsumedCCS
113 -> DataCon -- The data constructor
114 -> [(CgRep,CmmExpr)] -- Its args
115 -> FCode CgIdInfo -- Return details about how to find it
117 -- We used to pass a boolean indicating whether all the
118 -- args were of size zero, so we could use a static
119 -- construtor; but I concluded that it just isn't worth it.
120 -- Now I/O uses unboxed tuples there just aren't any constructors
121 -- with all size-zero args.
123 -- The reason for having a separate argument, rather than looking at
124 -- the addr modes of the args is that we may be in a "knot", and
125 -- premature looking at the args will cause the compiler to black-hole!
128 First we deal with the case of zero-arity constructors. Now, they
129 will probably be unfolded, so we don't expect to see this case much,
130 if at all, but it does no harm, and sets the scene for characters.
132 In the case of zero-arity constructors, or, more accurately, those
133 which have exclusively size-zero (VoidRep) args, we generate no code
137 buildDynCon binder _ con []
138 = returnFC (taggedStableIdInfo binder
139 (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 _ 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 = mkRtsGcPtrLabel (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 (taggedStableIdInfo binder intlike_amode (mkConLFInfo con) con) }
178 buildDynCon binder _ 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 = mkRtsGcPtrLabel (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 (taggedStableIdInfo binder charlike_amode (mkConLFInfo con) con) }
190 Now the general case.
193 buildDynCon binder ccs con args
196 (closure_info, amodes_w_offsets) = layOutDynConstr con args
198 ; hp_off <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
199 ; returnFC (taggedHeapIdInfo binder hp_off lf_info con) }
201 lf_info = mkConLFInfo con
203 use_cc -- cost-centre to stick in the object
204 | currentOrSubsumedCCS ccs = curCCS
205 | otherwise = CmmLit (mkCCostCentreStack ccs)
207 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
211 %************************************************************************
213 %* constructor-related utility function: *
214 %* bindConArgs is called from cgAlt of a case *
216 %************************************************************************
217 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
219 @bindConArgs@ $con args$ augments the environment with bindings for the
220 binders $args$, assuming that we have just returned from a @case@ which
224 bindConArgs :: DataCon -> [Id] -> Code
228 -- The binding below forces the masking out of the tag bits
229 -- when accessing the constructor field.
230 bind_arg (arg, offset) = bindNewToUntagNode arg offset (mkLFArgument arg) (tagForCon con)
231 (_, args_w_offsets) = layOutDynConstr con (addIdReps args)
233 ASSERT(not (isUnboxedTupleCon con)) return ()
234 mapCs bind_arg args_w_offsets
237 Unboxed tuples are handled slightly differently - the object is
238 returned in registers and on the stack instead of the heap.
241 bindUnboxedTupleComponents
243 -> FCode ([(Id,GlobalReg)], -- Regs assigned
244 WordOff, -- Number of pointer stack slots
245 WordOff, -- Number of non-pointer stack slots
246 VirtualSpOffset) -- Offset of return address slot
247 -- (= realSP on entry)
249 bindUnboxedTupleComponents args
254 -- Assign as many components as possible to registers
255 ; let (reg_args, stk_args) = assignReturnRegs (addIdReps args)
257 -- Separate the rest of the args into pointers and non-pointers
258 (ptr_args, nptr_args) = separateByPtrFollowness stk_args
260 -- Allocate the rest on the stack
261 -- The real SP points to the return address, above which any
262 -- leftover unboxed-tuple components will be allocated
263 (ptr_sp, ptr_offsets) = mkVirtStkOffsets rsp ptr_args
264 (nptr_sp, nptr_offsets) = mkVirtStkOffsets ptr_sp nptr_args
266 nptrs = nptr_sp - ptr_sp
268 -- The stack pointer points to the last stack-allocated component
269 ; setRealAndVirtualSp nptr_sp
271 -- We have just allocated slots starting at real SP + 1, and set the new
272 -- virtual SP to the topmost allocated slot.
273 -- If the virtual SP started *below* the real SP, we've just jumped over
274 -- some slots that won't be in the free-list, so put them there
275 -- This commonly happens because we've freed the return-address slot
276 -- (trimming back the virtual SP), but the real SP still points to that slot
277 ; freeStackSlots [vsp+1,vsp+2 .. rsp]
279 ; bindArgsToRegs reg_args
280 ; bindArgsToStack ptr_offsets
281 ; bindArgsToStack nptr_offsets
283 ; returnFC (reg_args, ptrs, nptrs, rsp) }
286 %************************************************************************
288 Actually generate code for a constructor return
290 %************************************************************************
293 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
294 sure the @amodes@ passed don't conflict with each other.
296 cgReturnDataCon :: DataCon -> [(CgRep, CmmExpr)] -> Code
298 cgReturnDataCon con amodes
299 = ASSERT( amodes `lengthIs` dataConRepArity con )
300 do { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
302 CaseAlts _ (Just (alts, deflt_lbl)) bndr
303 -> -- Ho! We know the constructor so we can
304 -- go straight to the right alternative
305 case assocMaybe alts (dataConTagZ con) of {
306 Just join_lbl -> build_it_then (jump_to join_lbl);
308 -- Special case! We're returning a constructor to the default case
309 -- of an enclosing case. For example:
311 -- case (case e of (a,b) -> C a b) of
313 -- y -> ...<returning here!>...
316 -- if the default is a non-bind-default (ie does not use y),
317 -- then we should simply jump to the default join point;
319 | isDeadBinder bndr -> performReturn (jump_to deflt_lbl)
320 | otherwise -> build_it_then (jump_to deflt_lbl) }
323 | isUnboxedTupleCon con -> returnUnboxedTuple amodes
324 | otherwise -> build_it_then emitReturnInstr
327 jump_to lbl = stmtC (CmmJump (CmmLit lbl) [])
328 build_it_then return_code
329 = do { -- BUILD THE OBJECT IN THE HEAP
330 -- The first "con" says that the name bound to this
331 -- closure is "con", which is a bit of a fudge, but it only
334 -- This Id is also used to get a unique for a
335 -- temporary variable, if the closure is a CHARLIKE.
336 -- funnily enough, this makes the unique always come
338 tickyReturnNewCon (length amodes)
339 ; idinfo <- buildDynCon (dataConWorkId con) currentCCS con amodes
340 ; amode <- idInfoToAmode idinfo
341 ; checkedAbsC (CmmAssign nodeReg amode)
342 ; performReturn return_code }
346 %************************************************************************
348 Generating static stuff for algebraic data types
350 %************************************************************************
352 [These comments are rather out of date]
355 Info tbls & Macro & Kind of constructor \\
357 info & @CONST_INFO_TABLE@& Zero arity (no info -- compiler uses static closure)\\
358 info & @CHARLIKE_INFO_TABLE@& Charlike (no info -- compiler indexes fixed array)\\
359 info & @INTLIKE_INFO_TABLE@& Intlike; the one macro generates both info tbls\\
360 info & @SPEC_INFO_TABLE@& SPECish, and bigger than or equal to @MIN_UPD_SIZE@\\
361 info & @GEN_INFO_TABLE@& GENish (hence bigger than or equal to @MIN_UPD_SIZE@)\\
364 Possible info tables for constructor con:
368 Used for dynamically let(rec)-bound occurrences of
369 the constructor, and for updates. For constructors
370 which are int-like, char-like or nullary, when GC occurs,
371 the closure tries to get rid of itself.
373 \item[@_static_info@:]
374 Static occurrences of the constructor
375 macro: @STATIC_INFO_TABLE@.
378 For zero-arity constructors, \tr{con}, we NO LONGER generate a static closure;
379 it's place is taken by the top level defn of the constructor.
381 For charlike and intlike closures there is a fixed array of static
382 closures predeclared.
385 cgTyCon :: TyCon -> FCode [Cmm] -- each constructor gets a separate Cmm
387 = do { constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon)
389 -- Generate a table of static closures for an enumeration type
390 -- Put the table after the data constructor decls, because the
391 -- datatype closure table (for enumeration types)
392 -- to (say) PrelBase_$wTrue_closure, which is defined in code_stuff
393 -- Note that the closure pointers are tagged.
395 -- XXX comment says to put table after constructor decls, but
396 -- code appears to put it before --- NR 16 Aug 2007
398 if isEnumerationTyCon tycon then do
399 tbl <- getCmm (emitRODataLits "cgTyCon" (mkLocalClosureTableLabel (tyConName tycon) NoCafRefs)
400 [ CmmLabelOff (mkLocalClosureLabel (dataConName con) NoCafRefs) (tagForCon 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
419 -- To allow the debuggers, interpreters, etc to cope with
420 -- static data structures (ie those built at compile
421 -- time), we take care that info-table contains the
422 -- information we need.
423 (static_cl_info, _) =
424 layOutStaticConstr data_con arg_reps
426 (dyn_cl_info, arg_things) =
427 layOutDynConstr data_con arg_reps
429 emit_info cl_info ticky_code
430 = do { code_blks <- getCgStmts the_code
431 ; emitClosureCodeAndInfoTable cl_info [] code_blks }
433 the_code = do { ticky_code
434 ; ldvEnter (CmmReg nodeReg)
437 arg_reps :: [(CgRep, Type)]
438 arg_reps = [(typeCgRep ty, ty) | ty <- dataConRepArgTys data_con]
441 -- NB: We don't set CC when entering data (WDP 94/06)
442 tickyReturnOldCon (length arg_things)
443 -- The case continuation code is expecting a tagged pointer
444 ; stmtC (CmmAssign nodeReg
445 (tagCons data_con (CmmReg nodeReg)))
446 ; performReturn emitReturnInstr }
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 }