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,
17 #include "HsVersions.h"
23 import AbsCUtils ( getAmodeRep )
24 import CgBindery ( getArgAmodes, bindNewToNode,
26 idInfoToAmode, stableAmodeIdInfo,
27 heapIdInfo, CgIdInfo, bindNewToStack
29 import CgStackery ( mkVirtStkOffsets, freeStackSlots )
30 import CgUsages ( getRealSp, getVirtSp, setRealAndVirtualSp )
31 import CgRetConv ( assignRegs )
32 import Constants ( mAX_INTLIKE, mIN_INTLIKE, mAX_CHARLIKE, mIN_CHARLIKE )
33 import CgHeapery ( allocDynClosure )
34 import CgTailCall ( performReturn, mkStaticAlgReturnCode,
36 import CLabel ( mkClosureLabel )
37 import ClosureInfo ( mkConLFInfo, mkLFArgument, layOutDynConstr,
38 layOutStaticConstr, mkStaticClosure
40 import CostCentre ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
42 import DataCon ( DataCon, dataConTag,
43 isUnboxedTupleCon, dataConWorkId,
44 dataConName, dataConRepArity
46 import Id ( Id, idName, idPrimRep, isDeadBinder )
47 import Literal ( Literal(..) )
48 import PrelInfo ( maybeCharLikeCon, maybeIntLikeCon )
49 import PrimRep ( PrimRep(..), isFollowableRep )
53 import List ( partition )
57 %************************************************************************
59 \subsection[toplevel-constructors]{Top-level constructors}
61 %************************************************************************
64 cgTopRhsCon :: Id -- Name of thing bound to this RHS
67 -> FCode (Id, CgIdInfo)
68 cgTopRhsCon id con args
69 = ASSERT( not (isDllConApp con args) )
70 ASSERT( args `lengthIs` dataConRepArity con )
73 getArgAmodes args `thenFC` \ amodes ->
77 lf_info = mkConLFInfo con
78 closure_label = mkClosureLabel name
79 (closure_info, amodes_w_offsets)
80 = layOutStaticConstr con getAmodeRep amodes
81 caffy = any stgArgHasCafRefs args
88 dontCareCCS -- because it's static data
89 (map fst amodes_w_offsets) -- Sorted into ptrs first, then nonptrs
92 -- NOTE: can't use idCafInfo instead of nonEmptySRT above,
93 -- because top-level constructors that were floated by
94 -- CorePrep don't have CafInfo attached. The SRT is more
98 returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info)
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 -> [CAddrMode] -- 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 cc con []
138 = returnFC (stableAmodeIdInfo binder
139 (CLbl (mkClosureLabel (dataConName con)) PtrRep)
143 The following three paragraphs about @Char@-like and @Int@-like
144 closures are obsolete, but I don't understand the details well enough
145 to properly word them, sorry. I've changed the treatment of @Char@s to
146 be analogous to @Int@s: only a subset is preallocated, because @Char@
147 has now 31 bits. Only literals are handled here. -- Qrczak
149 Now for @Char@-like closures. We generate an assignment of the
150 address of the closure to a temporary. It would be possible simply to
151 generate no code, and record the addressing mode in the environment,
152 but we'd have to be careful if the argument wasn't a constant --- so
153 for simplicity we just always asssign to a temporary.
155 Last special case: @Int@-like closures. We only special-case the
156 situation in which the argument is a literal in the range
157 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
158 work with any old argument, but for @Int@-like ones the argument has
159 to be a literal. Reason: @Char@ like closures have an argument type
160 which is guaranteed in range.
162 Because of this, we use can safely return an addressing mode.
165 buildDynCon binder cc con [arg_amode]
166 | maybeIntLikeCon con && in_range_int_lit arg_amode
167 = returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con))
169 in_range_int_lit (CLit (MachInt val)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
170 in_range_int_lit _other_amode = False
172 buildDynCon binder cc con [arg_amode]
173 | maybeCharLikeCon con && in_range_char_lit arg_amode
174 = returnFC (stableAmodeIdInfo binder (CCharLike arg_amode) (mkConLFInfo con))
176 in_range_char_lit (CLit (MachChar val)) =
177 ord val <= mAX_CHARLIKE && ord val >= mIN_CHARLIKE
178 in_range_char_lit _other_amode = False
181 Now the general case.
184 buildDynCon binder ccs con args
185 = allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off ->
186 returnFC (heapIdInfo binder hp_off lf_info)
188 lf_info = mkConLFInfo con
190 (closure_info, amodes_w_offsets) = layOutDynConstr con getAmodeRep args
192 use_cc -- cost-centre to stick in the object
193 = if currentOrSubsumedCCS ccs
194 then CReg CurCostCentre
195 else mkCCostCentreStack ccs
197 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
201 %************************************************************************
203 %* constructor-related utility function: *
204 %* bindConArgs is called from cgAlt of a case *
206 %************************************************************************
207 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
209 @bindConArgs@ $con args$ augments the environment with bindings for the
210 binders $args$, assuming that we have just returned from a @case@ which
215 :: DataCon -> [Id] -- Constructor and args
219 = ASSERT(not (isUnboxedTupleCon con))
220 mapCs bind_arg args_w_offsets
222 bind_arg (arg, offset) = bindNewToNode arg offset (mkLFArgument arg)
223 (_, args_w_offsets) = layOutDynConstr con idPrimRep args
226 Unboxed tuples are handled slightly differently - the object is
227 returned in registers and on the stack instead of the heap.
230 bindUnboxedTupleComponents
232 -> FCode ([MagicId], -- Regs assigned
233 Int, -- Number of pointer stack slots
234 Int, -- Number of non-pointer stack slots
235 VirtualSpOffset) -- Offset of return address slot
236 -- (= realSP on entry)
238 bindUnboxedTupleComponents args
239 = -- Assign as many components as possible to registers
240 let (arg_regs, _leftovers) = assignRegs [] (map idPrimRep args)
241 (reg_args, stk_args) = splitAtList arg_regs args
243 -- separate the rest of the args into pointers and non-pointers
244 (ptr_args, nptr_args) =
245 partition (isFollowableRep . idPrimRep) stk_args
248 -- Allocate the rest on the stack
249 -- The real SP points to the return address, above which any
250 -- leftover unboxed-tuple components will be allocated
251 getVirtSp `thenFC` \ vsp ->
252 getRealSp `thenFC` \ rsp ->
254 (ptr_sp, ptr_offsets) = mkVirtStkOffsets rsp idPrimRep ptr_args
255 (nptr_sp, nptr_offsets) = mkVirtStkOffsets ptr_sp idPrimRep nptr_args
257 nptrs = nptr_sp - ptr_sp
260 -- The stack pointer points to the last stack-allocated component
261 setRealAndVirtualSp nptr_sp `thenC`
263 -- We have just allocated slots starting at real SP + 1, and set the new
264 -- virtual SP to the topmost allocated slot.
265 -- If the virtual SP started *below* the real SP, we've just jumped over
266 -- some slots that won't be in the free-list, so put them there
267 -- This commonly happens because we've freed the return-address slot
268 -- (trimming back the virtual SP), but the real SP still points to that slot
269 freeStackSlots [vsp+1,vsp+2 .. rsp] `thenC`
271 bindArgsToRegs reg_args arg_regs `thenC`
272 mapCs bindNewToStack ptr_offsets `thenC`
273 mapCs bindNewToStack nptr_offsets `thenC`
275 returnFC (arg_regs, ptrs, nptrs, rsp)
278 %************************************************************************
280 \subsubsection[CgRetConv-cgReturnDataCon]{Actually generate code for a constructor return}
282 %************************************************************************
285 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
286 sure the @amodes@ passed don't conflict with each other.
288 cgReturnDataCon :: DataCon -> [CAddrMode] -> Code
290 cgReturnDataCon con amodes
291 = ASSERT( amodes `lengthIs` dataConRepArity con )
292 getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_sp sequel) ->
296 CaseAlts _ (Just (alts, Just (deflt_bndr, (_,deflt_lbl)))) False
297 | not (dataConTag con `is_elem` map fst alts)
299 -- Special case! We're returning a constructor to the default case
300 -- of an enclosing case. For example:
302 -- case (case e of (a,b) -> C a b) of
304 -- y -> ...<returning here!>...
307 -- if the default is a non-bind-default (ie does not use y),
308 -- then we should simply jump to the default join point;
310 if isDeadBinder deflt_bndr
311 then performReturn AbsCNop {- No reg assts -} jump_to_join_point
312 else build_it_then jump_to_join_point
314 is_elem = isIn "cgReturnDataCon"
315 jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
316 -- Ignore the sequel: we've already looked at it above
318 other_sequel -- The usual case
319 | isUnboxedTupleCon con -> returnUnboxedTuple amodes
320 | otherwise -> build_it_then (mkStaticAlgReturnCode con)
323 move_to_reg :: CAddrMode -> MagicId -> AbstractC
324 move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode
326 build_it_then return =
327 -- BUILD THE OBJECT IN THE HEAP
328 -- The first "con" says that the name bound to this
329 -- closure is "con", which is a bit of a fudge, but it only
332 -- This Id is also used to get a unique for a
333 -- temporary variable, if the closure is a CHARLIKE.
334 -- funnily enough, this makes the unique always come
336 buildDynCon (dataConWorkId con) currentCCS con amodes `thenFC` \ idinfo ->
337 idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
341 profCtrC FSLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
342 -- could use doTailCall here.
343 performReturn (move_to_reg amode node) return