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,
25 bindArgsToRegs, newTempAmodeAndIdInfo,
26 idInfoToAmode, stableAmodeIdInfo,
27 heapIdInfo, CgIdInfo, bindNewToStack
29 import CgStackery ( mkTaggedVirtStkOffsets, freeStackSlots,
32 import CgUsages ( getRealSp, getVirtSp, setRealAndVirtualSp,
34 import CgClosure ( cgTopRhsClosure )
35 import CgRetConv ( assignRegs )
36 import Constants ( mAX_INTLIKE, mIN_INTLIKE, mAX_CHARLIKE, mIN_CHARLIKE,
38 import CgHeapery ( allocDynClosure, inPlaceAllocDynClosure )
39 import CgTailCall ( performReturn, mkStaticAlgReturnCode, doTailCall,
40 mkUnboxedTupleReturnCode )
41 import CLabel ( mkClosureLabel )
42 import ClosureInfo ( mkClosureLFInfo, mkConLFInfo, mkLFArgument,
43 layOutDynCon, layOutDynClosure,
44 layOutStaticClosure, closureSize
46 import CostCentre ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
48 import DataCon ( DataCon, dataConName, dataConTag, dataConTyCon,
49 isUnboxedTupleCon, isNullaryDataCon, dataConId, dataConWrapId
51 import Id ( Id, idName, idType, idPrimRep )
52 import Name ( nameModule, isLocallyDefinedName )
53 import Literal ( Literal(..) )
54 import PrelInfo ( maybeCharLikeCon, maybeIntLikeCon )
55 import PrimRep ( PrimRep(..), isFollowableRep )
56 import Unique ( Uniquable(..) )
58 import Panic ( assertPanic, trace )
61 %************************************************************************
63 \subsection[toplevel-constructors]{Top-level constructors}
65 %************************************************************************
68 cgTopRhsCon :: Id -- Name of thing bound to this RHS
71 -> FCode (Id, CgIdInfo)
72 cgTopRhsCon id con args
73 = ASSERT(not dynamic_con_or_args) -- checks for litlit args too
76 getArgAmodes args `thenFC` \ amodes ->
79 (closure_info, amodes_w_offsets)
80 = layOutStaticClosure name getAmodeRep amodes lf_info
85 closure_label -- Labelled with the name on lhs of defn
86 closure_info -- Closure is static
88 (map fst amodes_w_offsets)) -- Sorted into ptrs first, then nonptrs
93 returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info)
95 lf_info = mkConLFInfo con
96 closure_label = mkClosureLabel name
99 top_ccc = mkCCostCentreStack dontCareCCS -- because it's static data
101 -- stuff needed by the assert pred only.
102 dynamic_con_or_args = isDllConApp con args
105 %************************************************************************
107 %* non-top-level constructors *
109 %************************************************************************
110 \subsection[code-for-constructors]{The code for constructors}
113 buildDynCon :: Id -- Name of the thing to which this constr will
115 -> CostCentreStack -- Where to grab cost centre from;
116 -- current CCS if currentOrSubsumedCCS
117 -> DataCon -- The data constructor
118 -> [CAddrMode] -- Its args
119 -> FCode CgIdInfo -- Return details about how to find it
121 -- We used to pass a boolean indicating whether all the
122 -- args were of size zero, so we could use a static
123 -- construtor; but I concluded that it just isn't worth it.
124 -- Now I/O uses unboxed tuples there just aren't any constructors
125 -- with all size-zero args.
127 -- The reason for having a separate argument, rather than looking at
128 -- the addr modes of the args is that we may be in a "knot", and
129 -- premature looking at the args will cause the compiler to black-hole!
132 First we deal with the case of zero-arity constructors. Now, they
133 will probably be unfolded, so we don't expect to see this case much,
134 if at all, but it does no harm, and sets the scene for characters.
136 In the case of zero-arity constructors, or, more accurately, those
137 which have exclusively size-zero (VoidRep) args, we generate no code
141 buildDynCon binder cc con []
142 = returnFC (stableAmodeIdInfo binder
143 (CLbl (mkClosureLabel (idName (dataConWrapId con))) PtrRep)
147 The following three paragraphs about @Char@-like and @Int@-like
148 closures are obsolete, but I don't understand the details well enough
149 to properly word them, sorry. I've changed the treatment of @Char@s to
150 be analogous to @Int@s: only a subset is preallocated, because @Char@
151 has now 31 bits. Only literals are handled here. -- Qrczak
153 Now for @Char@-like closures. We generate an assignment of the
154 address of the closure to a temporary. It would be possible simply to
155 generate no code, and record the addressing mode in the environment,
156 but we'd have to be careful if the argument wasn't a constant --- so
157 for simplicity we just always asssign to a temporary.
159 Last special case: @Int@-like closures. We only special-case the
160 situation in which the argument is a literal in the range
161 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
162 work with any old argument, but for @Int@-like ones the argument has
163 to be a literal. Reason: @Char@ like closures have an argument type
164 which is guaranteed in range.
166 Because of this, we use can safely return an addressing mode.
169 buildDynCon binder cc con [arg_amode]
170 | maybeIntLikeCon con && in_range_int_lit arg_amode
171 = returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con))
173 (temp_amode, temp_id_info) = newTempAmodeAndIdInfo binder (mkConLFInfo con)
175 in_range_int_lit (CLit (MachInt val)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
176 in_range_int_lit _other_amode = False
178 buildDynCon binder cc con [arg_amode]
179 | maybeCharLikeCon con && in_range_char_lit arg_amode
180 = returnFC (stableAmodeIdInfo binder (CCharLike arg_amode) (mkConLFInfo con))
182 (temp_amode, temp_id_info) = newTempAmodeAndIdInfo binder (mkConLFInfo con)
184 in_range_char_lit (CLit (MachChar val)) = val <= mAX_CHARLIKE && val >= mIN_CHARLIKE
185 in_range_char_lit _other_amode = False
188 Now the general case.
191 buildDynCon binder ccs con args
192 = allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off ->
193 returnFC (heapIdInfo binder hp_off lf_info)
195 (closure_info, amodes_w_offsets)
196 = layOutDynClosure (idName binder) getAmodeRep args lf_info
197 lf_info = mkConLFInfo con
199 use_cc -- cost-centre to stick in the object
200 = if currentOrSubsumedCCS ccs
201 then CReg CurCostCentre
202 else mkCCostCentreStack ccs
204 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
208 %************************************************************************
210 %* constructor-related utility function: *
211 %* bindConArgs is called from cgAlt of a case *
213 %************************************************************************
214 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
216 @bindConArgs@ $con args$ augments the environment with bindings for the
217 binders $args$, assuming that we have just returned from a @case@ which
222 :: DataCon -> [Id] -- Constructor and args
226 = ASSERT(not (isUnboxedTupleCon con))
227 mapCs bind_arg args_w_offsets
229 bind_arg (arg, offset) = bindNewToNode arg offset mkLFArgument
230 (_, args_w_offsets) = layOutDynCon con idPrimRep args
233 Unboxed tuples are handled slightly differently - the object is
234 returned in registers and on the stack instead of the heap.
237 bindUnboxedTupleComponents
239 -> FCode ([MagicId], -- regs assigned
240 [(VirtualSpOffset,Int)], -- tag slots
241 Bool) -- any components on stack?
243 bindUnboxedTupleComponents args
244 = -- Assign as many components as possible to registers
245 let (arg_regs, leftovers) = assignRegs [] (map idPrimRep args)
246 (reg_args, stk_args) = splitAt (length arg_regs) args
249 -- Allocate the rest on the stack (ToDo: separate out pointers)
250 getVirtSp `thenFC` \ vsp ->
251 getRealSp `thenFC` \ rsp ->
252 let (top_sp, stk_offsets, tags) =
253 mkTaggedVirtStkOffsets rsp idPrimRep stk_args
256 -- The stack pointer points to the last stack-allocated component
257 setRealAndVirtualSp top_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 stk_offsets `thenC`
264 returnFC (arg_regs,tags, not (null stk_offsets))
267 %************************************************************************
269 \subsubsection[CgRetConv-cgReturnDataCon]{Actually generate code for a constructor return}
271 %************************************************************************
274 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
275 sure the @amodes@ passed don't conflict with each other.
277 cgReturnDataCon :: DataCon -> [CAddrMode] -> Code
279 cgReturnDataCon con amodes
280 = getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_sp sequel) ->
284 CaseAlts _ (Just (alts, Just (maybe_deflt, (_,deflt_lbl))))
285 | not (dataConTag con `is_elem` map fst alts)
287 -- Special case! We're returning a constructor to the default case
288 -- of an enclosing case. For example:
290 -- case (case e of (a,b) -> C a b) of
292 -- y -> ...<returning here!>...
295 -- if the default is a non-bind-default (ie does not use y),
296 -- then we should simply jump to the default join point;
299 Nothing -> performReturn AbsCNop {- No reg assts -} jump_to_join_point
300 Just _ -> build_it_then jump_to_join_point
302 is_elem = isIn "cgReturnDataCon"
303 jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
304 -- Ignore the sequel: we've already looked at it above
306 -- If the sequel is an update frame, we might be able to
307 -- do update in place...
309 | not (isNullaryDataCon con) -- no nullary constructors, please
310 && not (any isFollowableRep (map getAmodeRep amodes))
311 -- no ptrs please (generational gc...)
312 && closureSize closure_info <= mIN_UPD_SIZE
313 -- don't know the real size of the
314 -- thunk, so assume mIN_UPD_SIZE
316 -> -- get a new temporary and make it point to the updatee
319 temp = CTemp uniq PtrRep
322 profCtrC SLIT("TICK_UPD_CON_IN_PLACE")
323 [mkIntCLit (length amodes)] `thenC`
325 getSpRelOffset args_sp `thenFC` \ sp_rel ->
327 (CMacroExpr PtrRep UPD_FRAME_UPDATEE [CAddr sp_rel]))
330 -- stomp all over it with the new constructor
331 inPlaceAllocDynClosure closure_info temp (CReg CurCostCentre) stuff
334 -- don't forget to update Su from the update frame
335 absC (CMacroStmt UPDATE_SU_FROM_UPD_FRAME [CAddr sp_rel]) `thenC`
337 -- set Node to point to the closure being returned
338 -- (can't be done earlier: node might conflict with amodes)
339 absC (CAssign (CReg node) temp) `thenC`
341 -- pop the update frame off the stack, and do the proper
343 let new_sp = args_sp - updateFrameSize in
344 setEndOfBlockInfo (EndOfBlockInfo new_sp (OnStack new_sp)) $
345 performReturn (AbsCNop) (mkStaticAlgReturnCode con)
347 where (closure_info, stuff)
348 = layOutDynClosure (dataConName con)
349 getAmodeRep amodes lf_info
351 lf_info = mkConLFInfo con
353 other_sequel -- The usual case
355 | isUnboxedTupleCon con ->
356 -- Return unboxed tuple in registers
357 let (ret_regs, leftovers) =
358 assignRegs [] (map getAmodeRep amodes)
360 profCtrC SLIT("TICK_RET_UNBOXED_TUP")
361 [mkIntCLit (length amodes)] `thenC`
363 doTailCall amodes ret_regs
364 mkUnboxedTupleReturnCode
365 (length leftovers) {- fast args arity -}
366 AbsCNop {-no pending assigments-}
367 Nothing {-not a let-no-escape-}
368 False {-node doesn't point-}
371 build_it_then (mkStaticAlgReturnCode con)
374 move_to_reg :: CAddrMode -> MagicId -> AbstractC
375 move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode
377 build_it_then return =
378 -- BUILD THE OBJECT IN THE HEAP
379 -- The first "con" says that the name bound to this
380 -- closure is "con", which is a bit of a fudge, but it only
383 -- This Id is also used to get a unique for a
384 -- temporary variable, if the closure is a CHARLIKE.
385 -- funnily enough, this makes the unique always come
387 buildDynCon (dataConId con) currentCCS con amodes `thenFC` \ idinfo ->
388 idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
392 profCtrC SLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
393 -- could use doTailCall here.
394 performReturn (move_to_reg amode node) return