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.
12 {-# OPTIONS_GHC -w #-}
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/WorkingConventions#Warnings
20 cgTopRhsCon, buildDynCon,
21 bindConArgs, bindUnboxedTupleComponents,
26 #include "HsVersions.h"
55 import Util ( lengthIs )
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
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)))
151 The following three paragraphs about @Char@-like and @Int@-like
152 closures are obsolete, but I don't understand the details well enough
153 to properly word them, sorry. I've changed the treatment of @Char@s to
154 be analogous to @Int@s: only a subset is preallocated, because @Char@
155 has now 31 bits. Only literals are handled here. -- Qrczak
157 Now for @Char@-like closures. We generate an assignment of the
158 address of the closure to a temporary. It would be possible simply to
159 generate no code, and record the addressing mode in the environment,
160 but we'd have to be careful if the argument wasn't a constant --- so
161 for simplicity we just always asssign to a temporary.
163 Last special case: @Int@-like closures. We only special-case the
164 situation in which the argument is a literal in the range
165 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
166 work with any old argument, but for @Int@-like ones the argument has
167 to be a literal. Reason: @Char@ like closures have an argument type
168 which is guaranteed in range.
170 Because of this, we use can safely return an addressing mode.
173 buildDynCon binder cc con [arg_amode]
174 | maybeIntLikeCon con
175 , (_, CmmLit (CmmInt val _)) <- arg_amode
176 , let val_int = (fromIntegral val) :: Int
177 , val_int <= mAX_INTLIKE && val_int >= mIN_INTLIKE
178 = do { let intlike_lbl = mkRtsDataLabel SLIT("stg_INTLIKE_closure")
179 offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1)
180 -- INTLIKE closures consist of a header and one word payload
181 intlike_amode = CmmLit (cmmLabelOffW intlike_lbl offsetW)
182 ; returnFC (taggedStableIdInfo binder intlike_amode (mkConLFInfo con) con) }
184 buildDynCon binder cc con [arg_amode]
185 | maybeCharLikeCon con
186 , (_, CmmLit (CmmInt val _)) <- arg_amode
187 , let val_int = (fromIntegral val) :: Int
188 , val_int <= mAX_CHARLIKE && val_int >= mIN_CHARLIKE
189 = do { let charlike_lbl = mkRtsDataLabel SLIT("stg_CHARLIKE_closure")
190 offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize + 1)
191 -- CHARLIKE closures consist of a header and one word payload
192 charlike_amode = CmmLit (cmmLabelOffW charlike_lbl offsetW)
193 ; returnFC (taggedStableIdInfo binder charlike_amode (mkConLFInfo con) con) }
196 Now the general case.
199 buildDynCon binder ccs con args
202 (closure_info, amodes_w_offsets) = layOutDynConstr con args
204 ; hp_off <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
205 ; returnFC (taggedHeapIdInfo binder hp_off lf_info con) }
207 lf_info = mkConLFInfo con
209 use_cc -- cost-centre to stick in the object
210 | currentOrSubsumedCCS ccs = curCCS
211 | otherwise = CmmLit (mkCCostCentreStack ccs)
213 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
217 %************************************************************************
219 %* constructor-related utility function: *
220 %* bindConArgs is called from cgAlt of a case *
222 %************************************************************************
223 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
225 @bindConArgs@ $con args$ augments the environment with bindings for the
226 binders $args$, assuming that we have just returned from a @case@ which
230 bindConArgs :: DataCon -> [Id] -> Code
234 -- The binding below forces the masking out of the tag bits
235 -- when accessing the constructor field.
236 bind_arg (arg, offset) = bindNewToUntagNode arg offset (mkLFArgument arg) (tagForCon con)
237 (_, args_w_offsets) = layOutDynConstr 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 emitReturnInstr
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
399 -- Note that the closure pointers are tagged.
401 if isEnumerationTyCon tycon then do
402 tbl <- getCmm (emitRODataLits (mkLocalClosureTableLabel
404 [ CmmLabelOff (mkLocalClosureLabel (dataConName con)) (tagForCon con)
405 | con <- tyConDataCons tycon])
410 ; return (extra ++ constrs)
414 Generate the entry code, info tables, and (for niladic constructor) the
415 static closure, for a constructor.
418 cgDataCon :: DataCon -> Code
420 = do { -- Don't need any dynamic closure code for zero-arity constructors
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 data_con arg_reps
430 (dyn_cl_info, arg_things) =
431 layOutDynConstr 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 -- The case continuation code is expecting a tagged pointer
448 ; stmtC (CmmAssign nodeReg
449 (tagCons data_con (CmmReg nodeReg)))
450 ; performReturn emitReturnInstr }
451 -- noStmts: Ptr to thing already in Node
453 ; whenC (not (isNullaryRepDataCon data_con))
454 (emit_info dyn_cl_info tickyEnterDynCon)
456 -- Dynamic-Closure first, to reduce forward references
457 ; emit_info static_cl_info tickyEnterStaticCon }