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, mIN_UPD_SIZE )
37 import CgHeapery ( allocDynClosure, inPlaceAllocDynClosure )
38 import CgTailCall ( performReturn, mkStaticAlgReturnCode, doTailCall,
39 mkUnboxedTupleReturnCode )
40 import CLabel ( mkClosureLabel )
41 import ClosureInfo ( mkClosureLFInfo, mkConLFInfo, mkLFArgument,
42 layOutDynCon, layOutDynClosure,
43 layOutStaticClosure, closureSize
45 import CostCentre ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
47 import DataCon ( DataCon, dataConName, dataConTag, dataConTyCon,
48 isUnboxedTupleCon, isNullaryDataCon, isDynDataCon, dataConId, dataConWrapId
50 import Id ( Id, idName, idType, idPrimRep )
51 import Name ( nameModule, isLocallyDefinedName )
52 import Module ( isDynamicModule )
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 con_tycon = dataConTyCon con
96 lf_info = mkConLFInfo con
97 closure_label = mkClosureLabel name
100 top_ccc = mkCCostCentreStack dontCareCCS -- because it's static data
102 -- stuff needed by the assert pred only.
103 dynamic_con_or_args = isDynDataCon con || any isDynArg args
106 %************************************************************************
108 %* non-top-level constructors *
110 %************************************************************************
111 \subsection[code-for-constructors]{The code for constructors}
114 buildDynCon :: Id -- Name of the thing to which this constr will
116 -> CostCentreStack -- Where to grab cost centre from;
117 -- current CCS if currentOrSubsumedCCS
118 -> DataCon -- The data constructor
119 -> [CAddrMode] -- Its args
120 -> FCode CgIdInfo -- Return details about how to find it
122 -- We used to pass a boolean indicating whether all the
123 -- args were of size zero, so we could use a static
124 -- construtor; but I concluded that it just isn't worth it.
125 -- Now I/O uses unboxed tuples there just aren't any constructors
126 -- with all size-zero args.
128 -- The reason for having a separate argument, rather than looking at
129 -- the addr modes of the args is that we may be in a "knot", and
130 -- premature looking at the args will cause the compiler to black-hole!
133 First we deal with the case of zero-arity constructors. Now, they
134 will probably be unfolded, so we don't expect to see this case much,
135 if at all, but it does no harm, and sets the scene for characters.
137 In the case of zero-arity constructors, or, more accurately, those
138 which have exclusively size-zero (VoidRep) args, we generate no code
142 buildDynCon binder cc con []
143 = returnFC (stableAmodeIdInfo binder
144 (CLbl (mkClosureLabel (idName (dataConWrapId con))) PtrRep)
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]
166 | maybeCharLikeCon con
167 = absC (CAssign temp_amode (CCharLike arg_amode)) `thenC`
168 returnFC temp_id_info
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 tycon = dataConTyCon con
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 (closure_info, amodes_w_offsets)
189 = layOutDynClosure (idName binder) getAmodeRep args lf_info
190 lf_info = mkConLFInfo con
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
223 (_, args_w_offsets) = layOutDynCon 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 [(VirtualSpOffset,Int)], -- tag slots
234 Bool) -- any components on stack?
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) = splitAt (length arg_regs) args
242 -- Allocate the rest on the stack (ToDo: separate out pointers)
243 getVirtSp `thenFC` \ vsp ->
244 getRealSp `thenFC` \ rsp ->
245 let (top_sp, stk_offsets, tags) =
246 mkTaggedVirtStkOffsets rsp idPrimRep stk_args
249 -- The stack pointer points to the last stack-allocated component
250 setRealAndVirtualSp top_sp `thenC`
252 -- need to explicitly free any empty slots we just jumped over
253 (if vsp < rsp then freeStackSlots [vsp+1 .. rsp] else nopC) `thenC`
255 bindArgsToRegs reg_args arg_regs `thenC`
256 mapCs bindNewToStack stk_offsets `thenC`
257 returnFC (arg_regs,tags, not (null stk_offsets))
260 %************************************************************************
262 \subsubsection[CgRetConv-cgReturnDataCon]{Actually generate code for a constructor return}
264 %************************************************************************
267 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
268 sure the @amodes@ passed don't conflict with each other.
270 cgReturnDataCon :: DataCon -> [CAddrMode] -> Code
272 cgReturnDataCon con amodes
273 = getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_sp sequel) ->
277 CaseAlts _ (Just (alts, Just (maybe_deflt, (_,deflt_lbl))))
278 | not (dataConTag con `is_elem` map fst alts)
280 -- Special case! We're returning a constructor to the default case
281 -- of an enclosing case. For example:
283 -- case (case e of (a,b) -> C a b) of
285 -- y -> ...<returning here!>...
288 -- if the default is a non-bind-default (ie does not use y),
289 -- then we should simply jump to the default join point;
292 Nothing -> performReturn AbsCNop {- No reg assts -} jump_to_join_point
293 Just _ -> build_it_then jump_to_join_point
295 is_elem = isIn "cgReturnDataCon"
296 jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
297 -- Ignore the sequel: we've already looked at it above
299 -- If the sequel is an update frame, we might be able to
300 -- do update in place...
302 | not (isNullaryDataCon con) -- no nullary constructors, please
303 && not (maybeCharLikeCon con) -- no chars please (these are all static)
304 && not (any isFollowableRep (map getAmodeRep amodes))
305 -- no ptrs please (generational gc...)
306 && closureSize closure_info <= mIN_UPD_SIZE
307 -- don't know the real size of the
308 -- thunk, so assume mIN_UPD_SIZE
310 -> -- get a new temporary and make it point to the updatee
313 temp = CTemp uniq PtrRep
316 profCtrC SLIT("TICK_UPD_CON_IN_PLACE")
317 [mkIntCLit (length amodes)] `thenC`
319 getSpRelOffset args_sp `thenFC` \ sp_rel ->
321 (CMacroExpr PtrRep UPD_FRAME_UPDATEE [CAddr sp_rel]))
324 -- stomp all over it with the new constructor
325 inPlaceAllocDynClosure closure_info temp (CReg CurCostCentre) stuff
328 -- don't forget to update Su from the update frame
329 absC (CMacroStmt UPDATE_SU_FROM_UPD_FRAME [CAddr sp_rel]) `thenC`
331 -- set Node to point to the closure being returned
332 -- (can't be done earlier: node might conflict with amodes)
333 absC (CAssign (CReg node) temp) `thenC`
335 -- pop the update frame off the stack, and do the proper
337 let new_sp = args_sp - updateFrameSize in
338 setEndOfBlockInfo (EndOfBlockInfo new_sp (OnStack new_sp)) $
339 performReturn (AbsCNop) (mkStaticAlgReturnCode con)
341 where (closure_info, stuff)
342 = layOutDynClosure (dataConName con)
343 getAmodeRep amodes lf_info
345 lf_info = mkConLFInfo con
347 other_sequel -- The usual case
349 | isUnboxedTupleCon con ->
350 -- Return unboxed tuple in registers
351 let (ret_regs, leftovers) =
352 assignRegs [] (map getAmodeRep amodes)
354 profCtrC SLIT("TICK_RET_UNBOXED_TUP")
355 [mkIntCLit (length amodes)] `thenC`
357 doTailCall amodes ret_regs
358 mkUnboxedTupleReturnCode
359 (length leftovers) {- fast args arity -}
360 AbsCNop {-no pending assigments-}
361 Nothing {-not a let-no-escape-}
362 False {-node doesn't point-}
365 build_it_then (mkStaticAlgReturnCode con)
368 con_name = dataConName 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