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 )
30 import CgUsages ( getRealSp, getVirtSp, setRealAndVirtualSp )
31 import CgClosure ( cgTopRhsClosure )
32 import CgRetConv ( assignRegs )
33 import Constants ( mAX_INTLIKE, mIN_INTLIKE )
34 import CgHeapery ( allocDynClosure )
35 import CgTailCall ( performReturn, mkStaticAlgReturnCode, doTailCall,
36 mkUnboxedTupleReturnCode )
37 import CLabel ( mkClosureLabel, mkStaticClosureLabel )
38 import ClosureInfo ( mkClosureLFInfo, mkConLFInfo, mkLFArgument,
39 layOutDynCon, layOutDynClosure,
42 import CostCentre ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
44 import DataCon ( DataCon, dataConName, dataConTag, dataConTyCon,
46 import MkId ( mkDataConId )
47 import Id ( Id, idName, idType, idPrimRep )
48 import Const ( Con(..), Literal(..) )
49 import PrelInfo ( maybeCharLikeCon, maybeIntLikeCon )
50 import PrimRep ( PrimRep(..) )
51 import BasicTypes ( TopLevelFlag(..) )
53 import Panic ( assertPanic )
56 %************************************************************************
58 \subsection[toplevel-constructors]{Top-level constructors}
60 %************************************************************************
63 cgTopRhsCon :: Id -- Name of thing bound to this RHS
66 -> Bool -- All zero-size args (see buildDynCon)
67 -> FCode (Id, CgIdInfo)
70 Special Case: Constructors some of whose arguments are of \tr{Double#}
71 type, {\em or} which are ``lit lits'' (which are given \tr{Addr#}
74 These ones have to be compiled as re-entrant thunks rather than
75 closures, because we can't figure out a way to persuade C to allow us
76 to initialise a static closure with Doubles! Thus, for \tr{x = 2.0}
77 (defaults to Double), we get:
81 Main.x = MkDouble [2.0##]
86 SET_STATIC_HDR(Main_x_closure,Main_x_static,CC_DATA,,EXTDATA_RO)
88 -- its *own* info table:
89 STATIC_INFO_TABLE(Main_x,Main_x_entry,,,,EXTFUN,???,":MkDouble","Double");
90 -- with its *own* entry code:
91 STGFUN(Main_x_entry) {
100 The above has the down side that each floating-point constant will end
101 up with its own info table (rather than sharing the MkFloat/MkDouble
102 ones). On the plus side, however, it does return a value (\tr{2.0})
105 Here, then is the implementation: just pretend it's a non-updatable
106 thunk. That is, instead of
112 x = [] \n [] -> D# 3.455#
115 top_ccc = mkCCostCentreStack dontCareCCS -- because it's static data
117 cgTopRhsCon bndr con args all_zero_size_args
118 | any isLitLitArg args
119 = cgTopRhsClosure bndr dontCareCCS NoStgBinderInfo NoSRT [] body lf_info
121 body = StgCon (DataCon con) args rhs_ty
122 lf_info = mkClosureLFInfo bndr TopLevel [] ReEntrant []
126 OK, so now we have the general case.
129 cgTopRhsCon id con args all_zero_size_args
132 getArgAmodes args `thenFC` \ amodes ->
135 (closure_info, amodes_w_offsets)
136 = layOutStaticClosure name getAmodeRep amodes lf_info
141 closure_label -- Labelled with the name on lhs of defn
142 closure_info -- Closure is static
144 (map fst amodes_w_offsets)) -- Sorted into ptrs first, then nonptrs
149 returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info)
151 con_tycon = dataConTyCon con
152 lf_info = mkConLFInfo con
153 closure_label = mkClosureLabel name
157 %************************************************************************
159 %* non-top-level constructors *
161 %************************************************************************
162 \subsection[code-for-constructors]{The code for constructors}
165 buildDynCon :: Id -- Name of the thing to which this constr will
167 -> CostCentreStack -- Where to grab cost centre from;
168 -- current CCS if currentOrSubsumedCCS
169 -> DataCon -- The data constructor
170 -> [CAddrMode] -- Its args
171 -> Bool -- True <=> all args (if any) are
172 -- of "zero size" (i.e., VoidRep);
173 -- The reason we don't just look at the
174 -- args is that we may be in a "knot", and
175 -- premature looking at the args will cause
176 -- the compiler to black-hole!
177 -> FCode CgIdInfo -- Return details about how to find it
180 First we deal with the case of zero-arity constructors. Now, they
181 will probably be unfolded, so we don't expect to see this case much,
182 if at all, but it does no harm, and sets the scene for characters.
184 In the case of zero-arity constructors, or, more accurately, those
185 which have exclusively size-zero (VoidRep) args, we generate no code
189 buildDynCon binder cc con args all_zero_size_args@True
190 = returnFC (stableAmodeIdInfo binder
191 (CLbl (mkStaticClosureLabel (dataConName con)) PtrRep)
195 Now for @Char@-like closures. We generate an assignment of the
196 address of the closure to a temporary. It would be possible simply to
197 generate no code, and record the addressing mode in the environment,
198 but we'd have to be careful if the argument wasn't a constant --- so
199 for simplicity we just always asssign to a temporary.
201 Last special case: @Int@-like closures. We only special-case the
202 situation in which the argument is a literal in the range
203 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
204 work with any old argument, but for @Int@-like ones the argument has
205 to be a literal. Reason: @Char@ like closures have an argument type
206 which is guaranteed in range.
208 Because of this, we use can safely return an addressing mode.
211 buildDynCon binder cc con [arg_amode] all_zero_size_args@False
213 | maybeCharLikeCon con
214 = absC (CAssign temp_amode (CCharLike arg_amode)) `thenC`
215 returnFC temp_id_info
217 | maybeIntLikeCon con && in_range_int_lit arg_amode
218 = returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con))
220 (temp_amode, temp_id_info) = newTempAmodeAndIdInfo binder (mkConLFInfo con)
222 in_range_int_lit (CLit (MachInt val _)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
223 in_range_int_lit other_amode = False
225 tycon = dataConTyCon con
228 Now the general case.
231 buildDynCon binder ccs con args all_zero_size_args@False
232 = allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off ->
233 returnFC (heapIdInfo binder hp_off lf_info)
235 (closure_info, amodes_w_offsets)
236 = layOutDynClosure (idName binder) getAmodeRep args lf_info
237 lf_info = mkConLFInfo con
239 use_cc -- cost-centre to stick in the object
240 = if currentOrSubsumedCCS ccs
241 then CReg CurCostCentre
242 else mkCCostCentreStack ccs
244 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
248 %************************************************************************
250 %* constructor-related utility function: *
251 %* bindConArgs is called from cgAlt of a case *
253 %************************************************************************
254 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
256 @bindConArgs@ $con args$ augments the environment with bindings for the
257 binders $args$, assuming that we have just returned from a @case@ which
262 :: DataCon -> [Id] -- Constructor and args
266 = ASSERT(not (isUnboxedTupleCon con))
267 mapCs bind_arg args_w_offsets
269 bind_arg (arg, offset) = bindNewToNode arg offset mkLFArgument
270 (_, args_w_offsets) = layOutDynCon con idPrimRep args
273 Unboxed tuples are handled slightly differently - the object is
274 returned in registers and on the stack instead of the heap.
277 bindUnboxedTupleComponents
279 -> FCode ([MagicId], -- regs assigned
280 [(VirtualSpOffset,Int)], -- tag slots
281 Bool) -- any components on stack?
283 bindUnboxedTupleComponents args
284 = -- Assign as many components as possible to registers
285 let (arg_regs, leftovers) = assignRegs [] (map idPrimRep args)
286 (reg_args, stk_args) = splitAt (length arg_regs) args
289 -- Allocate the rest on the stack (ToDo: separate out pointers)
290 getVirtSp `thenFC` \ vsp ->
291 getRealSp `thenFC` \ rsp ->
292 let (top_sp, stk_offsets, tags) =
293 mkTaggedVirtStkOffsets rsp idPrimRep stk_args
296 -- The stack pointer points to the last stack-allocated component
297 setRealAndVirtualSp top_sp `thenC`
299 -- need to explicitly free any empty slots we just jumped over
300 (if vsp < rsp then freeStackSlots [vsp+1 .. rsp] else nopC) `thenC`
302 bindArgsToRegs reg_args arg_regs `thenC`
303 mapCs bindNewToStack stk_offsets `thenC`
304 returnFC (arg_regs,tags, not (null stk_offsets))
307 %************************************************************************
309 \subsubsection[CgRetConv-cgReturnDataCon]{Actually generate code for a constructor return}
311 %************************************************************************
314 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
315 sure the @amodes@ passed don't conflict with each other.
317 cgReturnDataCon :: DataCon -> [CAddrMode] -> Bool -> Code
319 cgReturnDataCon con amodes all_zero_size_args
320 = getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_sp sequel) ->
324 CaseAlts _ (Just (alts, Just (maybe_deflt_binder, (_,deflt_lbl))))
325 | not (dataConTag con `is_elem` map fst alts)
327 -- Special case! We're returning a constructor to the default case
328 -- of an enclosing case. For example:
330 -- case (case e of (a,b) -> C a b) of
332 -- y -> ...<returning here!>...
335 -- if the default is a non-bind-default (ie does not use y),
336 -- then we should simply jump to the default join point;
338 -- if the default is a bind-default (ie does use y), we
339 -- should return the constructor in the heap,
340 -- pointed to by Node.
342 case maybe_deflt_binder of
344 ASSERT(not (isUnboxedTupleCon con))
345 buildDynCon binder currentCCS con amodes all_zero_size_args
347 profCtrC SLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
348 idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
349 performReturn (move_to_reg amode node) jump_to_join_point
352 performReturn AbsCNop {- No reg assts -} jump_to_join_point
354 is_elem = isIn "cgReturnDataCon"
355 jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
356 -- Ignore the sequel: we've already looked at it above
358 other_sequel -- The usual case
360 | isUnboxedTupleCon con ->
361 -- Return unboxed tuple in registers
362 let (ret_regs, leftovers) =
363 assignRegs [] (map getAmodeRep amodes)
365 profCtrC SLIT("TICK_RET_UNBOXED_TUP")
366 [mkIntCLit (length amodes)] `thenC`
368 doTailCall amodes ret_regs
369 mkUnboxedTupleReturnCode
370 (length leftovers) {- fast args arity -}
371 AbsCNop {-no pending assigments-}
372 Nothing {-not a let-no-escape-}
373 False {-node doesn't point-}
376 -- BUILD THE OBJECT IN THE HEAP
377 -- The first "con" says that the name bound to this
378 -- closure is "con", which is a bit of a fudge, but it only
381 -- This Id is also used to get a unique for a
382 -- temporary variable, if the closure is a CHARLIKE.
383 -- funilly enough, this makes the unique always come
385 buildDynCon (mkDataConId con) currentCCS
386 con amodes all_zero_size_args
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)
395 (mkStaticAlgReturnCode con)
398 con_name = dataConName con
400 move_to_reg :: CAddrMode -> MagicId -> AbstractC
401 move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode