2 % (c) The GRASP Project, Glasgow University, 1992-1996
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,
17 #include "HsVersions.h"
23 import AbsCUtils ( mkAbstractCs, getAmodeRep )
24 import CgBindery ( getArgAmodes, bindNewToNode,
25 bindArgsToRegs, newTempAmodeAndIdInfo,
26 idInfoToAmode, stableAmodeIdInfo,
29 import CgClosure ( cgTopRhsClosure )
30 import Constants ( mAX_INTLIKE, mIN_INTLIKE )
31 import CgHeapery ( allocDynClosure )
32 import CgRetConv ( dataReturnConvAlg, DataReturnConvention(..) )
33 import CgTailCall ( performReturn, mkStaticAlgReturnCode )
34 import CLabel ( mkClosureLabel, mkStaticClosureLabel,
35 mkConInfoTableLabel, mkPhantomInfoTableLabel
37 import ClosureInfo ( mkClosureLFInfo, mkConLFInfo, mkLFArgument,
38 layOutDynCon, layOutDynClosure,
41 import CostCentre ( currentOrSubsumedCosts, useCurrentCostCentre,
42 dontCareCostCentre, CostCentre
44 import Id ( idPrimRep, dataConTag, dataConTyCon,
48 import Literal ( Literal(..) )
49 import Maybes ( maybeToBool )
50 import PrelInfo ( maybeCharLikeTyCon, maybeIntLikeTyCon )
51 import PrimRep ( isFloatingRep, PrimRep(..) )
52 import TyCon ( TyCon{-instance Uniquable-} )
53 import Util ( isIn, zipWithEqual, 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)
71 Constructors some of whose arguments are of \tr{Float#} or
72 \tr{Double#} type, {\em or} which are ``lit lits'' (which are given
75 These ones have to be compiled as re-entrant thunks rather than closures,
76 because we can't figure out a way to persuade C to allow us to initialise a
77 static closure with Floats and Doubles!
78 Thus, for \tr{x = 2.0} (defaults to Double), we get:
82 Main.x = MkDouble [2.0##]
87 SET_STATIC_HDR(Main_x_closure,Main_x_static,CC_DATA,,EXTDATA_RO)
89 -- its *own* info table:
90 STATIC_INFO_TABLE(Main_x,Main_x_entry,,,,EXTFUN,???,":MkDouble","Double");
91 -- with its *own* entry code:
92 STGFUN(Main_x_entry) {
101 The above has the down side that each floating-point constant will end
102 up with its own info table (rather than sharing the MkFloat/MkDouble
103 ones). On the plus side, however, it does return a value (\tr{2.0})
106 Here, then is the implementation: just pretend it's a non-updatable
107 thunk. That is, instead of
113 x = [] \n [] -> F# 3.455#
116 top_cc = dontCareCostCentre -- out here to avoid a cgTopRhsCon CAF (sigh)
117 top_ccc = mkCCostCentre dontCareCostCentre -- because it's static data
119 cgTopRhsCon name con args all_zero_size_args
120 | any (isFloatingRep . getArgPrimRep) args
121 || any isLitLitArg args
122 = cgTopRhsClosure name top_cc NoStgBinderInfo [] body lf_info
124 body = StgCon con args emptyIdSet{-emptyLiveVarSet-}
125 lf_info = mkClosureLFInfo True {- Top level -} [] ReEntrant []
128 OK, so now we have the general case.
131 cgTopRhsCon name con args all_zero_size_args
133 ASSERT(isDataCon con)
136 getArgAmodes args `thenFC` \ amodes ->
139 (closure_info, amodes_w_offsets)
140 = layOutStaticClosure name getAmodeRep amodes lf_info
142 -- HWL: In 0.22 there was a heap check in here that had to be changed.
143 -- CHECK if having no heap check is ok for GrAnSim here!!!
147 closure_label -- Labelled with the name on lhs of defn
148 closure_info -- Closure is static
150 (map fst amodes_w_offsets)) -- Sorted into ptrs first, then nonptrs
155 returnFC (name, stableAmodeIdInfo name (CLbl closure_label PtrRep) lf_info)
157 con_tycon = dataConTyCon con
158 lf_info = mkConLFInfo con
159 closure_label = mkClosureLabel name
170 Main.x = Main.MkFoo []
172 -- interesting parts of the C Code:
175 SET_STATIC_HDR(Main_x_closure,Main_MkFoo_static,CC_DATA,,EXTDATA_RO)
177 -- entry code for "x":
178 STGFUN(Main_x_entry) {
179 Node=(W_)(Main_x_closure);
180 STGJUMP(Main_MkFoo_entry);
184 Observe: (1)~We create a static closure for \tr{x}, {\em reusing} the
185 regular \tr{MkFoo} info-table and entry code. (2)~However: the
186 \tr{MkFoo} code expects Node to be set, but the caller of \tr{x_entry}
187 will not have set it. Therefore, the whole point of \tr{x_entry} is
188 to set node (and then call the shared \tr{MkFoo} entry code).
191 For top-level Int/Char constants. We get entry-code fragments of the form:
197 -- entry code for "y":
198 STGFUN(Main_y_entry) {
199 Node=(W_)(Main_y_closure);
204 This is pretty tiresome: we {\em know} what the constant is---we'd
205 rather just return it. We end up with something that's a hybrid
206 between the Float/Double and general cases: (a)~like Floats/Doubles,
207 the entry-code returns the value immediately; (b)~like the general
208 case, we share the data-constructor's std info table. So, what we
218 -- interesting parts of the C Code:
220 -- closure for "z" (shares I# info table):
221 SET_STATIC_HDR(Main_z_closure,I#_static,CC_DATA,,EXTDATA_RO)
223 -- entry code for "z" (do the business directly):
224 STGFUN(Main_z_entry) {
233 This blob used to be in cgTopRhsCon, but I don't see how we can jump
234 direct to the named code for a constructor; any external entries will
235 be via Node. Generating all this extra code is a real waste for big
236 static data structures. So I've nuked it. SLPJ Sept 94
238 %************************************************************************
240 %* non-top-level constructors *
242 %************************************************************************
243 \subsection[code-for-constructors]{The code for constructors}
246 buildDynCon :: Id -- Name of the thing to which this constr will
248 -> CostCentre -- Where to grab cost centre from;
249 -- current CC if currentOrSubsumedCosts
250 -> DataCon -- The data constructor
251 -> [CAddrMode] -- Its args
252 -> Bool -- True <=> all args (if any) are
253 -- of "zero size" (i.e., VoidRep);
254 -- The reason we don't just look at the
255 -- args is that we may be in a "knot", and
256 -- premature looking at the args will cause
257 -- the compiler to black-hole!
258 -> FCode CgIdInfo -- Return details about how to find it
261 First we deal with the case of zero-arity constructors. Now, they
262 will probably be unfolded, so we don't expect to see this case much,
263 if at all, but it does no harm, and sets the scene for characters.
265 In the case of zero-arity constructors, or, more accurately, those
266 which have exclusively size-zero (VoidRep) args, we generate no code
270 buildDynCon binder cc con args all_zero_size_args@True
271 = ASSERT(isDataCon con)
272 returnFC (stableAmodeIdInfo binder
273 (CLbl (mkStaticClosureLabel con) PtrRep)
277 Now for @Char@-like closures. We generate an assignment of the
278 address of the closure to a temporary. It would be possible simply to
279 generate no code, and record the addressing mode in the environment,
280 but we'd have to be careful if the argument wasn't a constant --- so
281 for simplicity we just always asssign to a temporary.
283 Last special case: @Int@-like closures. We only special-case the
284 situation in which the argument is a literal in the range
285 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
286 work with any old argument, but for @Int@-like ones the argument has
287 to be a literal. Reason: @Char@ like closures have an argument type
288 which is guaranteed in range.
290 Because of this, we use can safely return an addressing mode.
293 buildDynCon binder cc con [arg_amode] all_zero_size_args@False
295 | maybeToBool (maybeCharLikeTyCon tycon)
296 = ASSERT(isDataCon con)
297 absC (CAssign temp_amode (CCharLike arg_amode)) `thenC`
298 returnFC temp_id_info
300 | maybeToBool (maybeIntLikeTyCon tycon) && in_range_int_lit arg_amode
301 = ASSERT(isDataCon con)
302 returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con))
304 tycon = dataConTyCon con
305 (temp_amode, temp_id_info) = newTempAmodeAndIdInfo binder (mkConLFInfo con)
307 in_range_int_lit (CLit (MachInt val _)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
308 in_range_int_lit other_amode = False
311 Now the general case.
314 buildDynCon binder cc con args all_zero_size_args@False
315 = ASSERT(isDataCon con)
316 allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off ->
317 returnFC (heapIdInfo binder hp_off (mkConLFInfo con))
319 (closure_info, amodes_w_offsets)
320 = layOutDynClosure binder getAmodeRep args (mkConLFInfo con)
322 use_cc -- cost-centre to stick in the object
323 = if currentOrSubsumedCosts cc
324 then CReg CurCostCentre
325 else mkCCostCentre cc
327 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
331 %************************************************************************
333 %* constructor-related utility function: *
334 %* bindConArgs is called from cgAlt of a case *
336 %************************************************************************
337 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
339 @bindConArgs@ $con args$ augments the environment with bindings for the
340 binders $args$, assuming that we have just returned from a @case@ which
344 bindConArgs :: DataCon -> [Id] -> Code
346 = ASSERT(isDataCon con)
347 case (dataReturnConvAlg con) of
348 ReturnInRegs rs -> bindArgsToRegs args rs
351 (_, args_w_offsets) = layOutDynCon con idPrimRep args
353 mapCs bind_arg args_w_offsets
355 bind_arg (arg, offset) = bindNewToNode arg offset mkLFArgument
359 %************************************************************************
361 \subsubsection[CgRetConv-cgReturnDataCon]{Actually generate code for a constructor return}
363 %************************************************************************
366 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
367 sure the @amodes@ passed don't conflict with each other.
369 cgReturnDataCon :: DataCon -> [CAddrMode] -> Bool -> StgLiveVars -> Code
371 cgReturnDataCon con amodes all_zero_size_args live_vars
372 = ASSERT(isDataCon con)
373 getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_spa args_spb sequel) ->
377 CaseAlts _ (Just (alts, Just (maybe_deflt_binder, (_,deflt_lbl))))
378 | not (dataConTag con `is_elem` map fst alts)
380 -- Special case! We're returning a constructor to the default case
381 -- of an enclosing case. For example:
383 -- case (case e of (a,b) -> C a b) of
385 -- y -> ...<returning here!>...
388 -- if the default is a non-bind-default (ie does not use y),
389 -- then we should simply jump to the default join point;
391 -- if the default is a bind-default (ie does use y), we
392 -- should return the constructor IN THE HEAP, pointed to by Node,
393 -- **regardless** of the return convention of the constructor C.
395 case maybe_deflt_binder of
397 buildDynCon binder useCurrentCostCentre con amodes all_zero_size_args
399 idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
400 performReturn (move_to_reg amode node) jump_to_join_point live_vars
403 performReturn AbsCNop {- No reg assts -} jump_to_join_point live_vars
405 is_elem = isIn "cgReturnDataCon"
406 jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
407 -- Ignore the sequel: we've already looked at it above
409 other_sequel -> -- The usual case
410 case (dataReturnConvAlg con) of
413 -- BUILD THE OBJECT IN THE HEAP
414 -- The first "con" says that the name bound to this
415 -- closure is "con", which is a bit of a fudge, but it only
416 -- affects profiling (ToDo?)
417 buildDynCon con useCurrentCostCentre con amodes all_zero_size_args
419 idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
421 -- MAKE NODE POINT TO IT
422 let reg_assts = move_to_reg amode node
423 info_lbl = mkConInfoTableLabel con
427 profCtrC SLIT("RET_NEW_IN_HEAP") [mkIntCLit (length amodes)] `thenC`
429 performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
433 reg_assts = mkAbstractCs (zipWithEqual "move_to_reg" move_to_reg amodes regs)
434 info_lbl = mkPhantomInfoTableLabel con
436 profCtrC SLIT("RET_NEW_IN_REGS") [mkIntCLit (length amodes)] `thenC`
438 performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
440 move_to_reg :: CAddrMode -> MagicId -> AbstractC
441 move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode