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 ( mkTaggedVirtStkOffsets, freeStackSlots,
32 import CgUsages ( getRealSp, getVirtSp, setRealAndVirtualSp,
34 import CgRetConv ( assignRegs )
35 import Constants ( mAX_INTLIKE, mIN_INTLIKE, mAX_CHARLIKE, mIN_CHARLIKE,
37 import CgHeapery ( allocDynClosure, inPlaceAllocDynClosure )
38 import CgTailCall ( performReturn, mkStaticAlgReturnCode, doTailCall,
39 mkUnboxedTupleReturnCode )
40 import CLabel ( mkClosureLabel )
41 import ClosureInfo ( mkConLFInfo, mkLFArgument, closureLFInfo,
42 layOutDynConstr, layOutDynClosure,
43 layOutStaticConstr, closureSize, mkStaticClosure
45 import CostCentre ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
47 import DataCon ( DataCon, dataConName, dataConTag,
48 isUnboxedTupleCon, isNullaryDataCon, dataConId,
49 dataConWrapId, dataConRepArity
51 import Id ( Id, idName, idPrimRep, idCafInfo )
52 import IdInfo ( mayHaveCafRefs )
53 import Literal ( Literal(..) )
54 import PrelInfo ( maybeCharLikeCon, maybeIntLikeCon )
55 import PrimRep ( PrimRep(..), isFollowableRep )
56 import Unique ( Uniquable(..) )
61 %************************************************************************
63 \subsection[toplevel-constructors]{Top-level constructors}
65 %************************************************************************
68 cgTopRhsCon :: Id -- Name of thing bound to this RHS
72 -> FCode (Id, CgIdInfo)
73 cgTopRhsCon id con args srt
74 = ASSERT( not (isDllConApp con args) ) -- checks for litlit args too
75 ASSERT( args `lengthIs` dataConRepArity con )
78 getArgAmodes args `thenFC` \ amodes ->
82 lf_info = closureLFInfo closure_info
83 closure_label = mkClosureLabel name
84 (closure_info, amodes_w_offsets)
85 = layOutStaticConstr name con getAmodeRep amodes
91 dontCareCCS -- because it's static data
92 (map fst amodes_w_offsets) -- Sorted into ptrs first, then nonptrs
93 (nonEmptySRT srt) -- has CAF refs
95 -- NOTE: can't use idCafInfo instead of nonEmptySRT above,
96 -- because top-level constructors that were floated by
97 -- CorePrep don't have CafInfo attached. The SRT is more
101 returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info)
104 %************************************************************************
106 %* non-top-level constructors *
108 %************************************************************************
109 \subsection[code-for-constructors]{The code for constructors}
112 buildDynCon :: Id -- Name of the thing to which this constr will
114 -> CostCentreStack -- Where to grab cost centre from;
115 -- current CCS if currentOrSubsumedCCS
116 -> DataCon -- The data constructor
117 -> [CAddrMode] -- Its args
118 -> FCode CgIdInfo -- Return details about how to find it
120 -- We used to pass a boolean indicating whether all the
121 -- args were of size zero, so we could use a static
122 -- construtor; but I concluded that it just isn't worth it.
123 -- Now I/O uses unboxed tuples there just aren't any constructors
124 -- with all size-zero args.
126 -- The reason for having a separate argument, rather than looking at
127 -- the addr modes of the args is that we may be in a "knot", and
128 -- premature looking at the args will cause the compiler to black-hole!
131 First we deal with the case of zero-arity constructors. Now, they
132 will probably be unfolded, so we don't expect to see this case much,
133 if at all, but it does no harm, and sets the scene for characters.
135 In the case of zero-arity constructors, or, more accurately, those
136 which have exclusively size-zero (VoidRep) args, we generate no code
140 buildDynCon binder cc con []
141 = returnFC (stableAmodeIdInfo binder
142 (CLbl (mkClosureLabel (idName (dataConWrapId con))) PtrRep)
146 The following three paragraphs about @Char@-like and @Int@-like
147 closures are obsolete, but I don't understand the details well enough
148 to properly word them, sorry. I've changed the treatment of @Char@s to
149 be analogous to @Int@s: only a subset is preallocated, because @Char@
150 has now 31 bits. Only literals are handled here. -- Qrczak
152 Now for @Char@-like closures. We generate an assignment of the
153 address of the closure to a temporary. It would be possible simply to
154 generate no code, and record the addressing mode in the environment,
155 but we'd have to be careful if the argument wasn't a constant --- so
156 for simplicity we just always asssign to a temporary.
158 Last special case: @Int@-like closures. We only special-case the
159 situation in which the argument is a literal in the range
160 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
161 work with any old argument, but for @Int@-like ones the argument has
162 to be a literal. Reason: @Char@ like closures have an argument type
163 which is guaranteed in range.
165 Because of this, we use can safely return an addressing mode.
168 buildDynCon binder cc con [arg_amode]
169 | maybeIntLikeCon con && in_range_int_lit arg_amode
170 = returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con))
172 in_range_int_lit (CLit (MachInt val)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
173 in_range_int_lit _other_amode = False
175 buildDynCon binder cc con [arg_amode]
176 | maybeCharLikeCon con && in_range_char_lit arg_amode
177 = returnFC (stableAmodeIdInfo binder (CCharLike arg_amode) (mkConLFInfo con))
179 in_range_char_lit (CLit (MachChar val)) = val <= mAX_CHARLIKE && val >= mIN_CHARLIKE
180 in_range_char_lit _other_amode = False
183 Now the general case.
186 buildDynCon binder ccs con args
187 = allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off ->
188 returnFC (heapIdInfo binder hp_off lf_info)
190 (closure_info, amodes_w_offsets)
191 = layOutDynClosure (idName binder) getAmodeRep args lf_info NoC_SRT
192 lf_info = mkConLFInfo con
194 use_cc -- cost-centre to stick in the object
195 = if currentOrSubsumedCCS ccs
196 then CReg CurCostCentre
197 else mkCCostCentreStack ccs
199 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
203 %************************************************************************
205 %* constructor-related utility function: *
206 %* bindConArgs is called from cgAlt of a case *
208 %************************************************************************
209 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
211 @bindConArgs@ $con args$ augments the environment with bindings for the
212 binders $args$, assuming that we have just returned from a @case@ which
217 :: DataCon -> [Id] -- Constructor and args
221 = ASSERT(not (isUnboxedTupleCon con))
222 mapCs bind_arg args_w_offsets
224 bind_arg (arg, offset) = bindNewToNode arg offset mkLFArgument
225 (_, args_w_offsets) = layOutDynConstr bogus_name con idPrimRep args
227 bogus_name = panic "bindConArgs"
230 Unboxed tuples are handled slightly differently - the object is
231 returned in registers and on the stack instead of the heap.
234 bindUnboxedTupleComponents
236 -> FCode ([MagicId], -- regs assigned
237 [(VirtualSpOffset,Int)], -- tag slots
238 Bool) -- any components on stack?
240 bindUnboxedTupleComponents args
241 = -- Assign as many components as possible to registers
242 let (arg_regs, _leftovers) = assignRegs [] (map idPrimRep args)
243 (reg_args, stk_args) = splitAtList arg_regs args
246 -- Allocate the rest on the stack (ToDo: separate out pointers)
247 getVirtSp `thenFC` \ vsp ->
248 getRealSp `thenFC` \ rsp ->
249 let (top_sp, stk_offsets, tags) =
250 mkTaggedVirtStkOffsets rsp idPrimRep stk_args
253 -- The stack pointer points to the last stack-allocated component
254 setRealAndVirtualSp top_sp `thenC`
256 -- need to explicitly free any empty slots we just jumped over
257 (if vsp < rsp then freeStackSlots [vsp+1 .. rsp] else nopC) `thenC`
259 bindArgsToRegs reg_args arg_regs `thenC`
260 mapCs bindNewToStack stk_offsets `thenC`
261 returnFC (arg_regs,tags, not (null stk_offsets))
264 %************************************************************************
266 \subsubsection[CgRetConv-cgReturnDataCon]{Actually generate code for a constructor return}
268 %************************************************************************
271 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
272 sure the @amodes@ passed don't conflict with each other.
274 cgReturnDataCon :: DataCon -> [CAddrMode] -> Code
276 cgReturnDataCon con amodes
277 = ASSERT( amodes `lengthIs` dataConRepArity con )
278 getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_sp sequel) ->
282 CaseAlts _ (Just (alts, Just (maybe_deflt, (_,deflt_lbl))))
283 | not (dataConTag con `is_elem` map fst alts)
285 -- Special case! We're returning a constructor to the default case
286 -- of an enclosing case. For example:
288 -- case (case e of (a,b) -> C a b) of
290 -- y -> ...<returning here!>...
293 -- if the default is a non-bind-default (ie does not use y),
294 -- then we should simply jump to the default join point;
297 Nothing -> performReturn AbsCNop {- No reg assts -} jump_to_join_point
298 Just _ -> build_it_then jump_to_join_point
300 is_elem = isIn "cgReturnDataCon"
301 jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
302 -- Ignore the sequel: we've already looked at it above
304 -- If the sequel is an update frame, we might be able to
305 -- do update in place...
307 | not (isNullaryDataCon con) -- no nullary constructors, please
308 && not (any isFollowableRep (map getAmodeRep amodes))
309 -- no ptrs please (generational gc...)
310 && closureSize closure_info <= mIN_UPD_SIZE
311 -- don't know the real size of the
312 -- thunk, so assume mIN_UPD_SIZE
314 -> -- get a new temporary and make it point to the updatee
317 temp = CTemp uniq PtrRep
320 profCtrC SLIT("TICK_UPD_CON_IN_PLACE")
321 [mkIntCLit (length amodes)] `thenC`
323 getSpRelOffset args_sp `thenFC` \ sp_rel ->
325 (CMacroExpr PtrRep UPD_FRAME_UPDATEE [CAddr sp_rel]))
328 -- stomp all over it with the new constructor
329 inPlaceAllocDynClosure closure_info temp (CReg CurCostCentre) stuff
332 -- don't forget to update Su from the update frame
333 absC (CMacroStmt UPDATE_SU_FROM_UPD_FRAME [CAddr sp_rel]) `thenC`
335 -- set Node to point to the closure being returned
336 -- (can't be done earlier: node might conflict with amodes)
337 absC (CAssign (CReg node) temp) `thenC`
339 -- pop the update frame off the stack, and do the proper
341 let new_sp = args_sp - updateFrameSize in
342 setEndOfBlockInfo (EndOfBlockInfo new_sp (OnStack new_sp)) $
343 performReturn (AbsCNop) (mkStaticAlgReturnCode con)
346 (closure_info, stuff)
347 = layOutDynConstr (dataConName con) con getAmodeRep amodes
349 other_sequel -- The usual case
351 | isUnboxedTupleCon con ->
352 -- Return unboxed tuple in registers
353 let (ret_regs, leftovers) =
354 assignRegs [] (map getAmodeRep amodes)
356 profCtrC SLIT("TICK_RET_UNBOXED_TUP")
357 [mkIntCLit (length amodes)] `thenC`
359 doTailCall amodes ret_regs
360 mkUnboxedTupleReturnCode
361 (length leftovers) {- fast args arity -}
362 AbsCNop {-no pending assigments-}
363 Nothing {-not a let-no-escape-}
364 False {-node doesn't point-}
367 build_it_then (mkStaticAlgReturnCode con)
370 move_to_reg :: CAddrMode -> MagicId -> AbstractC
371 move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode
373 build_it_then return =
374 -- BUILD THE OBJECT IN THE HEAP
375 -- The first "con" says that the name bound to this
376 -- closure is "con", which is a bit of a fudge, but it only
379 -- This Id is also used to get a unique for a
380 -- temporary variable, if the closure is a CHARLIKE.
381 -- funnily enough, this makes the unique always come
383 buildDynCon (dataConId con) currentCCS con amodes `thenFC` \ idinfo ->
384 idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
388 profCtrC SLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
389 -- could use doTailCall here.
390 performReturn (move_to_reg amode node) return