1 -----------------------------------------------------------------------------
3 -- Stg to C--: code generation for constructors
5 -- This module provides the support code for StgCmm to deal with with
6 -- constructors on the RHSs of let(rec)s.
8 -- (c) The University of Glasgow 2004-2006
10 -----------------------------------------------------------------------------
13 cgTopRhsCon, buildDynCon, bindConArgs
16 #include "HsVersions.h"
19 import CoreSyn ( AltCon(..) )
30 import MkZipCfgCmm (CmmAGraph, mkNop)
40 import Util ( lengthIs )
44 ---------------------------------------------------------------
45 -- Top-level constructors
46 ---------------------------------------------------------------
48 cgTopRhsCon :: Id -- Name of thing bound to this RHS
52 cgTopRhsCon id con args
55 -- Windows DLLs have a problem with static cross-DLL refs.
56 ; this_pkg <- getThisPackage
57 ; ASSERT( not (isDllConApp this_pkg con args) ) return ()
59 ; ASSERT( args `lengthIs` dataConRepArity con ) return ()
64 lf_info = mkConLFInfo con
65 closure_label = mkClosureLabel name $ idCafInfo id
66 caffy = any stgArgHasCafRefs args
67 (closure_info, nv_args_w_offsets)
68 = layOutStaticConstr con (addArgReps args)
70 get_lit (arg, _offset) = do { CmmLit lit <- getArgAmode arg
73 ; payload <- mapM get_lit nv_args_w_offsets
74 -- NB1: nv_args_w_offsets is sorted into ptrs then non-ptrs
75 -- NB2: all the amodes should be Lits!
77 ; let closure_rep = mkStaticClosureFields
79 dontCareCCS -- Because it's static data
84 ; emitDataLits closure_label closure_rep
87 ; return $ litIdInfo id lf_info (CmmLabel closure_label) }
90 ---------------------------------------------------------------
91 -- Lay out and allocate non-top-level constructors
92 ---------------------------------------------------------------
94 buildDynCon :: Id -- Name of the thing to which this constr will
96 -> CostCentreStack -- Where to grab cost centre from;
97 -- current CCS if currentOrSubsumedCCS
98 -> DataCon -- The data constructor
99 -> [StgArg] -- Its args
100 -> FCode (CgIdInfo, CmmAGraph)
101 -- Return details about how to find it and initialization code
103 {- We used to pass a boolean indicating whether all the
104 args were of size zero, so we could use a static
105 construtor; but I concluded that it just isn't worth it.
106 Now I/O uses unboxed tuples there just aren't any constructors
107 with all size-zero args.
109 The reason for having a separate argument, rather than looking at
110 the addr modes of the args is that we may be in a "knot", and
111 premature looking at the args will cause the compiler to black-hole!
115 -------- buildDynCon: Nullary constructors --------------
116 -- First we deal with the case of zero-arity constructors. They
117 -- will probably be unfolded, so we don't expect to see this case much,
118 -- if at all, but it does no harm, and sets the scene for characters.
120 -- In the case of zero-arity constructors, or, more accurately, those
121 -- which have exclusively size-zero (VoidRep) args, we generate no code
124 buildDynCon binder _cc con []
125 = return (litIdInfo binder (mkConLFInfo con)
126 (CmmLabel (mkClosureLabel (dataConName con) (idCafInfo binder))),
129 -------- buildDynCon: Charlike and Intlike constructors -----------
130 {- The following three paragraphs about @Char@-like and @Int@-like
131 closures are obsolete, but I don't understand the details well enough
132 to properly word them, sorry. I've changed the treatment of @Char@s to
133 be analogous to @Int@s: only a subset is preallocated, because @Char@
134 has now 31 bits. Only literals are handled here. -- Qrczak
136 Now for @Char@-like closures. We generate an assignment of the
137 address of the closure to a temporary. It would be possible simply to
138 generate no code, and record the addressing mode in the environment,
139 but we'd have to be careful if the argument wasn't a constant --- so
140 for simplicity we just always asssign to a temporary.
142 Last special case: @Int@-like closures. We only special-case the
143 situation in which the argument is a literal in the range
144 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
145 work with any old argument, but for @Int@-like ones the argument has
146 to be a literal. Reason: @Char@ like closures have an argument type
147 which is guaranteed in range.
149 Because of this, we use can safely return an addressing mode. -}
151 buildDynCon binder _cc con [arg]
152 | maybeIntLikeCon con
153 , StgLitArg (MachInt val) <- arg
154 , val <= fromIntegral mAX_INTLIKE -- Comparisons at type Integer!
155 , val >= fromIntegral mIN_INTLIKE -- ...ditto...
156 = do { let intlike_lbl = mkRtsGcPtrLabel (sLit "stg_INTLIKE_closure")
157 val_int = fromIntegral val :: Int
158 offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1)
159 -- INTLIKE closures consist of a header and one word payload
160 intlike_amode = cmmLabelOffW intlike_lbl offsetW
161 ; return (litIdInfo binder (mkConLFInfo con) intlike_amode, mkNop) }
163 buildDynCon binder _cc con [arg]
164 | maybeCharLikeCon con
165 , StgLitArg (MachChar val) <- arg
166 , let val_int = ord val :: Int
167 , val_int <= mAX_CHARLIKE
168 , val_int >= mIN_CHARLIKE
169 = do { let charlike_lbl = mkRtsGcPtrLabel (sLit "stg_CHARLIKE_closure")
170 offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize + 1)
171 -- CHARLIKE closures consist of a header and one word payload
172 charlike_amode = cmmLabelOffW charlike_lbl offsetW
173 ; return (litIdInfo binder (mkConLFInfo con) charlike_amode, mkNop) }
175 -------- buildDynCon: the general case -----------
176 buildDynCon binder ccs con args
177 = do { let (cl_info, args_w_offsets) = layOutDynConstr con (addArgReps args)
178 -- No void args in args_w_offsets
179 ; (tmp, init) <- allocDynClosure cl_info use_cc blame_cc args_w_offsets
180 ; return (regIdInfo binder lf_info tmp, init) }
182 lf_info = mkConLFInfo con
184 use_cc -- cost-centre to stick in the object
185 | currentOrSubsumedCCS ccs = curCCS
186 | otherwise = CmmLit (mkCCostCentreStack ccs)
188 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
191 ---------------------------------------------------------------
192 -- Binding constructor arguments
193 ---------------------------------------------------------------
195 bindConArgs :: AltCon -> LocalReg -> [Id] -> FCode [LocalReg]
196 -- bindConArgs is called from cgAlt of a case
197 -- (bindConArgs con args) augments the environment with bindings for the
198 -- binders args, assuming that we have just returned from a 'case' which
200 bindConArgs (DataAlt con) base args
201 = ASSERT(not (isUnboxedTupleCon con))
202 mapM bind_arg args_w_offsets
204 (_, args_w_offsets) = layOutDynConstr con (addIdReps args)
208 -- The binding below forces the masking out of the tag bits
209 -- when accessing the constructor field.
210 bind_arg :: (NonVoid Id, VirtualHpOffset) -> FCode LocalReg
211 bind_arg (arg, offset)
212 = do { emit $ mkTaggedObjectLoad (idToReg arg) base offset tag
215 bindConArgs _other_con _base args
216 = ASSERT( null args ) return []