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.
11 #include "HsVersions.h"
14 cgTopRhsCon, buildDynCon,
25 import AbsCUtils ( mkAbstractCs, getAmodeRep )
26 import CgBindery ( getArgAmodes, bindNewToNode,
27 bindArgsToRegs, newTempAmodeAndIdInfo,
28 idInfoToAmode, stableAmodeIdInfo,
31 import CgClosure ( cgTopRhsClosure )
32 import CgCompInfo ( mAX_INTLIKE, mIN_INTLIKE )
33 import CgHeapery ( allocDynClosure )
34 import CgRetConv ( dataReturnConvAlg, DataReturnConvention(..) )
35 import CgTailCall ( performReturn, mkStaticAlgReturnCode )
36 import CLabel ( mkClosureLabel, mkStaticClosureLabel,
37 mkConInfoTableLabel, mkPhantomInfoTableLabel
39 import ClosureInfo ( mkClosureLFInfo, mkConLFInfo, mkLFArgument,
40 layOutDynCon, layOutDynClosure,
43 import CostCentre ( currentOrSubsumedCosts, useCurrentCostCentre,
46 import Id ( idPrimRep, dataConTag, dataConTyCon,
47 isDataCon, DataCon(..),
50 import Literal ( Literal(..) )
51 import Maybes ( maybeToBool )
52 import PrelInfo ( maybeCharLikeTyCon, maybeIntLikeTyCon )
53 import PrimRep ( isFloatingRep, PrimRep(..) )
54 import TyCon ( TyCon{-instance Uniquable-} )
55 import Util ( isIn, zipWithEqual, panic, assertPanic )
58 %************************************************************************
60 \subsection[toplevel-constructors]{Top-level constructors}
62 %************************************************************************
65 cgTopRhsCon :: Id -- Name of thing bound to this RHS
68 -> Bool -- All zero-size args (see buildDynCon)
69 -> FCode (Id, CgIdInfo)
73 Constructors some of whose arguments are of \tr{Float#} or
74 \tr{Double#} type, {\em or} which are ``lit lits'' (which are given
77 These ones have to be compiled as re-entrant thunks rather than closures,
78 because we can't figure out a way to persuade C to allow us to initialise a
79 static closure with Floats and Doubles!
80 Thus, for \tr{x = 2.0} (defaults to Double), we get:
84 Main.x = MkDouble [2.0##]
89 SET_STATIC_HDR(Main_x_closure,Main_x_static,CC_DATA,,EXTDATA_RO)
91 -- its *own* info table:
92 STATIC_INFO_TABLE(Main_x,Main_x_entry,,,,EXTFUN,???,":MkDouble","Double");
93 -- with its *own* entry code:
94 STGFUN(Main_x_entry) {
103 The above has the down side that each floating-point constant will end
104 up with its own info table (rather than sharing the MkFloat/MkDouble
105 ones). On the plus side, however, it does return a value (\tr{2.0})
108 Here, then is the implementation: just pretend it's a non-updatable
109 thunk. That is, instead of
115 x = [] \n [] -> F# 3.455#
118 top_cc = dontCareCostCentre -- out here to avoid a cgTopRhsCon CAF (sigh)
119 top_ccc = mkCCostCentre dontCareCostCentre -- because it's static data
121 cgTopRhsCon name con args all_zero_size_args
122 | any (isFloatingRep . getArgPrimRep) args
123 || any isLitLitArg args
124 = cgTopRhsClosure name top_cc NoStgBinderInfo [] body lf_info
126 body = StgCon con args emptyIdSet{-emptyLiveVarSet-}
127 lf_info = mkClosureLFInfo True {- Top level -} [] ReEntrant [] body
130 OK, so now we have the general case.
133 cgTopRhsCon name con args all_zero_size_args
135 ASSERT(isDataCon con)
138 getArgAmodes args `thenFC` \ amodes ->
141 (closure_info, amodes_w_offsets)
142 = layOutStaticClosure name getAmodeRep amodes lf_info
144 -- HWL: In 0.22 there was a heap check in here that had to be changed.
145 -- CHECK if having no heap check is ok for GrAnSim here!!!
149 closure_label -- Labelled with the name on lhs of defn
150 closure_info -- Closure is static
152 (map fst amodes_w_offsets)) -- Sorted into ptrs first, then nonptrs
157 returnFC (name, stableAmodeIdInfo name (CLbl closure_label PtrRep) lf_info)
159 con_tycon = dataConTyCon con
160 lf_info = mkConLFInfo con
161 closure_label = mkClosureLabel name
172 Main.x = Main.MkFoo []
174 -- interesting parts of the C Code:
177 SET_STATIC_HDR(Main_x_closure,Main_MkFoo_static,CC_DATA,,EXTDATA_RO)
179 -- entry code for "x":
180 STGFUN(Main_x_entry) {
181 Node=(W_)(Main_x_closure);
182 STGJUMP(Main_MkFoo_entry);
186 Observe: (1)~We create a static closure for \tr{x}, {\em reusing} the
187 regular \tr{MkFoo} info-table and entry code. (2)~However: the
188 \tr{MkFoo} code expects Node to be set, but the caller of \tr{x_entry}
189 will not have set it. Therefore, the whole point of \tr{x_entry} is
190 to set node (and then call the shared \tr{MkFoo} entry code).
193 For top-level Int/Char constants. We get entry-code fragments of the form:
199 -- entry code for "y":
200 STGFUN(Main_y_entry) {
201 Node=(W_)(Main_y_closure);
206 This is pretty tiresome: we {\em know} what the constant is---we'd
207 rather just return it. We end up with something that's a hybrid
208 between the Float/Double and general cases: (a)~like Floats/Doubles,
209 the entry-code returns the value immediately; (b)~like the general
210 case, we share the data-constructor's std info table. So, what we
220 -- interesting parts of the C Code:
222 -- closure for "z" (shares I# info table):
223 SET_STATIC_HDR(Main_z_closure,I#_static,CC_DATA,,EXTDATA_RO)
225 -- entry code for "z" (do the business directly):
226 STGFUN(Main_z_entry) {
235 This blob used to be in cgTopRhsCon, but I don't see how we can jump
236 direct to the named code for a constructor; any external entries will
237 be via Node. Generating all this extra code is a real waste for big
238 static data structures. So I've nuked it. SLPJ Sept 94
240 %************************************************************************
242 %* non-top-level constructors *
244 %************************************************************************
245 \subsection[code-for-constructors]{The code for constructors}
248 buildDynCon :: Id -- Name of the thing to which this constr will
250 -> CostCentre -- Where to grab cost centre from;
251 -- current CC if currentOrSubsumedCosts
252 -> DataCon -- The data constructor
253 -> [CAddrMode] -- Its args
254 -> Bool -- True <=> all args (if any) are
255 -- of "zero size" (i.e., VoidRep);
256 -- The reason we don't just look at the
257 -- args is that we may be in a "knot", and
258 -- premature looking at the args will cause
259 -- the compiler to black-hole!
260 -> FCode CgIdInfo -- Return details about how to find it
263 First we deal with the case of zero-arity constructors. Now, they
264 will probably be unfolded, so we don't expect to see this case much,
265 if at all, but it does no harm, and sets the scene for characters.
267 In the case of zero-arity constructors, or, more accurately, those
268 which have exclusively size-zero (VoidRep) args, we generate no code
272 buildDynCon binder cc con args all_zero_size_args@True
273 = ASSERT(isDataCon con)
274 returnFC (stableAmodeIdInfo binder
275 (CLbl (mkStaticClosureLabel con) PtrRep)
279 Now for @Char@-like closures. We generate an assignment of the
280 address of the closure to a temporary. It would be possible simply to
281 generate no code, and record the addressing mode in the environment,
282 but we'd have to be careful if the argument wasn't a constant --- so
283 for simplicity we just always asssign to a temporary.
285 Last special case: @Int@-like closures. We only special-case the
286 situation in which the argument is a literal in the range
287 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
288 work with any old argument, but for @Int@-like ones the argument has
289 to be a literal. Reason: @Char@ like closures have an argument type
290 which is guaranteed in range.
292 Because of this, we use can safely return an addressing mode.
295 buildDynCon binder cc con [arg_amode] all_zero_size_args@False
297 | maybeToBool (maybeCharLikeTyCon tycon)
298 = ASSERT(isDataCon con)
299 absC (CAssign temp_amode (CCharLike arg_amode)) `thenC`
300 returnFC temp_id_info
302 | maybeToBool (maybeIntLikeTyCon tycon) && in_range_int_lit arg_amode
303 = ASSERT(isDataCon con)
304 returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con))
306 tycon = dataConTyCon con
307 (temp_amode, temp_id_info) = newTempAmodeAndIdInfo binder (mkConLFInfo con)
309 in_range_int_lit (CLit (MachInt val _)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
310 in_range_int_lit other_amode = False
313 Now the general case.
316 buildDynCon binder cc con args all_zero_size_args@False
317 = ASSERT(isDataCon con)
318 allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off ->
319 returnFC (heapIdInfo binder hp_off (mkConLFInfo con))
321 (closure_info, amodes_w_offsets)
322 = layOutDynClosure binder getAmodeRep args (mkConLFInfo con)
324 use_cc -- cost-centre to stick in the object
325 = if currentOrSubsumedCosts cc
326 then CReg CurCostCentre
327 else mkCCostCentre cc
329 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
333 %************************************************************************
335 %* constructor-related utility function: *
336 %* bindConArgs is called from cgAlt of a case *
338 %************************************************************************
339 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
341 @bindConArgs@ $con args$ augments the environment with bindings for the
342 binders $args$, assuming that we have just returned from a @case@ which
346 bindConArgs :: DataCon -> [Id] -> Code
348 = ASSERT(isDataCon con)
349 case (dataReturnConvAlg con) of
350 ReturnInRegs rs -> bindArgsToRegs args rs
353 (_, args_w_offsets) = layOutDynCon con idPrimRep args
355 mapCs bind_arg args_w_offsets
357 bind_arg (arg, offset) = bindNewToNode arg offset mkLFArgument
361 %************************************************************************
363 \subsubsection[CgRetConv-cgReturnDataCon]{Actually generate code for a constructor return}
365 %************************************************************************
368 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
369 sure the @amodes@ passed don't conflict with each other.
371 cgReturnDataCon :: DataCon -> [CAddrMode] -> Bool -> StgLiveVars -> Code
373 cgReturnDataCon con amodes all_zero_size_args live_vars
374 = ASSERT(isDataCon con)
375 getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_spa args_spb sequel) ->
379 CaseAlts _ (Just (alts, Just (maybe_deflt_binder, (_,deflt_lbl))))
380 | not (dataConTag con `is_elem` map fst alts)
382 -- Special case! We're returning a constructor to the default case
383 -- of an enclosing case. For example:
385 -- case (case e of (a,b) -> C a b) of
387 -- y -> ...<returning here!>...
390 -- if the default is a non-bind-default (ie does not use y),
391 -- then we should simply jump to the default join point;
393 -- if the default is a bind-default (ie does use y), we
394 -- should return the constructor IN THE HEAP, pointed to by Node,
395 -- **regardless** of the return convention of the constructor C.
397 case maybe_deflt_binder of
399 buildDynCon binder useCurrentCostCentre con amodes all_zero_size_args
401 idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
402 performReturn (move_to_reg amode node) jump_to_join_point live_vars
405 performReturn AbsCNop {- No reg assts -} jump_to_join_point live_vars
407 is_elem = isIn "cgReturnDataCon"
408 jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
409 -- Ignore the sequel: we've already looked at it above
411 other_sequel -> -- The usual case
412 case (dataReturnConvAlg con) of
415 -- BUILD THE OBJECT IN THE HEAP
416 -- The first "con" says that the name bound to this
417 -- closure is "con", which is a bit of a fudge, but it only
418 -- affects profiling (ToDo?)
419 buildDynCon con useCurrentCostCentre con amodes all_zero_size_args
421 idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
423 -- MAKE NODE POINT TO IT
424 let reg_assts = move_to_reg amode node
425 info_lbl = mkConInfoTableLabel con
429 profCtrC SLIT("RET_NEW_IN_HEAP") [mkIntCLit (length amodes)] `thenC`
431 performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
435 reg_assts = mkAbstractCs (zipWithEqual "move_to_reg" move_to_reg amodes regs)
436 info_lbl = mkPhantomInfoTableLabel con
438 profCtrC SLIT("RET_NEW_IN_REGS") [mkIntCLit (length amodes)] `thenC`
440 performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
442 move_to_reg :: CAddrMode -> MagicId -> AbstractC
443 move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode