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, mkInfoTableLabel,
37 mkPhantomInfoTableLabel,
38 mkConEntryLabel, mkStdEntryLabel
40 import ClosureInfo ( mkClosureLFInfo, mkConLFInfo, mkLFArgument,
41 layOutDynCon, layOutDynClosure,
44 import CostCentre ( currentOrSubsumedCosts, useCurrentCostCentre,
47 import Id ( idPrimRep, dataConTag, dataConTyCon,
48 isDataCon, DataCon(..),
51 import Literal ( Literal(..) )
52 import Maybes ( maybeToBool )
53 import PrimRep ( isFloatingRep, PrimRep(..) )
54 import Util ( isIn, zipWithEqual, panic, assertPanic )
56 maybeCharLikeTyCon = panic "CgCon.maybeCharLikeTyCon (ToDo)"
57 maybeIntLikeTyCon = panic "CgCon.maybeIntLikeTyCon (ToDo)"
60 %************************************************************************
62 \subsection[toplevel-constructors]{Top-level constructors}
64 %************************************************************************
67 cgTopRhsCon :: Id -- Name of thing bound to this RHS
70 -> Bool -- All zero-size args (see buildDynCon)
71 -> FCode (Id, CgIdInfo)
75 Constructors some of whose arguments are of \tr{Float#} or
76 \tr{Double#} type, {\em or} which are ``lit lits'' (which are given
79 These ones have to be compiled as re-entrant thunks rather than closures,
80 because we can't figure out a way to persuade C to allow us to initialise a
81 static closure with Floats and Doubles!
82 Thus, for \tr{x = 2.0} (defaults to Double), we get:
86 Main.x = MkDouble [2.0##]
91 SET_STATIC_HDR(Main_x_closure,Main_x_static,CC_DATA,,EXTDATA_RO)
93 -- its *own* info table:
94 STATIC_INFO_TABLE(Main_x,Main_x_entry,,,,EXTFUN,???,":MkDouble","Double");
95 -- with its *own* entry code:
96 STGFUN(Main_x_entry) {
105 The above has the down side that each floating-point constant will end
106 up with its own info table (rather than sharing the MkFloat/MkDouble
107 ones). On the plus side, however, it does return a value (\tr{2.0})
110 Here, then is the implementation: just pretend it's a non-updatable
111 thunk. That is, instead of
117 x = [] \n [] -> F# 3.455#
120 top_cc = dontCareCostCentre -- out here to avoid a cgTopRhsCon CAF (sigh)
121 top_ccc = mkCCostCentre dontCareCostCentre -- because it's static data
123 cgTopRhsCon name con args all_zero_size_args
124 | any (isFloatingRep . getArgPrimRep) args
125 || any isLitLitArg args
126 = cgTopRhsClosure name top_cc NoStgBinderInfo [] body lf_info
128 body = StgCon con args emptyIdSet{-emptyLiveVarSet-}
129 lf_info = mkClosureLFInfo True {- Top level -} [] ReEntrant [] body
132 OK, so now we have the general case.
135 cgTopRhsCon name con args all_zero_size_args
137 ASSERT(isDataCon con)
140 getArgAmodes args `thenFC` \ amodes ->
143 (closure_info, amodes_w_offsets)
144 = layOutStaticClosure name getAmodeRep amodes lf_info
146 -- HWL: In 0.22 there was a heap check in here that had to be changed.
147 -- CHECK if having no heap check is ok for GrAnSim here!!!
151 closure_label -- Labelled with the name on lhs of defn
152 closure_info -- Closure is static
154 (map fst amodes_w_offsets)) -- Sorted into ptrs first, then nonptrs
159 returnFC (name, stableAmodeIdInfo name (CLbl closure_label PtrRep) lf_info)
161 con_tycon = dataConTyCon con
162 lf_info = mkConLFInfo con
164 closure_label = mkClosureLabel name
165 info_label = mkInfoTableLabel con
166 con_entry_label = mkConEntryLabel con
167 entry_label = mkStdEntryLabel name
178 Main.x = Main.MkFoo []
180 -- interesting parts of the C Code:
183 SET_STATIC_HDR(Main_x_closure,Main_MkFoo_static,CC_DATA,,EXTDATA_RO)
185 -- entry code for "x":
186 STGFUN(Main_x_entry) {
187 Node=(W_)(Main_x_closure);
188 STGJUMP(Main_MkFoo_entry);
192 Observe: (1)~We create a static closure for \tr{x}, {\em reusing} the
193 regular \tr{MkFoo} info-table and entry code. (2)~However: the
194 \tr{MkFoo} code expects Node to be set, but the caller of \tr{x_entry}
195 will not have set it. Therefore, the whole point of \tr{x_entry} is
196 to set node (and then call the shared \tr{MkFoo} entry code).
199 For top-level Int/Char constants. We get entry-code fragments of the form:
205 -- entry code for "y":
206 STGFUN(Main_y_entry) {
207 Node=(W_)(Main_y_closure);
212 This is pretty tiresome: we {\em know} what the constant is---we'd
213 rather just return it. We end up with something that's a hybrid
214 between the Float/Double and general cases: (a)~like Floats/Doubles,
215 the entry-code returns the value immediately; (b)~like the general
216 case, we share the data-constructor's std info table. So, what we
226 -- interesting parts of the C Code:
228 -- closure for "z" (shares I# info table):
229 SET_STATIC_HDR(Main_z_closure,I#_static,CC_DATA,,EXTDATA_RO)
231 -- entry code for "z" (do the business directly):
232 STGFUN(Main_z_entry) {
241 This blob used to be in cgTopRhsCon, but I don't see how we can jump
242 direct to the named code for a constructor; any external entries will
243 be via Node. Generating all this extra code is a real waste for big
244 static data structures. So I've nuked it. SLPJ Sept 94
246 %************************************************************************
248 %* non-top-level constructors *
250 %************************************************************************
251 \subsection[code-for-constructors]{The code for constructors}
254 buildDynCon :: Id -- Name of the thing to which this constr will
256 -> CostCentre -- Where to grab cost centre from;
257 -- current CC if currentOrSubsumedCosts
258 -> DataCon -- The data constructor
259 -> [CAddrMode] -- Its args
260 -> Bool -- True <=> all args (if any) are
261 -- of "zero size" (i.e., VoidRep);
262 -- The reason we don't just look at the
263 -- args is that we may be in a "knot", and
264 -- premature looking at the args will cause
265 -- the compiler to black-hole!
266 -> FCode CgIdInfo -- Return details about how to find it
269 First we deal with the case of zero-arity constructors. Now, they
270 will probably be unfolded, so we don't expect to see this case much,
271 if at all, but it does no harm, and sets the scene for characters.
273 In the case of zero-arity constructors, or, more accurately, those
274 which have exclusively size-zero (VoidRep) args, we generate no code
278 buildDynCon binder cc con args all_zero_size_args@True
279 = ASSERT(isDataCon con)
280 returnFC (stableAmodeIdInfo binder
281 (CLbl (mkClosureLabel con) PtrRep)
285 Now for @Char@-like closures. We generate an assignment of the
286 address of the closure to a temporary. It would be possible simply to
287 generate no code, and record the addressing mode in the environment,
288 but we'd have to be careful if the argument wasn't a constant --- so
289 for simplicity we just always asssign to a temporary.
291 Last special case: @Int@-like closures. We only special-case the
292 situation in which the argument is a literal in the range
293 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
294 work with any old argument, but for @Int@-like ones the argument has
295 to be a literal. Reason: @Char@ like closures have an argument type
296 which is guaranteed in range.
298 Because of this, we use can safely return an addressing mode.
301 buildDynCon binder cc con [arg_amode] all_zero_size_args@False
303 | maybeToBool (maybeCharLikeTyCon tycon)
304 = ASSERT(isDataCon con)
305 absC (CAssign temp_amode (CCharLike arg_amode)) `thenC`
306 returnFC temp_id_info
308 | maybeToBool (maybeIntLikeTyCon tycon) && in_range_int_lit arg_amode
309 = ASSERT(isDataCon con)
310 returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con))
312 tycon = dataConTyCon con
313 (temp_amode, temp_id_info) = newTempAmodeAndIdInfo binder (mkConLFInfo con)
315 in_range_int_lit (CLit (MachInt val _)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
316 in_range_int_lit other_amode = False
319 Now the general case.
322 buildDynCon binder cc con args all_zero_size_args@False
323 = ASSERT(isDataCon con)
324 allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off ->
325 returnFC (heapIdInfo binder hp_off (mkConLFInfo con))
327 (closure_info, amodes_w_offsets)
328 = layOutDynClosure binder getAmodeRep args (mkConLFInfo con)
330 use_cc -- cost-centre to stick in the object
331 = if currentOrSubsumedCosts cc
332 then CReg CurCostCentre
333 else mkCCostCentre cc
335 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
339 %************************************************************************
341 %* constructor-related utility function: *
342 %* bindConArgs is called from cgAlt of a case *
344 %************************************************************************
345 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
347 @bindConArgs@ $con args$ augments the environment with bindings for the
348 binders $args$, assuming that we have just returned from a @case@ which
352 bindConArgs :: DataCon -> [Id] -> Code
354 = ASSERT(isDataCon con)
355 case (dataReturnConvAlg con) of
356 ReturnInRegs rs -> bindArgsToRegs args rs
359 (_, args_w_offsets) = layOutDynCon con idPrimRep args
361 mapCs bind_arg args_w_offsets
363 bind_arg (arg, offset) = bindNewToNode arg offset mkLFArgument
367 %************************************************************************
369 \subsubsection[CgRetConv-cgReturnDataCon]{Actually generate code for a constructor return}
371 %************************************************************************
374 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
375 sure the @amodes@ passed don't conflict with each other.
377 cgReturnDataCon :: DataCon -> [CAddrMode] -> Bool -> StgLiveVars -> Code
379 cgReturnDataCon con amodes all_zero_size_args live_vars
380 = ASSERT(isDataCon con)
381 getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_spa args_spb sequel) ->
385 CaseAlts _ (Just (alts, Just (maybe_deflt_binder, (_,deflt_lbl))))
386 | not (dataConTag con `is_elem` map fst alts)
388 -- Special case! We're returning a constructor to the default case
389 -- of an enclosing case. For example:
391 -- case (case e of (a,b) -> C a b) of
393 -- y -> ...<returning here!>...
396 -- if the default is a non-bind-default (ie does not use y),
397 -- then we should simply jump to the default join point;
399 -- if the default is a bind-default (ie does use y), we
400 -- should return the constructor IN THE HEAP, pointed to by Node,
401 -- **regardless** of the return convention of the constructor C.
403 case maybe_deflt_binder of
405 buildDynCon binder useCurrentCostCentre con amodes all_zero_size_args
407 idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
408 performReturn (move_to_reg amode node) jump_to_join_point live_vars
411 performReturn AbsCNop {- No reg assts -} jump_to_join_point live_vars
413 is_elem = isIn "cgReturnDataCon"
414 jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
415 -- Ignore the sequel: we've already looked at it above
417 other_sequel -> -- The usual case
418 case (dataReturnConvAlg con) of
421 -- BUILD THE OBJECT IN THE HEAP
422 -- The first "con" says that the name bound to this
423 -- closure is "con", which is a bit of a fudge, but it only
424 -- affects profiling (ToDo?)
425 buildDynCon con useCurrentCostCentre con amodes all_zero_size_args
427 idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
429 -- MAKE NODE POINT TO IT
430 let reg_assts = move_to_reg amode node
431 info_lbl = mkInfoTableLabel con
435 profCtrC SLIT("RET_NEW_IN_HEAP") [mkIntCLit (length amodes)] `thenC`
437 performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
441 reg_assts = mkAbstractCs (zipWithEqual move_to_reg amodes regs)
442 info_lbl = mkPhantomInfoTableLabel con
444 profCtrC SLIT("RET_NEW_IN_REGS") [mkIntCLit (length amodes)] `thenC`
446 performReturn reg_assts (mkStaticAlgReturnCode con (Just info_lbl)) live_vars
448 move_to_reg :: CAddrMode -> MagicId -> AbstractC
449 move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode