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 -- The above warning supression flag is a temporary kludge.
14 -- While working on this module you are encouraged to remove it and fix
15 -- any warnings in the module. See
16 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
20 cgTopRhsCon, buildDynCon,
21 bindConArgs, bindUnboxedTupleComponents,
26 #include "HsVersions.h"
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
74 -- Windows DLLs have a problem with static cross-DLL refs.
75 ; this_pkg <- getThisPackage
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 name $ idCafInfo id
87 caffy = any stgArgHasCafRefs args
88 (closure_info, amodes_w_offsets) = layOutStaticConstr 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, taggedStableIdInfo id (mkLblExpr closure_label) lf_info con) }
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 = returnFC (taggedStableIdInfo binder
146 (mkLblExpr (mkClosureLabel (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 = mkRtsGcPtrLabel (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 (taggedStableIdInfo binder intlike_amode (mkConLFInfo con) 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 = mkRtsGcPtrLabel (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 (taggedStableIdInfo binder charlike_amode (mkConLFInfo con) con) }
197 Now the general case.
200 buildDynCon binder ccs con args
203 (closure_info, amodes_w_offsets) = layOutDynConstr con args
205 ; hp_off <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
206 ; returnFC (taggedHeapIdInfo binder hp_off lf_info con) }
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
235 -- The binding below forces the masking out of the tag bits
236 -- when accessing the constructor field.
237 bind_arg (arg, offset) = bindNewToUntagNode arg offset (mkLFArgument arg) (tagForCon con)
238 (_, args_w_offsets) = layOutDynConstr con (addIdReps args)
240 ASSERT(not (isUnboxedTupleCon con)) return ()
241 mapCs bind_arg args_w_offsets
244 Unboxed tuples are handled slightly differently - the object is
245 returned in registers and on the stack instead of the heap.
248 bindUnboxedTupleComponents
250 -> FCode ([(Id,GlobalReg)], -- Regs assigned
251 WordOff, -- Number of pointer stack slots
252 WordOff, -- Number of non-pointer stack slots
253 VirtualSpOffset) -- Offset of return address slot
254 -- (= realSP on entry)
256 bindUnboxedTupleComponents args
261 -- Assign as many components as possible to registers
262 ; let (reg_args, stk_args) = assignReturnRegs (addIdReps args)
264 -- Separate the rest of the args into pointers and non-pointers
265 (ptr_args, nptr_args) = separateByPtrFollowness stk_args
267 -- Allocate the rest on the stack
268 -- The real SP points to the return address, above which any
269 -- leftover unboxed-tuple components will be allocated
270 (ptr_sp, ptr_offsets) = mkVirtStkOffsets rsp ptr_args
271 (nptr_sp, nptr_offsets) = mkVirtStkOffsets ptr_sp nptr_args
273 nptrs = nptr_sp - ptr_sp
275 -- The stack pointer points to the last stack-allocated component
276 ; setRealAndVirtualSp nptr_sp
278 -- We have just allocated slots starting at real SP + 1, and set the new
279 -- virtual SP to the topmost allocated slot.
280 -- If the virtual SP started *below* the real SP, we've just jumped over
281 -- some slots that won't be in the free-list, so put them there
282 -- This commonly happens because we've freed the return-address slot
283 -- (trimming back the virtual SP), but the real SP still points to that slot
284 ; freeStackSlots [vsp+1,vsp+2 .. rsp]
286 ; bindArgsToRegs reg_args
287 ; bindArgsToStack ptr_offsets
288 ; bindArgsToStack nptr_offsets
290 ; returnFC (reg_args, ptrs, nptrs, rsp) }
293 %************************************************************************
295 Actually generate code for a constructor return
297 %************************************************************************
300 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
301 sure the @amodes@ passed don't conflict with each other.
303 cgReturnDataCon :: DataCon -> [(CgRep, CmmExpr)] -> Code
305 cgReturnDataCon con amodes
306 = ASSERT( amodes `lengthIs` dataConRepArity con )
307 do { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
309 CaseAlts _ (Just (alts, deflt_lbl)) bndr
310 -> -- Ho! We know the constructor so we can
311 -- go straight to the right alternative
312 case assocMaybe alts (dataConTagZ con) of {
313 Just join_lbl -> build_it_then (jump_to join_lbl);
315 -- Special case! We're returning a constructor to the default case
316 -- of an enclosing case. For example:
318 -- case (case e of (a,b) -> C a b) of
320 -- y -> ...<returning here!>...
323 -- if the default is a non-bind-default (ie does not use y),
324 -- then we should simply jump to the default join point;
326 | isDeadBinder bndr -> performReturn (jump_to deflt_lbl)
327 | otherwise -> build_it_then (jump_to deflt_lbl) }
329 other_sequel -- The usual case
330 | isUnboxedTupleCon con -> returnUnboxedTuple amodes
331 | otherwise -> build_it_then emitReturnInstr
334 jump_to lbl = stmtC (CmmJump (CmmLit lbl) [])
335 build_it_then return_code
336 = do { -- BUILD THE OBJECT IN THE HEAP
337 -- The first "con" says that the name bound to this
338 -- closure is "con", which is a bit of a fudge, but it only
341 -- This Id is also used to get a unique for a
342 -- temporary variable, if the closure is a CHARLIKE.
343 -- funnily enough, this makes the unique always come
345 tickyReturnNewCon (length amodes)
346 ; idinfo <- buildDynCon (dataConWorkId con) currentCCS con amodes
347 ; amode <- idInfoToAmode idinfo
348 ; checkedAbsC (CmmAssign nodeReg amode)
349 ; performReturn return_code }
353 %************************************************************************
355 Generating static stuff for algebraic data types
357 %************************************************************************
359 [These comments are rather out of date]
362 Info tbls & Macro & Kind of constructor \\
364 info & @CONST_INFO_TABLE@& Zero arity (no info -- compiler uses static closure)\\
365 info & @CHARLIKE_INFO_TABLE@& Charlike (no info -- compiler indexes fixed array)\\
366 info & @INTLIKE_INFO_TABLE@& Intlike; the one macro generates both info tbls\\
367 info & @SPEC_INFO_TABLE@& SPECish, and bigger than or equal to @MIN_UPD_SIZE@\\
368 info & @GEN_INFO_TABLE@& GENish (hence bigger than or equal to @MIN_UPD_SIZE@)\\
371 Possible info tables for constructor con:
375 Used for dynamically let(rec)-bound occurrences of
376 the constructor, and for updates. For constructors
377 which are int-like, char-like or nullary, when GC occurs,
378 the closure tries to get rid of itself.
380 \item[@_static_info@:]
381 Static occurrences of the constructor
382 macro: @STATIC_INFO_TABLE@.
385 For zero-arity constructors, \tr{con}, we NO LONGER generate a static closure;
386 it's place is taken by the top level defn of the constructor.
388 For charlike and intlike closures there is a fixed array of static
389 closures predeclared.
392 cgTyCon :: TyCon -> FCode [Cmm] -- each constructor gets a separate Cmm
394 = do { constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon)
396 -- Generate a table of static closures for an enumeration type
397 -- Put the table after the data constructor decls, because the
398 -- datatype closure table (for enumeration types)
399 -- to (say) PrelBase_$wTrue_closure, which is defined in code_stuff
400 -- Note that the closure pointers are tagged.
402 -- XXX comment says to put table after constructor decls, but
403 -- code appears to put it before --- NR 16 Aug 2007
405 if isEnumerationTyCon tycon then do
406 tbl <- getCmm (emitRODataLits "cgTyCon" (mkLocalClosureTableLabel (tyConName tycon) NoCafRefs)
407 [ CmmLabelOff (mkLocalClosureLabel (dataConName con) NoCafRefs) (tagForCon con)
408 | con <- tyConDataCons tycon])
413 ; return (extra ++ constrs)
417 Generate the entry code, info tables, and (for niladic constructor) the
418 static closure, for a constructor.
421 cgDataCon :: DataCon -> Code
423 = do { -- Don't need any dynamic closure code for zero-arity constructors
426 -- To allow the debuggers, interpreters, etc to cope with
427 -- static data structures (ie those built at compile
428 -- time), we take care that info-table contains the
429 -- information we need.
430 (static_cl_info, _) =
431 layOutStaticConstr data_con arg_reps
433 (dyn_cl_info, arg_things) =
434 layOutDynConstr data_con arg_reps
436 emit_info cl_info ticky_code
437 = do { code_blks <- getCgStmts the_code
438 ; emitClosureCodeAndInfoTable cl_info [] code_blks }
440 the_code = do { ticky_code
441 ; ldvEnter (CmmReg nodeReg)
444 arg_reps :: [(CgRep, Type)]
445 arg_reps = [(typeCgRep ty, ty) | ty <- dataConRepArgTys data_con]
448 -- NB: We don't set CC when entering data (WDP 94/06)
449 tickyReturnOldCon (length arg_things)
450 -- The case continuation code is expecting a tagged pointer
451 ; stmtC (CmmAssign nodeReg
452 (tagCons data_con (CmmReg nodeReg)))
453 ; performReturn emitReturnInstr }
454 -- noStmts: Ptr to thing already in Node
456 ; whenC (not (isNullaryRepDataCon data_con))
457 (emit_info dyn_cl_info tickyEnterDynCon)
459 -- Dynamic-Closure first, to reduce forward references
460 ; emit_info static_cl_info tickyEnterStaticCon }