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
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 )
52 import Literal ( Literal(..) )
53 import PrelInfo ( maybeCharLikeCon, maybeIntLikeCon )
54 import PrimRep ( PrimRep(..), isFollowableRep )
55 import Unique ( Uniquable(..) )
60 %************************************************************************
62 \subsection[toplevel-constructors]{Top-level constructors}
64 %************************************************************************
67 cgTopRhsCon :: Id -- Name of thing bound to this RHS
70 -> FCode (Id, CgIdInfo)
71 cgTopRhsCon id con args
72 = ASSERT( not (isDllConApp con args) ) -- checks for litlit args too
73 ASSERT( args `lengthIs` dataConRepArity con )
76 getArgAmodes args `thenFC` \ amodes ->
80 closure_label = mkClosureLabel name
81 lf_info = closureLFInfo closure_info
82 (closure_info, amodes_w_offsets) = layOutStaticConstr name con getAmodeRep amodes
87 closure_label -- Labelled with the name on lhs of defn
88 closure_info -- Closure is static
89 (mkCCostCentreStack dontCareCCS) -- because it's static data
90 (map fst amodes_w_offsets)) -- Sorted into ptrs first, then nonptrs
95 returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info)
98 %************************************************************************
100 %* non-top-level constructors *
102 %************************************************************************
103 \subsection[code-for-constructors]{The code for constructors}
106 buildDynCon :: Id -- Name of the thing to which this constr will
108 -> CostCentreStack -- Where to grab cost centre from;
109 -- current CCS if currentOrSubsumedCCS
110 -> DataCon -- The data constructor
111 -> [CAddrMode] -- Its args
112 -> FCode CgIdInfo -- Return details about how to find it
114 -- We used to pass a boolean indicating whether all the
115 -- args were of size zero, so we could use a static
116 -- construtor; but I concluded that it just isn't worth it.
117 -- Now I/O uses unboxed tuples there just aren't any constructors
118 -- with all size-zero args.
120 -- The reason for having a separate argument, rather than looking at
121 -- the addr modes of the args is that we may be in a "knot", and
122 -- premature looking at the args will cause the compiler to black-hole!
125 First we deal with the case of zero-arity constructors. Now, they
126 will probably be unfolded, so we don't expect to see this case much,
127 if at all, but it does no harm, and sets the scene for characters.
129 In the case of zero-arity constructors, or, more accurately, those
130 which have exclusively size-zero (VoidRep) args, we generate no code
134 buildDynCon binder cc con []
135 = returnFC (stableAmodeIdInfo binder
136 (CLbl (mkClosureLabel (idName (dataConWrapId con))) PtrRep)
140 The following three paragraphs about @Char@-like and @Int@-like
141 closures are obsolete, but I don't understand the details well enough
142 to properly word them, sorry. I've changed the treatment of @Char@s to
143 be analogous to @Int@s: only a subset is preallocated, because @Char@
144 has now 31 bits. Only literals are handled here. -- Qrczak
146 Now for @Char@-like closures. We generate an assignment of the
147 address of the closure to a temporary. It would be possible simply to
148 generate no code, and record the addressing mode in the environment,
149 but we'd have to be careful if the argument wasn't a constant --- so
150 for simplicity we just always asssign to a temporary.
152 Last special case: @Int@-like closures. We only special-case the
153 situation in which the argument is a literal in the range
154 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
155 work with any old argument, but for @Int@-like ones the argument has
156 to be a literal. Reason: @Char@ like closures have an argument type
157 which is guaranteed in range.
159 Because of this, we use can safely return an addressing mode.
162 buildDynCon binder cc con [arg_amode]
163 | maybeIntLikeCon con && in_range_int_lit arg_amode
164 = returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con))
166 in_range_int_lit (CLit (MachInt val)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
167 in_range_int_lit _other_amode = False
169 buildDynCon binder cc con [arg_amode]
170 | maybeCharLikeCon con && in_range_char_lit arg_amode
171 = returnFC (stableAmodeIdInfo binder (CCharLike arg_amode) (mkConLFInfo con))
173 in_range_char_lit (CLit (MachChar val)) = val <= mAX_CHARLIKE && val >= mIN_CHARLIKE
174 in_range_char_lit _other_amode = False
177 Now the general case.
180 buildDynCon binder ccs con args
181 = allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off ->
182 returnFC (heapIdInfo binder hp_off lf_info)
184 (closure_info, amodes_w_offsets)
185 = layOutDynClosure (idName binder) getAmodeRep args lf_info NoC_SRT
186 lf_info = mkConLFInfo con
188 use_cc -- cost-centre to stick in the object
189 = if currentOrSubsumedCCS ccs
190 then CReg CurCostCentre
191 else mkCCostCentreStack ccs
193 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
197 %************************************************************************
199 %* constructor-related utility function: *
200 %* bindConArgs is called from cgAlt of a case *
202 %************************************************************************
203 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
205 @bindConArgs@ $con args$ augments the environment with bindings for the
206 binders $args$, assuming that we have just returned from a @case@ which
211 :: DataCon -> [Id] -- Constructor and args
215 = ASSERT(not (isUnboxedTupleCon con))
216 mapCs bind_arg args_w_offsets
218 bind_arg (arg, offset) = bindNewToNode arg offset mkLFArgument
219 (_, args_w_offsets) = layOutDynConstr bogus_name con idPrimRep args
221 bogus_name = panic "bindConArgs"
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 [(VirtualSpOffset,Int)], -- tag slots
232 Bool) -- any components on stack?
234 bindUnboxedTupleComponents args
235 = -- Assign as many components as possible to registers
236 let (arg_regs, _leftovers) = assignRegs [] (map idPrimRep args)
237 (reg_args, stk_args) = splitAtList arg_regs args
240 -- Allocate the rest on the stack (ToDo: separate out pointers)
241 getVirtSp `thenFC` \ vsp ->
242 getRealSp `thenFC` \ rsp ->
243 let (top_sp, stk_offsets, tags) =
244 mkTaggedVirtStkOffsets rsp idPrimRep stk_args
247 -- The stack pointer points to the last stack-allocated component
248 setRealAndVirtualSp top_sp `thenC`
250 -- need to explicitly free any empty slots we just jumped over
251 (if vsp < rsp then freeStackSlots [vsp+1 .. rsp] else nopC) `thenC`
253 bindArgsToRegs reg_args arg_regs `thenC`
254 mapCs bindNewToStack stk_offsets `thenC`
255 returnFC (arg_regs,tags, not (null stk_offsets))
258 %************************************************************************
260 \subsubsection[CgRetConv-cgReturnDataCon]{Actually generate code for a constructor return}
262 %************************************************************************
265 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
266 sure the @amodes@ passed don't conflict with each other.
268 cgReturnDataCon :: DataCon -> [CAddrMode] -> Code
270 cgReturnDataCon con amodes
271 = ASSERT( amodes `lengthIs` dataConRepArity con )
272 getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_sp sequel) ->
276 CaseAlts _ (Just (alts, Just (maybe_deflt, (_,deflt_lbl))))
277 | not (dataConTag con `is_elem` map fst alts)
279 -- Special case! We're returning a constructor to the default case
280 -- of an enclosing case. For example:
282 -- case (case e of (a,b) -> C a b) of
284 -- y -> ...<returning here!>...
287 -- if the default is a non-bind-default (ie does not use y),
288 -- then we should simply jump to the default join point;
291 Nothing -> performReturn AbsCNop {- No reg assts -} jump_to_join_point
292 Just _ -> build_it_then jump_to_join_point
294 is_elem = isIn "cgReturnDataCon"
295 jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
296 -- Ignore the sequel: we've already looked at it above
298 -- If the sequel is an update frame, we might be able to
299 -- do update in place...
301 | not (isNullaryDataCon con) -- no nullary constructors, please
302 && not (any isFollowableRep (map getAmodeRep amodes))
303 -- no ptrs please (generational gc...)
304 && closureSize closure_info <= mIN_UPD_SIZE
305 -- don't know the real size of the
306 -- thunk, so assume mIN_UPD_SIZE
308 -> -- get a new temporary and make it point to the updatee
311 temp = CTemp uniq PtrRep
314 profCtrC SLIT("TICK_UPD_CON_IN_PLACE")
315 [mkIntCLit (length amodes)] `thenC`
317 getSpRelOffset args_sp `thenFC` \ sp_rel ->
319 (CMacroExpr PtrRep UPD_FRAME_UPDATEE [CAddr sp_rel]))
322 -- stomp all over it with the new constructor
323 inPlaceAllocDynClosure closure_info temp (CReg CurCostCentre) stuff
326 -- don't forget to update Su from the update frame
327 absC (CMacroStmt UPDATE_SU_FROM_UPD_FRAME [CAddr sp_rel]) `thenC`
329 -- set Node to point to the closure being returned
330 -- (can't be done earlier: node might conflict with amodes)
331 absC (CAssign (CReg node) temp) `thenC`
333 -- pop the update frame off the stack, and do the proper
335 let new_sp = args_sp - updateFrameSize in
336 setEndOfBlockInfo (EndOfBlockInfo new_sp (OnStack new_sp)) $
337 performReturn (AbsCNop) (mkStaticAlgReturnCode con)
340 (closure_info, stuff)
341 = layOutDynConstr (dataConName con) con getAmodeRep amodes
343 other_sequel -- The usual case
345 | isUnboxedTupleCon con ->
346 -- Return unboxed tuple in registers
347 let (ret_regs, leftovers) =
348 assignRegs [] (map getAmodeRep amodes)
350 profCtrC SLIT("TICK_RET_UNBOXED_TUP")
351 [mkIntCLit (length amodes)] `thenC`
353 doTailCall amodes ret_regs
354 mkUnboxedTupleReturnCode
355 (length leftovers) {- fast args arity -}
356 AbsCNop {-no pending assigments-}
357 Nothing {-not a let-no-escape-}
358 False {-node doesn't point-}
361 build_it_then (mkStaticAlgReturnCode con)
364 move_to_reg :: CAddrMode -> MagicId -> AbstractC
365 move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode
367 build_it_then return =
368 -- BUILD THE OBJECT IN THE HEAP
369 -- The first "con" says that the name bound to this
370 -- closure is "con", which is a bit of a fudge, but it only
373 -- This Id is also used to get a unique for a
374 -- temporary variable, if the closure is a CHARLIKE.
375 -- funnily enough, this makes the unique always come
377 buildDynCon (dataConId con) currentCCS con amodes `thenFC` \ idinfo ->
378 idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
382 profCtrC SLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
383 -- could use doTailCall here.
384 performReturn (move_to_reg amode node) return