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 )
56 %************************************************************************
58 \subsection[toplevel-constructors]{Top-level constructors}
60 %************************************************************************
63 cgTopRhsCon :: Id -- Name of thing bound to this RHS
66 -> FCode (Id, CgIdInfo)
67 cgTopRhsCon id con args
68 = ASSERT( not (isDllConApp con args) )
69 ASSERT( args `lengthIs` dataConRepArity con )
72 getArgAmodes args `thenFC` \ amodes ->
76 lf_info = mkConLFInfo con
77 closure_label = mkClosureLabel name
78 (closure_info, amodes_w_offsets)
79 = layOutStaticConstr con getAmodeRep amodes
80 caffy = any stgArgHasCafRefs args
87 dontCareCCS -- because it's static data
88 (map fst amodes_w_offsets) -- Sorted into ptrs first, then nonptrs
91 -- NOTE: can't use idCafInfo instead of nonEmptySRT above,
92 -- because top-level constructors that were floated by
93 -- CorePrep don't have CafInfo attached. The SRT is more
97 returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info)
100 %************************************************************************
102 %* non-top-level constructors *
104 %************************************************************************
105 \subsection[code-for-constructors]{The code for constructors}
108 buildDynCon :: Id -- Name of the thing to which this constr will
110 -> CostCentreStack -- Where to grab cost centre from;
111 -- current CCS if currentOrSubsumedCCS
112 -> DataCon -- The data constructor
113 -> [CAddrMode] -- Its args
114 -> FCode CgIdInfo -- Return details about how to find it
116 -- We used to pass a boolean indicating whether all the
117 -- args were of size zero, so we could use a static
118 -- construtor; but I concluded that it just isn't worth it.
119 -- Now I/O uses unboxed tuples there just aren't any constructors
120 -- with all size-zero args.
122 -- The reason for having a separate argument, rather than looking at
123 -- the addr modes of the args is that we may be in a "knot", and
124 -- premature looking at the args will cause the compiler to black-hole!
127 First we deal with the case of zero-arity constructors. Now, they
128 will probably be unfolded, so we don't expect to see this case much,
129 if at all, but it does no harm, and sets the scene for characters.
131 In the case of zero-arity constructors, or, more accurately, those
132 which have exclusively size-zero (VoidRep) args, we generate no code
136 buildDynCon binder cc con []
137 = returnFC (stableAmodeIdInfo binder
138 (CLbl (mkClosureLabel (dataConName con)) PtrRep)
142 The following three paragraphs about @Char@-like and @Int@-like
143 closures are obsolete, but I don't understand the details well enough
144 to properly word them, sorry. I've changed the treatment of @Char@s to
145 be analogous to @Int@s: only a subset is preallocated, because @Char@
146 has now 31 bits. Only literals are handled here. -- Qrczak
148 Now for @Char@-like closures. We generate an assignment of the
149 address of the closure to a temporary. It would be possible simply to
150 generate no code, and record the addressing mode in the environment,
151 but we'd have to be careful if the argument wasn't a constant --- so
152 for simplicity we just always asssign to a temporary.
154 Last special case: @Int@-like closures. We only special-case the
155 situation in which the argument is a literal in the range
156 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
157 work with any old argument, but for @Int@-like ones the argument has
158 to be a literal. Reason: @Char@ like closures have an argument type
159 which is guaranteed in range.
161 Because of this, we use can safely return an addressing mode.
164 buildDynCon binder cc con [arg_amode]
165 | maybeIntLikeCon con && in_range_int_lit arg_amode
166 = returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con))
168 in_range_int_lit (CLit (MachInt val)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
169 in_range_int_lit _other_amode = False
171 buildDynCon binder cc con [arg_amode]
172 | maybeCharLikeCon con && in_range_char_lit arg_amode
173 = returnFC (stableAmodeIdInfo binder (CCharLike arg_amode) (mkConLFInfo con))
175 in_range_char_lit (CLit (MachChar val)) = val <= mAX_CHARLIKE && val >= mIN_CHARLIKE
176 in_range_char_lit _other_amode = False
179 Now the general case.
182 buildDynCon binder ccs con args
183 = allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off ->
184 returnFC (heapIdInfo binder hp_off lf_info)
186 lf_info = mkConLFInfo con
188 (closure_info, amodes_w_offsets) = layOutDynConstr con getAmodeRep args
190 use_cc -- cost-centre to stick in the object
191 = if currentOrSubsumedCCS ccs
192 then CReg CurCostCentre
193 else mkCCostCentreStack ccs
195 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
199 %************************************************************************
201 %* constructor-related utility function: *
202 %* bindConArgs is called from cgAlt of a case *
204 %************************************************************************
205 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
207 @bindConArgs@ $con args$ augments the environment with bindings for the
208 binders $args$, assuming that we have just returned from a @case@ which
213 :: DataCon -> [Id] -- Constructor and args
217 = ASSERT(not (isUnboxedTupleCon con))
218 mapCs bind_arg args_w_offsets
220 bind_arg (arg, offset) = bindNewToNode arg offset (mkLFArgument arg)
221 (_, args_w_offsets) = layOutDynConstr con idPrimRep args
224 Unboxed tuples are handled slightly differently - the object is
225 returned in registers and on the stack instead of the heap.
228 bindUnboxedTupleComponents
230 -> FCode ([MagicId], -- Regs assigned
231 Int, -- Number of pointer stack slots
232 Int, -- Number of non-pointer stack slots
233 VirtualSpOffset) -- Offset of return address slot
234 -- (= realSP on entry)
236 bindUnboxedTupleComponents args
237 = -- Assign as many components as possible to registers
238 let (arg_regs, _leftovers) = assignRegs [] (map idPrimRep args)
239 (reg_args, stk_args) = splitAtList arg_regs args
241 -- separate the rest of the args into pointers and non-pointers
242 (ptr_args, nptr_args) =
243 partition (isFollowableRep . idPrimRep) stk_args
246 -- Allocate the rest on the stack
247 -- The real SP points to the return address, above which any
248 -- leftover unboxed-tuple components will be allocated
249 getVirtSp `thenFC` \ vsp ->
250 getRealSp `thenFC` \ rsp ->
252 (ptr_sp, ptr_offsets) = mkVirtStkOffsets rsp idPrimRep ptr_args
253 (nptr_sp, nptr_offsets) = mkVirtStkOffsets ptr_sp idPrimRep nptr_args
255 nptrs = nptr_sp - ptr_sp
258 -- The stack pointer points to the last stack-allocated component
259 setRealAndVirtualSp nptr_sp `thenC`
261 -- We have just allocated slots starting at real SP + 1, and set the new
262 -- virtual SP to the topmost allocated slot.
263 -- If the virtual SP started *below* the real SP, we've just jumped over
264 -- some slots that won't be in the free-list, so put them there
265 -- This commonly happens because we've freed the return-address slot
266 -- (trimming back the virtual SP), but the real SP still points to that slot
267 freeStackSlots [vsp+1,vsp+2 .. rsp] `thenC`
269 bindArgsToRegs reg_args arg_regs `thenC`
270 mapCs bindNewToStack ptr_offsets `thenC`
271 mapCs bindNewToStack nptr_offsets `thenC`
273 returnFC (arg_regs, ptrs, nptrs, rsp)
276 %************************************************************************
278 \subsubsection[CgRetConv-cgReturnDataCon]{Actually generate code for a constructor return}
280 %************************************************************************
283 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
284 sure the @amodes@ passed don't conflict with each other.
286 cgReturnDataCon :: DataCon -> [CAddrMode] -> Code
288 cgReturnDataCon con amodes
289 = ASSERT( amodes `lengthIs` dataConRepArity con )
290 getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_sp sequel) ->
294 CaseAlts _ (Just (alts, Just (deflt_bndr, (_,deflt_lbl)))) False
295 | not (dataConTag con `is_elem` map fst alts)
297 -- Special case! We're returning a constructor to the default case
298 -- of an enclosing case. For example:
300 -- case (case e of (a,b) -> C a b) of
302 -- y -> ...<returning here!>...
305 -- if the default is a non-bind-default (ie does not use y),
306 -- then we should simply jump to the default join point;
308 if isDeadBinder deflt_bndr
309 then performReturn AbsCNop {- No reg assts -} jump_to_join_point
310 else build_it_then jump_to_join_point
312 is_elem = isIn "cgReturnDataCon"
313 jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
314 -- Ignore the sequel: we've already looked at it above
316 other_sequel -- The usual case
317 | isUnboxedTupleCon con -> returnUnboxedTuple amodes
318 | otherwise -> build_it_then (mkStaticAlgReturnCode con)
321 move_to_reg :: CAddrMode -> MagicId -> AbstractC
322 move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode
324 build_it_then return =
325 -- BUILD THE OBJECT IN THE HEAP
326 -- The first "con" says that the name bound to this
327 -- closure is "con", which is a bit of a fudge, but it only
330 -- This Id is also used to get a unique for a
331 -- temporary variable, if the closure is a CHARLIKE.
332 -- funnily enough, this makes the unique always come
334 buildDynCon (dataConWorkId con) currentCCS con amodes `thenFC` \ idinfo ->
335 idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
339 profCtrC FSLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
340 -- could use doTailCall here.
341 performReturn (move_to_reg amode node) return