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, updateFrameSize )
30 import CgUsages ( getRealSp, getVirtSp, setRealAndVirtualSp,
32 import CgRetConv ( assignRegs )
33 import Constants ( mAX_INTLIKE, mIN_INTLIKE, mAX_CHARLIKE, mIN_CHARLIKE,
35 import CgHeapery ( allocDynClosure, inPlaceAllocDynClosure )
36 import CgTailCall ( performReturn, mkStaticAlgReturnCode,
38 import CLabel ( mkClosureLabel )
39 import ClosureInfo ( mkConLFInfo, mkLFArgument, layOutDynConstr,
40 layOutStaticConstr, closureSize, mkStaticClosure
42 import CostCentre ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
44 import DataCon ( DataCon, dataConTag,
45 isUnboxedTupleCon, isNullaryDataCon, dataConWorkId,
46 dataConName, dataConRepArity
48 import Id ( Id, idName, idPrimRep )
49 import Literal ( Literal(..) )
50 import PrelInfo ( maybeCharLikeCon, maybeIntLikeCon )
51 import PrimRep ( PrimRep(..), isFollowableRep )
52 import Unique ( Uniquable(..) )
56 import List ( partition )
59 %************************************************************************
61 \subsection[toplevel-constructors]{Top-level constructors}
63 %************************************************************************
66 cgTopRhsCon :: Id -- Name of thing bound to this RHS
69 -> FCode (Id, CgIdInfo)
70 cgTopRhsCon id con args
71 = ASSERT( not (isDllConApp con args) ) -- checks for litlit args too
72 ASSERT( args `lengthIs` dataConRepArity con )
75 getArgAmodes args `thenFC` \ amodes ->
79 lf_info = mkConLFInfo con
80 closure_label = mkClosureLabel name
81 (closure_info, amodes_w_offsets)
82 = layOutStaticConstr con getAmodeRep amodes
83 caffy = any stgArgHasCafRefs args
90 dontCareCCS -- because it's static data
91 (map fst amodes_w_offsets) -- Sorted into ptrs first, then nonptrs
94 -- NOTE: can't use idCafInfo instead of nonEmptySRT above,
95 -- because top-level constructors that were floated by
96 -- CorePrep don't have CafInfo attached. The SRT is more
100 returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info)
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 -> [CAddrMode] -- 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 cc con []
140 = returnFC (stableAmodeIdInfo binder
141 (CLbl (mkClosureLabel (dataConName con)) PtrRep)
145 The following three paragraphs about @Char@-like and @Int@-like
146 closures are obsolete, but I don't understand the details well enough
147 to properly word them, sorry. I've changed the treatment of @Char@s to
148 be analogous to @Int@s: only a subset is preallocated, because @Char@
149 has now 31 bits. Only literals are handled here. -- Qrczak
151 Now for @Char@-like closures. We generate an assignment of the
152 address of the closure to a temporary. It would be possible simply to
153 generate no code, and record the addressing mode in the environment,
154 but we'd have to be careful if the argument wasn't a constant --- so
155 for simplicity we just always asssign to a temporary.
157 Last special case: @Int@-like closures. We only special-case the
158 situation in which the argument is a literal in the range
159 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
160 work with any old argument, but for @Int@-like ones the argument has
161 to be a literal. Reason: @Char@ like closures have an argument type
162 which is guaranteed in range.
164 Because of this, we use can safely return an addressing mode.
167 buildDynCon binder cc con [arg_amode]
168 | maybeIntLikeCon con && in_range_int_lit arg_amode
169 = returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con))
171 in_range_int_lit (CLit (MachInt val)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
172 in_range_int_lit _other_amode = False
174 buildDynCon binder cc con [arg_amode]
175 | maybeCharLikeCon con && in_range_char_lit arg_amode
176 = returnFC (stableAmodeIdInfo binder (CCharLike arg_amode) (mkConLFInfo con))
178 in_range_char_lit (CLit (MachChar val)) = val <= mAX_CHARLIKE && val >= mIN_CHARLIKE
179 in_range_char_lit _other_amode = False
182 Now the general case.
185 buildDynCon binder ccs con args
186 = allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off ->
187 returnFC (heapIdInfo binder hp_off lf_info)
189 lf_info = mkConLFInfo con
191 (closure_info, amodes_w_offsets) = layOutDynConstr con getAmodeRep args
193 use_cc -- cost-centre to stick in the object
194 = if currentOrSubsumedCCS ccs
195 then CReg CurCostCentre
196 else mkCCostCentreStack ccs
198 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
202 %************************************************************************
204 %* constructor-related utility function: *
205 %* bindConArgs is called from cgAlt of a case *
207 %************************************************************************
208 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
210 @bindConArgs@ $con args$ augments the environment with bindings for the
211 binders $args$, assuming that we have just returned from a @case@ which
216 :: DataCon -> [Id] -- Constructor and args
220 = ASSERT(not (isUnboxedTupleCon con))
221 mapCs bind_arg args_w_offsets
223 bind_arg (arg, offset) = bindNewToNode arg offset (mkLFArgument arg)
224 (_, args_w_offsets) = layOutDynConstr con idPrimRep args
227 Unboxed tuples are handled slightly differently - the object is
228 returned in registers and on the stack instead of the heap.
231 bindUnboxedTupleComponents
233 -> FCode ([MagicId], -- regs assigned
234 Int, -- number of pointer stack slots
235 Int, -- number of non-pointer stack slots
236 Bool) -- any components on stack?
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 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
256 -- The stack pointer points to the last stack-allocated component
257 setRealAndVirtualSp nptr_sp `thenC`
259 -- need to explicitly free any empty slots we just jumped over
260 (if vsp < rsp then freeStackSlots [vsp+1 .. rsp] else nopC) `thenC`
262 bindArgsToRegs reg_args arg_regs `thenC`
263 mapCs bindNewToStack ptr_offsets `thenC`
264 mapCs bindNewToStack nptr_offsets `thenC`
267 ptr_sp - rsp, nptr_sp - ptr_sp,
268 notNull ptr_offsets || notNull ptr_offsets
272 %************************************************************************
274 \subsubsection[CgRetConv-cgReturnDataCon]{Actually generate code for a constructor return}
276 %************************************************************************
279 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
280 sure the @amodes@ passed don't conflict with each other.
282 cgReturnDataCon :: DataCon -> [CAddrMode] -> Code
284 cgReturnDataCon con amodes
285 = ASSERT( amodes `lengthIs` dataConRepArity con )
286 getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_sp sequel) ->
290 CaseAlts _ (Just (alts, Just (maybe_deflt, (_,deflt_lbl)))) False
291 | not (dataConTag con `is_elem` map fst alts)
293 -- Special case! We're returning a constructor to the default case
294 -- of an enclosing case. For example:
296 -- case (case e of (a,b) -> C a b) of
298 -- y -> ...<returning here!>...
301 -- if the default is a non-bind-default (ie does not use y),
302 -- then we should simply jump to the default join point;
305 Nothing -> performReturn AbsCNop {- No reg assts -} jump_to_join_point
306 Just _ -> build_it_then jump_to_join_point
308 is_elem = isIn "cgReturnDataCon"
309 jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
310 -- Ignore the sequel: we've already looked at it above
312 -- If the sequel is an update frame, we might be able to
313 -- do update in place...
315 | not (isNullaryDataCon con) -- no nullary constructors, please
316 && not (any isFollowableRep (map getAmodeRep amodes))
317 -- no ptrs please (generational gc...)
318 && closureSize closure_info <= mIN_UPD_SIZE
319 -- don't know the real size of the
320 -- thunk, so assume mIN_UPD_SIZE
322 -> -- get a new temporary and make it point to the updatee
325 temp = CTemp uniq PtrRep
328 profCtrC FSLIT("TICK_UPD_CON_IN_PLACE")
329 [mkIntCLit (length amodes)] `thenC`
331 getSpRelOffset args_sp `thenFC` \ sp_rel ->
333 (CMacroExpr PtrRep UPD_FRAME_UPDATEE [CAddr sp_rel]))
336 -- stomp all over it with the new constructor
337 inPlaceAllocDynClosure closure_info temp (CReg CurCostCentre) stuff
340 -- set Node to point to the closure being returned
341 -- (can't be done earlier: node might conflict with amodes)
342 absC (CAssign (CReg node) temp) `thenC`
344 -- pop the update frame off the stack, and do the proper
346 let new_sp = args_sp - updateFrameSize in
347 setEndOfBlockInfo (EndOfBlockInfo new_sp (OnStack new_sp)) $
348 performReturn (AbsCNop) (mkStaticAlgReturnCode con)
351 (closure_info, stuff) = layOutDynConstr con getAmodeRep amodes
353 other_sequel -- The usual case
354 | isUnboxedTupleCon con -> returnUnboxedTuple amodes
355 | otherwise -> build_it_then (mkStaticAlgReturnCode con)
358 move_to_reg :: CAddrMode -> MagicId -> AbstractC
359 move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode
361 build_it_then return =
362 -- BUILD THE OBJECT IN THE HEAP
363 -- The first "con" says that the name bound to this
364 -- closure is "con", which is a bit of a fudge, but it only
367 -- This Id is also used to get a unique for a
368 -- temporary variable, if the closure is a CHARLIKE.
369 -- funnily enough, this makes the unique always come
371 buildDynCon (dataConWorkId con) currentCCS con amodes `thenFC` \ idinfo ->
372 idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
376 profCtrC FSLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
377 -- could use doTailCall here.
378 performReturn (move_to_reg amode node) return