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"
55 %************************************************************************
57 \subsection[toplevel-constructors]{Top-level constructors}
59 %************************************************************************
62 cgTopRhsCon :: Id -- Name of thing bound to this RHS
65 -> FCode (Id, CgIdInfo)
66 cgTopRhsCon id con args
69 -- Windows DLLs have a problem with static cross-DLL refs.
70 ; this_pkg <- getThisPackage
71 ; ASSERT( not (isDllConApp this_pkg con args) ) return ()
73 ; ASSERT( args `lengthIs` dataConRepArity con ) return ()
76 ; amodes <- getArgAmodes args
80 lf_info = mkConLFInfo con
81 closure_label = mkClosureLabel name $ idCafInfo id
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, taggedStableIdInfo id (mkLblExpr closure_label) lf_info con) }
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 _ con []
140 = returnFC (taggedStableIdInfo binder
141 (mkLblExpr (mkClosureLabel (dataConName con)
147 The following three paragraphs about @Char@-like and @Int@-like
148 closures are obsolete, but I don't understand the details well enough
149 to properly word them, sorry. I've changed the treatment of @Char@s to
150 be analogous to @Int@s: only a subset is preallocated, because @Char@
151 has now 31 bits. Only literals are handled here. -- Qrczak
153 Now for @Char@-like closures. We generate an assignment of the
154 address of the closure to a temporary. It would be possible simply to
155 generate no code, and record the addressing mode in the environment,
156 but we'd have to be careful if the argument wasn't a constant --- so
157 for simplicity we just always asssign to a temporary.
159 Last special case: @Int@-like closures. We only special-case the
160 situation in which the argument is a literal in the range
161 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
162 work with any old argument, but for @Int@-like ones the argument has
163 to be a literal. Reason: @Char@ like closures have an argument type
164 which is guaranteed in range.
166 Because of this, we use can safely return an addressing mode.
168 We don't support this optimisation when compiling into Windows DLLs yet
169 because they don't support cross package data references well.
174 #if !(defined(__PIC__) && defined(mingw32_HOST_OS))
175 buildDynCon binder _ con [arg_amode]
176 | maybeIntLikeCon con
177 , (_, CmmLit (CmmInt val _)) <- arg_amode
178 , let val_int = (fromIntegral val) :: Int
179 , val_int <= mAX_INTLIKE && val_int >= mIN_INTLIKE
180 = do { let intlike_lbl = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_INTLIKE_closure")
181 offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1)
182 -- INTLIKE closures consist of a header and one word payload
183 intlike_amode = CmmLit (cmmLabelOffW intlike_lbl offsetW)
184 ; returnFC (taggedStableIdInfo binder intlike_amode (mkConLFInfo con) con) }
186 buildDynCon binder _ con [arg_amode]
187 | maybeCharLikeCon con
188 , (_, CmmLit (CmmInt val _)) <- arg_amode
189 , let val_int = (fromIntegral val) :: Int
190 , val_int <= mAX_CHARLIKE && val_int >= mIN_CHARLIKE
191 = do { let charlike_lbl = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_CHARLIKE_closure")
192 offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize + 1)
193 -- CHARLIKE closures consist of a header and one word payload
194 charlike_amode = CmmLit (cmmLabelOffW charlike_lbl offsetW)
195 ; returnFC (taggedStableIdInfo binder charlike_amode (mkConLFInfo con) con) }
200 Now the general case.
203 buildDynCon binder ccs con args
206 (closure_info, amodes_w_offsets) = layOutDynConstr con args
208 ; hp_off <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
209 ; returnFC (taggedHeapIdInfo binder hp_off lf_info con) }
211 lf_info = mkConLFInfo con
213 use_cc -- cost-centre to stick in the object
214 | currentOrSubsumedCCS ccs = curCCS
215 | otherwise = CmmLit (mkCCostCentreStack ccs)
217 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
221 %************************************************************************
223 %* constructor-related utility function: *
224 %* bindConArgs is called from cgAlt of a case *
226 %************************************************************************
227 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
229 @bindConArgs@ $con args$ augments the environment with bindings for the
230 binders $args$, assuming that we have just returned from a @case@ which
234 bindConArgs :: DataCon -> [Id] -> Code
238 -- The binding below forces the masking out of the tag bits
239 -- when accessing the constructor field.
240 bind_arg (arg, offset) = bindNewToUntagNode arg offset (mkLFArgument arg) (tagForCon con)
241 (_, args_w_offsets) = layOutDynConstr con (addIdReps args)
243 ASSERT(not (isUnboxedTupleCon con)) return ()
244 mapCs bind_arg args_w_offsets
247 Unboxed tuples are handled slightly differently - the object is
248 returned in registers and on the stack instead of the heap.
251 bindUnboxedTupleComponents
253 -> FCode ([(Id,GlobalReg)], -- Regs assigned
254 WordOff, -- Number of pointer stack slots
255 WordOff, -- Number of non-pointer stack slots
256 VirtualSpOffset) -- Offset of return address slot
257 -- (= realSP on entry)
259 bindUnboxedTupleComponents args
264 -- Assign as many components as possible to registers
265 ; let (reg_args, stk_args) = assignReturnRegs (addIdReps args)
267 -- Separate the rest of the args into pointers and non-pointers
268 (ptr_args, nptr_args) = separateByPtrFollowness stk_args
270 -- Allocate the rest on the stack
271 -- The real SP points to the return address, above which any
272 -- leftover unboxed-tuple components will be allocated
273 (ptr_sp, ptr_offsets) = mkVirtStkOffsets rsp ptr_args
274 (nptr_sp, nptr_offsets) = mkVirtStkOffsets ptr_sp nptr_args
276 nptrs = nptr_sp - ptr_sp
278 -- The stack pointer points to the last stack-allocated component
279 ; setRealAndVirtualSp nptr_sp
281 -- We have just allocated slots starting at real SP + 1, and set the new
282 -- virtual SP to the topmost allocated slot.
283 -- If the virtual SP started *below* the real SP, we've just jumped over
284 -- some slots that won't be in the free-list, so put them there
285 -- This commonly happens because we've freed the return-address slot
286 -- (trimming back the virtual SP), but the real SP still points to that slot
287 ; freeStackSlots [vsp+1,vsp+2 .. rsp]
289 ; bindArgsToRegs reg_args
290 ; bindArgsToStack ptr_offsets
291 ; bindArgsToStack nptr_offsets
293 ; returnFC (reg_args, ptrs, nptrs, rsp) }
296 %************************************************************************
298 Actually generate code for a constructor return
300 %************************************************************************
303 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
304 sure the @amodes@ passed don't conflict with each other.
306 cgReturnDataCon :: DataCon -> [(CgRep, CmmExpr)] -> Code
308 cgReturnDataCon con amodes
309 | isUnboxedTupleCon con = returnUnboxedTuple amodes
310 -- when profiling we can't shortcut here, we have to enter the closure
311 -- for it to be marked as "used" for LDV profiling.
312 | opt_SccProfilingOn = build_it_then enter_it
314 = ASSERT( amodes `lengthIs` dataConRepArity con )
315 do { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
317 CaseAlts _ (Just (alts, deflt_lbl)) bndr
318 -> -- Ho! We know the constructor so we can
319 -- go straight to the right alternative
320 case assocMaybe alts (dataConTagZ con) of {
321 Just join_lbl -> build_it_then (jump_to join_lbl);
323 -- Special case! We're returning a constructor to the default case
324 -- of an enclosing case. For example:
326 -- case (case e of (a,b) -> C a b) of
328 -- y -> ...<returning here!>...
331 -- if the default is a non-bind-default (ie does not use y),
332 -- then we should simply jump to the default join point;
334 | isDeadBinder bndr -> performReturn (jump_to deflt_lbl)
335 | otherwise -> build_it_then (jump_to deflt_lbl) }
337 _otherwise -- The usual case
338 -> build_it_then emitReturnInstr
341 enter_it = stmtsC [ CmmAssign nodeReg (cmmUntag (CmmReg nodeReg)),
342 CmmJump (entryCode (closureInfoPtr (CmmReg nodeReg))) [] ]
343 jump_to lbl = stmtC (CmmJump (CmmLit lbl) [])
344 build_it_then return_code
345 = do { -- BUILD THE OBJECT IN THE HEAP
346 -- The first "con" says that the name bound to this
347 -- closure is "con", which is a bit of a fudge, but it only
350 -- This Id is also used to get a unique for a
351 -- temporary variable, if the closure is a CHARLIKE.
352 -- funnily enough, this makes the unique always come
354 tickyReturnNewCon (length amodes)
355 ; idinfo <- buildDynCon (dataConWorkId con) currentCCS con amodes
356 ; amode <- idInfoToAmode idinfo
357 ; checkedAbsC (CmmAssign nodeReg amode)
358 ; performReturn return_code }
362 %************************************************************************
364 Generating static stuff for algebraic data types
366 %************************************************************************
368 [These comments are rather out of date]
371 Info tbls & Macro & Kind of constructor \\
373 info & @CONST_INFO_TABLE@& Zero arity (no info -- compiler uses static closure)\\
374 info & @CHARLIKE_INFO_TABLE@& Charlike (no info -- compiler indexes fixed array)\\
375 info & @INTLIKE_INFO_TABLE@& Intlike; the one macro generates both info tbls\\
376 info & @SPEC_INFO_TABLE@& SPECish, and bigger than or equal to @MIN_UPD_SIZE@\\
377 info & @GEN_INFO_TABLE@& GENish (hence bigger than or equal to @MIN_UPD_SIZE@)\\
380 Possible info tables for constructor con:
384 Used for dynamically let(rec)-bound occurrences of
385 the constructor, and for updates. For constructors
386 which are int-like, char-like or nullary, when GC occurs,
387 the closure tries to get rid of itself.
389 \item[@_static_info@:]
390 Static occurrences of the constructor
391 macro: @STATIC_INFO_TABLE@.
394 For zero-arity constructors, \tr{con}, we NO LONGER generate a static closure;
395 it's place is taken by the top level defn of the constructor.
397 For charlike and intlike closures there is a fixed array of static
398 closures predeclared.
401 cgTyCon :: TyCon -> FCode [Cmm] -- each constructor gets a separate Cmm
403 = do { constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon)
405 -- Generate a table of static closures for an enumeration type
406 -- Put the table after the data constructor decls, because the
407 -- datatype closure table (for enumeration types)
408 -- to (say) PrelBase_$wTrue_closure, which is defined in code_stuff
409 -- Note that the closure pointers are tagged.
411 -- XXX comment says to put table after constructor decls, but
412 -- code appears to put it before --- NR 16 Aug 2007
414 if isEnumerationTyCon tycon then do
415 tbl <- getCmm (emitRODataLits "cgTyCon" (mkLocalClosureTableLabel (tyConName tycon) NoCafRefs)
416 [ CmmLabelOff (mkLocalClosureLabel (dataConName con) NoCafRefs) (tagForCon con)
417 | con <- tyConDataCons tycon])
422 ; return (extra ++ constrs)
426 Generate the entry code, info tables, and (for niladic constructor) the
427 static closure, for a constructor.
430 cgDataCon :: DataCon -> Code
432 = do { -- Don't need any dynamic closure code for zero-arity constructors
435 -- To allow the debuggers, interpreters, etc to cope with
436 -- static data structures (ie those built at compile
437 -- time), we take care that info-table contains the
438 -- information we need.
439 (static_cl_info, _) =
440 layOutStaticConstr data_con arg_reps
442 (dyn_cl_info, arg_things) =
443 layOutDynConstr data_con arg_reps
445 emit_info cl_info ticky_code
446 = do { code_blks <- getCgStmts the_code
447 ; emitClosureCodeAndInfoTable cl_info [] code_blks }
449 the_code = do { _ <- ticky_code
450 ; ldvEnter (CmmReg nodeReg)
453 arg_reps :: [(CgRep, Type)]
454 arg_reps = [(typeCgRep ty, ty) | ty <- dataConRepArgTys data_con]
457 -- NB: We don't set CC when entering data (WDP 94/06)
458 tickyReturnOldCon (length arg_things)
459 -- The case continuation code is expecting a tagged pointer
460 ; stmtC (CmmAssign nodeReg
461 (tagCons data_con (CmmReg nodeReg)))
462 ; performReturn emitReturnInstr }
463 -- noStmts: Ptr to thing already in Node
465 ; whenC (not (isNullaryRepDataCon data_con))
466 (emit_info dyn_cl_info tickyEnterDynCon)
468 -- Dynamic-Closure first, to reduce forward references
469 ; emit_info static_cl_info tickyEnterStaticCon }