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 Name ( nameModule, isLocallyDefinedName )
49 import Module ( isDynamicModule )
50 import Const ( Con(..), Literal(..), isLitLitLit )
51 import PrelInfo ( maybeCharLikeCon, maybeIntLikeCon )
52 import PrimRep ( PrimRep(..) )
53 import BasicTypes ( TopLevelFlag(..) )
55 import Panic ( assertPanic, trace )
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)
70 cgTopRhsCon id con args all_zero_size_args
71 = ASSERT(not (any_litlit_args || dynamic_con_or_args))
74 getArgAmodes args `thenFC` \ amodes ->
77 (closure_info, amodes_w_offsets)
78 = layOutStaticClosure name getAmodeRep amodes lf_info
83 closure_label -- Labelled with the name on lhs of defn
84 closure_info -- Closure is static
86 (map fst amodes_w_offsets)) -- Sorted into ptrs first, then nonptrs
91 returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info)
93 con_tycon = dataConTyCon con
94 lf_info = mkConLFInfo con
95 closure_label = mkClosureLabel name
98 top_ccc = mkCCostCentreStack dontCareCCS -- because it's static data
100 -- stuff needed by the assert pred only.
101 any_litlit_args = any isLitLitArg args
102 dynamic_con_or_args = dynamic_con || any (isDynamic) args
104 dynamic_con = isDynName (dataConName con)
107 not (isLocallyDefinedName nm) &&
108 isDynamicModule (nameModule nm)
111 Do any of the arguments refer to something in a DLL?
113 isDynamic (StgVarArg v) = isDynName (idName v)
114 isDynamic (StgConArg c) =
116 DataCon dc -> isDynName (dataConName dc)
117 Literal l -> isLitLitLit l -- all bets are off if it is.
123 %************************************************************************
125 %* non-top-level constructors *
127 %************************************************************************
128 \subsection[code-for-constructors]{The code for constructors}
131 buildDynCon :: Id -- Name of the thing to which this constr will
133 -> CostCentreStack -- Where to grab cost centre from;
134 -- current CCS if currentOrSubsumedCCS
135 -> DataCon -- The data constructor
136 -> [CAddrMode] -- Its args
137 -> Bool -- True <=> all args (if any) are
138 -- of "zero size" (i.e., VoidRep);
139 -- The reason we don't just look at the
140 -- args is that we may be in a "knot", and
141 -- premature looking at the args will cause
142 -- the compiler to black-hole!
143 -> FCode CgIdInfo -- Return details about how to find it
146 First we deal with the case of zero-arity constructors. Now, they
147 will probably be unfolded, so we don't expect to see this case much,
148 if at all, but it does no harm, and sets the scene for characters.
150 In the case of zero-arity constructors, or, more accurately, those
151 which have exclusively size-zero (VoidRep) args, we generate no code
155 buildDynCon binder cc con args all_zero_size_args@True
156 = returnFC (stableAmodeIdInfo binder
157 (CLbl (mkStaticClosureLabel (dataConName con)) PtrRep)
161 Now for @Char@-like closures. We generate an assignment of the
162 address of the closure to a temporary. It would be possible simply to
163 generate no code, and record the addressing mode in the environment,
164 but we'd have to be careful if the argument wasn't a constant --- so
165 for simplicity we just always asssign to a temporary.
167 Last special case: @Int@-like closures. We only special-case the
168 situation in which the argument is a literal in the range
169 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
170 work with any old argument, but for @Int@-like ones the argument has
171 to be a literal. Reason: @Char@ like closures have an argument type
172 which is guaranteed in range.
174 Because of this, we use can safely return an addressing mode.
177 buildDynCon binder cc con [arg_amode] all_zero_size_args@False
179 | maybeCharLikeCon con
180 = absC (CAssign temp_amode (CCharLike arg_amode)) `thenC`
181 returnFC temp_id_info
183 | maybeIntLikeCon con && in_range_int_lit arg_amode
184 = returnFC (stableAmodeIdInfo binder (CIntLike arg_amode) (mkConLFInfo con))
186 (temp_amode, temp_id_info) = newTempAmodeAndIdInfo binder (mkConLFInfo con)
188 in_range_int_lit (CLit (MachInt val _)) = val <= mAX_INTLIKE && val >= mIN_INTLIKE
189 in_range_int_lit other_amode = False
191 tycon = dataConTyCon con
194 Now the general case.
197 buildDynCon binder ccs con args all_zero_size_args@False
198 = allocDynClosure closure_info use_cc blame_cc amodes_w_offsets `thenFC` \ hp_off ->
199 returnFC (heapIdInfo binder hp_off lf_info)
201 (closure_info, amodes_w_offsets)
202 = layOutDynClosure (idName binder) getAmodeRep args lf_info
203 lf_info = mkConLFInfo con
205 use_cc -- cost-centre to stick in the object
206 = if currentOrSubsumedCCS ccs
207 then CReg CurCostCentre
208 else mkCCostCentreStack ccs
210 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
214 %************************************************************************
216 %* constructor-related utility function: *
217 %* bindConArgs is called from cgAlt of a case *
219 %************************************************************************
220 \subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
222 @bindConArgs@ $con args$ augments the environment with bindings for the
223 binders $args$, assuming that we have just returned from a @case@ which
228 :: DataCon -> [Id] -- Constructor and args
232 = ASSERT(not (isUnboxedTupleCon con))
233 mapCs bind_arg args_w_offsets
235 bind_arg (arg, offset) = bindNewToNode arg offset mkLFArgument
236 (_, args_w_offsets) = layOutDynCon con idPrimRep args
239 Unboxed tuples are handled slightly differently - the object is
240 returned in registers and on the stack instead of the heap.
243 bindUnboxedTupleComponents
245 -> FCode ([MagicId], -- regs assigned
246 [(VirtualSpOffset,Int)], -- tag slots
247 Bool) -- any components on stack?
249 bindUnboxedTupleComponents args
250 = -- Assign as many components as possible to registers
251 let (arg_regs, leftovers) = assignRegs [] (map idPrimRep args)
252 (reg_args, stk_args) = splitAt (length arg_regs) args
255 -- Allocate the rest on the stack (ToDo: separate out pointers)
256 getVirtSp `thenFC` \ vsp ->
257 getRealSp `thenFC` \ rsp ->
258 let (top_sp, stk_offsets, tags) =
259 mkTaggedVirtStkOffsets rsp idPrimRep stk_args
262 -- The stack pointer points to the last stack-allocated component
263 setRealAndVirtualSp top_sp `thenC`
265 -- need to explicitly free any empty slots we just jumped over
266 (if vsp < rsp then freeStackSlots [vsp+1 .. rsp] else nopC) `thenC`
268 bindArgsToRegs reg_args arg_regs `thenC`
269 mapCs bindNewToStack stk_offsets `thenC`
270 returnFC (arg_regs,tags, not (null stk_offsets))
273 %************************************************************************
275 \subsubsection[CgRetConv-cgReturnDataCon]{Actually generate code for a constructor return}
277 %************************************************************************
280 Note: it's the responsibility of the @cgReturnDataCon@ caller to be
281 sure the @amodes@ passed don't conflict with each other.
283 cgReturnDataCon :: DataCon -> [CAddrMode] -> Bool -> Code
285 cgReturnDataCon con amodes all_zero_size_args
286 = getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_sp sequel) ->
290 CaseAlts _ (Just (alts, Just (maybe_deflt_binder, (_,deflt_lbl))))
291 | not (dataConTag con `is_elem` map fst alts)
293 -- Special case! We're returning a constructor to the default case
294 -- of an enclosing case. For example:
296 -- case (case e of (a,b) -> C a b) of
298 -- y -> ...<returning here!>...
301 -- if the default is a non-bind-default (ie does not use y),
302 -- then we should simply jump to the default join point;
304 -- if the default is a bind-default (ie does use y), we
305 -- should return the constructor in the heap,
306 -- pointed to by Node.
308 case maybe_deflt_binder of
310 ASSERT(not (isUnboxedTupleCon con))
311 buildDynCon binder currentCCS con amodes all_zero_size_args
313 profCtrC SLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
314 idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
315 performReturn (move_to_reg amode node) jump_to_join_point
318 performReturn AbsCNop {- No reg assts -} jump_to_join_point
320 is_elem = isIn "cgReturnDataCon"
321 jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
322 -- Ignore the sequel: we've already looked at it above
324 other_sequel -- The usual case
326 | isUnboxedTupleCon con ->
327 -- Return unboxed tuple in registers
328 let (ret_regs, leftovers) =
329 assignRegs [] (map getAmodeRep amodes)
331 profCtrC SLIT("TICK_RET_UNBOXED_TUP")
332 [mkIntCLit (length amodes)] `thenC`
334 doTailCall amodes ret_regs
335 mkUnboxedTupleReturnCode
336 (length leftovers) {- fast args arity -}
337 AbsCNop {-no pending assigments-}
338 Nothing {-not a let-no-escape-}
339 False {-node doesn't point-}
342 -- BUILD THE OBJECT IN THE HEAP
343 -- The first "con" says that the name bound to this
344 -- closure is "con", which is a bit of a fudge, but it only
347 -- This Id is also used to get a unique for a
348 -- temporary variable, if the closure is a CHARLIKE.
349 -- funilly enough, this makes the unique always come
351 buildDynCon (mkDataConId con) currentCCS
352 con amodes all_zero_size_args
354 idInfoToAmode PtrRep idinfo `thenFC` \ amode ->
358 profCtrC SLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
359 -- could use doTailCall here.
360 performReturn (move_to_reg amode node)
361 (mkStaticAlgReturnCode con)
364 con_name = dataConName con
366 move_to_reg :: CAddrMode -> MagicId -> AbstractC
367 move_to_reg src_amode dest_reg = CAssign (CReg dest_reg) src_amode