2 % (c) The GRASP Project, Glasgow University, 1992-1995
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.
11 #include "HsVersions.h"
14 -- it's all exported, actually...
15 cgTopRhsCon, buildDynCon,
19 -- and to make the interface self-sufficient...
26 import Type ( maybeCharLikeTyCon, maybeIntLikeTyCon, TyVar,
29 import CgBindery ( getAtomAmode, getAtomAmodes, bindNewToNode,
30 bindArgsToRegs, newTempAmodeAndIdInfo, idInfoToAmode
32 import CgClosure ( cgTopRhsClosure )
33 import CgHeapery ( allocDynClosure, heapCheck
35 , fetchAndReschedule -- HWL
38 import CgCompInfo ( mAX_INTLIKE, mIN_INTLIKE )
40 import CgRetConv ( dataReturnConvAlg, mkLiveRegsBitMask,
41 CtrlReturnConvention(..), DataReturnConvention(..)
43 import CgTailCall ( performReturn, mkStaticAlgReturnCode )
44 import CgUsages ( getHpRelOffset )
45 import CLabel ( CLabel, mkClosureLabel, mkInfoTableLabel,
46 mkPhantomInfoTableLabel,
47 mkConEntryLabel, mkStdEntryLabel
49 import ClosureInfo -- hiding ( auxInfoTableLabelFromCI ) -- I hate pragmas
50 {-( mkConLFInfo, mkLFArgument, closureLFInfo,
51 layOutDynCon, layOutDynClosure,
52 layOutStaticClosure, UpdateFlag(..),
53 mkClosureLFInfo, layOutStaticNoFVClosure
55 import Id ( getIdPrimRep, getDataConTag, getDataConTyCon,
56 isDataCon, fIRST_TAG, DataCon(..), ConTag(..)
58 import Maybes ( maybeToBool, Maybe(..) )
59 import PrimRep ( PrimRep(..), isFloatingRep, getPrimRepSize )
61 import UniqSet -- ( emptyUniqSet, UniqSet(..) )
65 %************************************************************************
67 \subsection[toplevel-constructors]{Top-level constructors}
69 %************************************************************************
72 cgTopRhsCon :: Id -- Name of thing bound to this RHS
75 -> Bool -- All zero-size args (see buildDynCon)
76 -> FCode (Id, CgIdInfo)
80 Constructors some of whose arguments are of \tr{Float#} or
81 \tr{Double#} type, {\em or} which are ``lit lits'' (which are given
84 These ones have to be compiled as re-entrant thunks rather than closures,
85 because we can't figure out a way to persuade C to allow us to initialise a
86 static closure with Floats and Doubles!
87 Thus, for \tr{x = 2.0} (defaults to Double), we get:
91 Main.x = MkDouble [2.0##]
96 SET_STATIC_HDR(Main_x_closure,Main_x_static,CC_DATA,,EXTDATA_RO)
98 -- its *own* info table:
99 STATIC_INFO_TABLE(Main_x,Main_x_entry,,,,EXTFUN,???,":MkDouble","Double");
100 -- with its *own* entry code:
101 STGFUN(Main_x_entry) {
110 The above has the down side that each floating-point constant will end
111 up with its own info table (rather than sharing the MkFloat/MkDouble
112 ones). On the plus side, however, it does return a value (\tr{2.0})
115 Here, then is the implementation: just pretend it's a non-updatable
116 thunk. That is, instead of
122 x = [] \n [] -> F# 3.455#
125 top_cc = dontCareCostCentre -- out here to avoid a cgTopRhsCon CAF (sigh)
126 top_ccc = mkCCostCentre dontCareCostCentre -- because it's static data
128 cgTopRhsCon name con args all_zero_size_args
129 | any (isFloatingRep . getArgPrimRep) args
130 || any isLitLitArg args
131 = cgTopRhsClosure name top_cc NoStgBinderInfo [] body lf_info
133 body = StgCon con args emptyUniqSet{-emptyLiveVarSet-}
134 lf_info = mkClosureLFInfo True {- Top level -} [] ReEntrant [] body
137 OK, so now we have the general case.
140 cgTopRhsCon name con args all_zero_size_args
142 ASSERT(isDataCon con)
145 getAtomAmodes args `thenFC` \ amodes ->
148 (closure_info, amodes_w_offsets)
149 = layOutStaticClosure name getAmodeRep amodes lf_info
151 -- HWL: In 0.22 there was a heap check in here that had to be changed.
152 -- CHECK if having no heap check is ok for GrAnSim here!!!
156 closure_label -- Labelled with the name on lhs of defn
157 closure_info -- Closure is static
159 (map fst amodes_w_offsets)) -- Sorted into ptrs first, then nonptrs
164 returnFC (name, stableAmodeIdInfo name (CLbl closure_label PtrRep) lf_info)
166 con_tycon = getDataConTyCon con
167 lf_info = mkConLFInfo con
169 closure_label = mkClosureLabel name
170 info_label = mkInfoTableLabel con
171 con_entry_label = mkConEntryLabel con
172 entry_label = mkStdEntryLabel name
183 Main.x = Main.MkFoo []
185 -- interesting parts of the C Code:
188 SET_STATIC_HDR(Main_x_closure,Main_MkFoo_static,CC_DATA,,EXTDATA_RO)
190 -- entry code for "x":
191 STGFUN(Main_x_entry) {
192 Node=(W_)(Main_x_closure);
193 STGJUMP(Main_MkFoo_entry);
197 Observe: (1)~We create a static closure for \tr{x}, {\em reusing} the
198 regular \tr{MkFoo} info-table and entry code. (2)~However: the
199 \tr{MkFoo} code expects Node to be set, but the caller of \tr{x_entry}
200 will not have set it. Therefore, the whole point of \tr{x_entry} is
201 to set node (and then call the shared \tr{MkFoo} entry code).
204 For top-level Int/Char constants. We get entry-code fragments of the form:
210 -- entry code for "y":
211 STGFUN(Main_y_entry) {
212 Node=(W_)(Main_y_closure);
217 This is pretty tiresome: we {\em know} what the constant is---we'd
218 rather just return it. We end up with something that's a hybrid
219 between the Float/Double and general cases: (a)~like Floats/Doubles,
220 the entry-code returns the value immediately; (b)~like the general
221 case, we share the data-constructor's std info table. So, what we
231 -- interesting parts of the C Code:
233 -- closure for "z" (shares I# info table):
234 SET_STATIC_HDR(Main_z_closure,I#_static,CC_DATA,,EXTDATA_RO)
236 -- entry code for "z" (do the business directly):
237 STGFUN(Main_z_entry) {
246 This blob used to be in cgTopRhsCon, but I don't see how we can jump
247 direct to the named code for a constructor; any external entries will
248 be via Node. Generating all this extra code is a real waste for big
249 static data structures. So I've nuked it. SLPJ Sept 94
251 %************************************************************************
253 %* non-top-level constructors *
255 %************************************************************************
256 \subsection[code-for-constructors]{The code for constructors}
259 buildDynCon :: Id -- Name of the thing to which this constr will
261 -> CostCentre -- Where to grab cost centre from;
262 -- current CC if currentOrSubsumedCosts
263 -> DataCon -- The data constructor
264 -> [CAddrMode] -- Its args
265 -> Bool -- True <=> all args (if any) are
266 -- of "zero size" (i.e., VoidRep);
267 -- The reason we don't just look at the
268 -- args is that we may be in a "knot", and
269 -- premature looking at the args will cause
270 -- the compiler to black-hole!
271 -> FCode CgIdInfo -- Return details about how to find it
274 First we deal with the case of zero-arity constructors. Now, they
275 will probably be unfolded, so we don't expect to see this case much,
276 if at all, but it does no harm, and sets the scene for characters.
278 In the case of zero-arity constructors, or, more accurately, those
279 which have exclusively size-zero (VoidRep) args, we generate no code
283 buildDynCon binder cc con args all_zero_size_args@True
284 = ASSERT(isDataCon con)
285 returnFC (stableAmodeIdInfo binder
286 (CLbl (mkClosureLabel con) PtrRep)
290 Now for @Char@-like closures. We generate an assignment of the
291 address of the closure to a temporary. It would be possible simply to
292 generate no code, and record the addressing mode in the environment,
293 but we'd have to be careful if the argument wasn't a constant --- so
294 for simplicity we just always asssign to a temporary.
296 Last special case: @Int@-like closures. We only special-case the
297 situation in which the argument is a literal in the range
298 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
299 work with any old argument, but for @Int@-like ones the argument has
300 to be a literal. Reason: @Char@ like closures have an argument type
301 which is guaranteed in range.
303 Because of this, we use can safely return an addressing mode.
306 buildDynCon binder cc con [arg_amode] all_zero_size_args@False
308 | maybeToBool (maybeCharLikeTyCon tycon)
309 = ASSERT(isDataCon con)
310 absC (CAssign temp_amode (CCharLike arg_amode)) `thenC`
311 returnFC temp_id_info
313 | maybeToBool (maybeIntLikeTyCon tycon) && in_range_int_lit arg_amode
314 = ASSERT(isDataCon con)
315 returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con))
317 tycon = getDataConTyCon con
318 (temp_amode, temp_id_info) = newTempAmodeAndIdInfo binder (mkConLFInfo con)
320 in_range_int_lit (CLit (MachInt val _)) = (val <= mAX_INTLIKE) && (val >= mIN_INTLIKE)
321 in_range_int_lit other_amode = False
324 Now the general case.
327 buildDynCon binder cc con args all_zero_size_args@False
328 = ASSERT(isDataCon con)
329 allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off ->
330 returnFC (heapIdInfo binder hp_off (mkConLFInfo con))
332 (closure_info, amodes_w_offsets)
333 = layOutDynClosure binder getAmodeRep args (mkConLFInfo con)
335 use_cc -- cost-centre to stick in the object
336 = if currentOrSubsumedCosts cc
337 then CReg CurCostCentre
338 else mkCCostCentre cc
340 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
344 %************************************************************************
346 %* constructor-related utility function: *
347 %* bindConArgs is called from cgAlt of a case *
349 %************************************************************************
350 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
352 @bindConArgs@ $con args$ augments the environment with bindings for the
353 binders $args$, assuming that we have just returned from a @case@ which
357 bindConArgs :: DataCon -> [Id] -> Code
359 = ASSERT(isDataCon con)
360 getIntSwitchChkrC `thenFC` \ isw_chkr ->
362 case (dataReturnConvAlg isw_chkr con) of
363 ReturnInRegs rs -> bindArgsToRegs args rs
366 (_, args_w_offsets) = layOutDynCon con getIdPrimRep args
368 mapCs bind_arg args_w_offsets
370 bind_arg (arg, offset) = bindNewToNode arg offset mkLFArgument
374 %************************************************************************
376 \subsubsection[CgRetConv-cgReturnDataCon]{Actually generate code for a constructor return}
378 %************************************************************************
381 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
382 sure the @amodes@ passed don't conflict with each other.
384 cgReturnDataCon :: DataCon -> [CAddrMode] -> Bool -> StgLiveVars -> Code
386 cgReturnDataCon con amodes all_zero_size_args live_vars
387 = ASSERT(isDataCon con)
388 getIntSwitchChkrC `thenFC` \ isw_chkr ->
389 getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_spa args_spb sequel) ->
393 CaseAlts _ (Just (alts, Just (maybe_deflt_binder, (_,deflt_lbl))))
394 | not (getDataConTag con `is_elem` map fst alts)
396 -- Special case! We're returning a constructor to the default case
397 -- of an enclosing case. For example:
399 -- case (case e of (a,b) -> C a b) of
401 -- y -> ...<returning here!>...
404 -- if the default is a non-bind-default (ie does not use y),
405 -- then we should simply jump to the default join point;
407 -- if the default is a bind-default (ie does use y), we
408 -- should return the constructor IN THE HEAP, pointed to by Node,
409 -- **regardless** of the return convention of the constructor C.
411 case maybe_deflt_binder of
413 buildDynCon binder useCurrentCostCentre con amodes all_zero_size_args
415 idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
416 performReturn (move_to_reg amode node) jump_to_join_point live_vars
419 performReturn AbsCNop {- No reg assts -} jump_to_join_point live_vars
421 is_elem = isIn "cgReturnDataCon"
422 jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
423 -- Ignore the sequel: we've already looked at it above
425 other_sequel -> -- The usual case
426 case (dataReturnConvAlg isw_chkr con) of
429 -- BUILD THE OBJECT IN THE HEAP
430 -- The first "con" says that the name bound to this
431 -- closure is "con", which is a bit of a fudge, but it only
432 -- affects profiling (ToDo?)
433 buildDynCon con useCurrentCostCentre con amodes all_zero_size_args
435 idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
437 -- MAKE NODE POINT TO IT
438 let reg_assts = move_to_reg amode node
439 info_lbl = mkInfoTableLabel con
443 profCtrC SLIT("RET_NEW_IN_HEAP") [mkIntCLit (length amodes)] `thenC`
445 performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
449 reg_assts = mkAbstractCs (zipWithEqual move_to_reg amodes regs)
450 info_lbl = mkPhantomInfoTableLabel con
452 profCtrC SLIT("RET_NEW_IN_REGS") [mkIntCLit (length amodes)] `thenC`
454 performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
456 move_to_reg :: CAddrMode -> MagicId -> AbstractC
457 move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode