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(..) )
55 %************************************************************************
57 \subsection[toplevel-constructors]{Top-level constructors}
59 %************************************************************************
62 cgTopRhsCon :: Id -- Name of thing bound to this RHS
65 -> Bool -- All zero-size args (see buildDynCon)
66 -> FCode (Id, CgIdInfo)
69 Special Case: Constructors some of whose arguments are of \tr{Double#}
70 type, {\em or} which are ``lit lits'' (which are given \tr{Addr#}
73 These ones have to be compiled as re-entrant thunks rather than
74 closures, because we can't figure out a way to persuade C to allow us
75 to initialise a static closure with Doubles! Thus, for \tr{x = 2.0}
76 (defaults to Double), we get:
80 Main.x = MkDouble [2.0##]
85 SET_STATIC_HDR(Main_x_closure,Main_x_static,CC_DATA,,EXTDATA_RO)
87 -- its *own* info table:
88 STATIC_INFO_TABLE(Main_x,Main_x_entry,,,,EXTFUN,???,":MkDouble","Double");
89 -- with its *own* entry code:
90 STGFUN(Main_x_entry) {
99 The above has the down side that each floating-point constant will end
100 up with its own info table (rather than sharing the MkFloat/MkDouble
101 ones). On the plus side, however, it does return a value (\tr{2.0})
104 Here, then is the implementation: just pretend it's a non-updatable
105 thunk. That is, instead of
111 x = [] \n [] -> D# 3.455#
114 top_ccc = mkCCostCentreStack dontCareCCS -- because it's static data
116 cgTopRhsCon bndr con args all_zero_size_args
117 | any isLitLitArg args
118 = cgTopRhsClosure bndr dontCareCCS NoStgBinderInfo NoSRT [] body lf_info
120 body = StgCon (DataCon con) args rhs_ty
121 lf_info = mkClosureLFInfo bndr TopLevel [] ReEntrant []
125 OK, so now we have the general case.
128 cgTopRhsCon id con args all_zero_size_args
131 getArgAmodes args `thenFC` \ amodes ->
134 (closure_info, amodes_w_offsets)
135 = layOutStaticClosure name getAmodeRep amodes lf_info
140 closure_label -- Labelled with the name on lhs of defn
141 closure_info -- Closure is static
143 (map fst amodes_w_offsets)) -- Sorted into ptrs first, then nonptrs
148 returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info)
150 con_tycon = dataConTyCon con
151 lf_info = mkConLFInfo con
152 closure_label = mkClosureLabel name
156 %************************************************************************
158 %* non-top-level constructors *
160 %************************************************************************
161 \subsection[code-for-constructors]{The code for constructors}
164 buildDynCon :: Id -- Name of the thing to which this constr will
166 -> CostCentreStack -- Where to grab cost centre from;
167 -- current CCS if currentOrSubsumedCCS
168 -> DataCon -- The data constructor
169 -> [CAddrMode] -- Its args
170 -> Bool -- True <=> all args (if any) are
171 -- of "zero size" (i.e., VoidRep);
172 -- The reason we don't just look at the
173 -- args is that we may be in a "knot", and
174 -- premature looking at the args will cause
175 -- the compiler to black-hole!
176 -> FCode CgIdInfo -- Return details about how to find it
179 First we deal with the case of zero-arity constructors. Now, they
180 will probably be unfolded, so we don't expect to see this case much,
181 if at all, but it does no harm, and sets the scene for characters.
183 In the case of zero-arity constructors, or, more accurately, those
184 which have exclusively size-zero (VoidRep) args, we generate no code
188 buildDynCon binder cc con args all_zero_size_args@True
189 = returnFC (stableAmodeIdInfo binder
190 (CLbl (mkStaticClosureLabel (dataConName con)) PtrRep)
194 Now for @Char@-like closures. We generate an assignment of the
195 address of the closure to a temporary. It would be possible simply to
196 generate no code, and record the addressing mode in the environment,
197 but we'd have to be careful if the argument wasn't a constant --- so
198 for simplicity we just always asssign to a temporary.
200 Last special case: @Int@-like closures. We only special-case the
201 situation in which the argument is a literal in the range
202 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
203 work with any old argument, but for @Int@-like ones the argument has
204 to be a literal. Reason: @Char@ like closures have an argument type
205 which is guaranteed in range.
207 Because of this, we use can safely return an addressing mode.
210 buildDynCon binder cc con [arg_amode] all_zero_size_args@False
212 | maybeCharLikeCon con
213 = absC (CAssign temp_amode (CCharLike arg_amode)) `thenC`
214 returnFC temp_id_info
216 | maybeIntLikeCon con && in_range_int_lit arg_amode
217 = returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con))
219 (temp_amode, temp_id_info) = newTempAmodeAndIdInfo binder (mkConLFInfo con)
221 in_range_int_lit (CLit (MachInt val _)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
222 in_range_int_lit other_amode = False
224 tycon = dataConTyCon con
227 Now the general case.
230 buildDynCon binder ccs con args all_zero_size_args@False
231 = allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off ->
232 returnFC (heapIdInfo binder hp_off lf_info)
234 (closure_info, amodes_w_offsets)
235 = layOutDynClosure (idName binder) getAmodeRep args lf_info
236 lf_info = mkConLFInfo con
238 use_cc -- cost-centre to stick in the object
239 = if currentOrSubsumedCCS ccs
240 then CReg CurCostCentre
241 else mkCCostCentreStack ccs
243 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
247 %************************************************************************
249 %* constructor-related utility function: *
250 %* bindConArgs is called from cgAlt of a case *
252 %************************************************************************
253 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
255 @bindConArgs@ $con args$ augments the environment with bindings for the
256 binders $args$, assuming that we have just returned from a @case@ which
261 :: DataCon -> [Id] -- Constructor and args
265 = ASSERT(not (isUnboxedTupleCon con))
266 mapCs bind_arg args_w_offsets
268 bind_arg (arg, offset) = bindNewToNode arg offset mkLFArgument
269 (_, args_w_offsets) = layOutDynCon con idPrimRep args
272 Unboxed tuples are handled slightly differently - the object is
273 returned in registers and on the stack instead of the heap.
276 bindUnboxedTupleComponents
278 -> FCode ([MagicId], -- regs assigned
279 [(VirtualSpOffset,Int)], -- tag slots
280 Bool) -- any components on stack?
282 bindUnboxedTupleComponents args
283 = -- Assign as many components as possible to registers
284 let (arg_regs, leftovers) = assignRegs [] (map idPrimRep args)
285 (reg_args, stk_args) = splitAt (length arg_regs) args
288 -- Allocate the rest on the stack (ToDo: separate out pointers)
289 getVirtSp `thenFC` \ vsp ->
290 getRealSp `thenFC` \ rsp ->
291 let (top_sp, stk_offsets, tags) =
292 mkTaggedVirtStkOffsets rsp idPrimRep stk_args
295 -- The stack pointer points to the last stack-allocated component
296 setRealAndVirtualSp top_sp `thenC`
298 -- need to explicitly free any empty slots we just jumped over
299 (if vsp < rsp then freeStackSlots [vsp+1 .. rsp] else nopC) `thenC`
301 bindArgsToRegs reg_args arg_regs `thenC`
302 mapCs bindNewToStack stk_offsets `thenC`
303 returnFC (arg_regs,tags, not (null stk_offsets))
306 %************************************************************************
308 \subsubsection[CgRetConv-cgReturnDataCon]{Actually generate code for a constructor return}
310 %************************************************************************
313 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
314 sure the @amodes@ passed don't conflict with each other.
316 cgReturnDataCon :: DataCon -> [CAddrMode] -> Bool -> Code
318 cgReturnDataCon con amodes all_zero_size_args
319 = getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_sp sequel) ->
323 CaseAlts _ (Just (alts, Just (maybe_deflt_binder, (_,deflt_lbl))))
324 | not (dataConTag con `is_elem` map fst alts)
326 -- Special case! We're returning a constructor to the default case
327 -- of an enclosing case. For example:
329 -- case (case e of (a,b) -> C a b) of
331 -- y -> ...<returning here!>...
334 -- if the default is a non-bind-default (ie does not use y),
335 -- then we should simply jump to the default join point;
337 -- if the default is a bind-default (ie does use y), we
338 -- should return the constructor in the heap,
339 -- pointed to by Node.
341 case maybe_deflt_binder of
343 ASSERT(not (isUnboxedTupleCon con))
344 buildDynCon binder currentCCS con amodes all_zero_size_args
346 idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
347 performReturn (move_to_reg amode node) jump_to_join_point
350 performReturn AbsCNop {- No reg assts -} jump_to_join_point
352 is_elem = isIn "cgReturnDataCon"
353 jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
354 -- Ignore the sequel: we've already looked at it above
356 other_sequel -- The usual case
358 | isUnboxedTupleCon con ->
359 -- Return unboxed tuple in registers
360 let (ret_regs, leftovers) =
361 assignRegs [] (map getAmodeRep amodes)
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 THE OBJECT IN THE HEAP
372 -- The first "con" says that the name bound to this
373 -- closure is "con", which is a bit of a fudge, but it only
376 -- This Id is also used to get a unique for a
377 -- temporary variable, if the closure is a CHARLIKE.
378 -- funilly enough, this makes the unique always come
380 buildDynCon (mkDataConId con) currentCCS
381 con amodes all_zero_size_args
383 idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
387 profCtrC SLIT("TICK_RET_CON") [mkIntCLit (length amodes)] `thenC`
388 -- could use doTailCall here.
389 performReturn (move_to_reg amode node)
390 (mkStaticAlgReturnCode con)
393 con_name = dataConName con
395 move_to_reg :: CAddrMode -> MagicId -> AbstractC
396 move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode