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(..) )
41 import Util ( lengthIs )
45 #if defined(mingw32_TARGET_OS)
46 import StaticFlags ( opt_PIC )
50 ---------------------------------------------------------------
51 -- Top-level constructors
52 ---------------------------------------------------------------
54 cgTopRhsCon :: Id -- Name of thing bound to this RHS
58 cgTopRhsCon id con args
61 -- Windows DLLs have a problem with static cross-DLL refs.
62 ; this_pkg <- getThisPackage
63 ; ASSERT( not (isDllConApp this_pkg con args) ) return ()
65 ; ASSERT( args `lengthIs` dataConRepArity con ) return ()
70 lf_info = mkConLFInfo con
71 closure_label = mkClosureLabel name $ idCafInfo id
72 caffy = any stgArgHasCafRefs args
73 (closure_info, nv_args_w_offsets)
74 = layOutStaticConstr con (addArgReps args)
76 get_lit (arg, _offset) = do { CmmLit lit <- getArgAmode arg
79 ; payload <- mapM get_lit nv_args_w_offsets
80 -- NB1: nv_args_w_offsets is sorted into ptrs then non-ptrs
81 -- NB2: all the amodes should be Lits!
83 ; let closure_rep = mkStaticClosureFields
85 dontCareCCS -- Because it's static data
90 ; emitDataLits closure_label closure_rep
93 ; return $ litIdInfo id lf_info (CmmLabel closure_label) }
96 ---------------------------------------------------------------
97 -- Lay out and allocate non-top-level constructors
98 ---------------------------------------------------------------
100 buildDynCon :: Id -- Name of the thing to which this constr will
102 -> CostCentreStack -- Where to grab cost centre from;
103 -- current CCS if currentOrSubsumedCCS
104 -> DataCon -- The data constructor
105 -> [StgArg] -- Its args
106 -> FCode (CgIdInfo, CmmAGraph)
107 -- Return details about how to find it and initialization code
109 {- We used to pass a boolean indicating whether all the
110 args were of size zero, so we could use a static
111 construtor; but I concluded that it just isn't worth it.
112 Now I/O uses unboxed tuples there just aren't any constructors
113 with all size-zero args.
115 The reason for having a separate argument, rather than looking at
116 the addr modes of the args is that we may be in a "knot", and
117 premature looking at the args will cause the compiler to black-hole!
121 -------- buildDynCon: Nullary constructors --------------
122 -- First we deal with the case of zero-arity constructors. They
123 -- will probably be unfolded, so we don't expect to see this case much,
124 -- if at all, but it does no harm, and sets the scene for characters.
126 -- In the case of zero-arity constructors, or, more accurately, those
127 -- which have exclusively size-zero (VoidRep) args, we generate no code
130 buildDynCon binder _cc con []
131 = return (litIdInfo binder (mkConLFInfo con)
132 (CmmLabel (mkClosureLabel (dataConName con) (idCafInfo binder))),
135 -------- buildDynCon: Charlike and Intlike constructors -----------
136 {- The following three paragraphs about @Char@-like and @Int@-like
137 closures are obsolete, but I don't understand the details well enough
138 to properly word them, sorry. I've changed the treatment of @Char@s to
139 be analogous to @Int@s: only a subset is preallocated, because @Char@
140 has now 31 bits. Only literals are handled here. -- Qrczak
142 Now for @Char@-like closures. We generate an assignment of the
143 address of the closure to a temporary. It would be possible simply to
144 generate no code, and record the addressing mode in the environment,
145 but we'd have to be careful if the argument wasn't a constant --- so
146 for simplicity we just always asssign to a temporary.
148 Last special case: @Int@-like closures. We only special-case the
149 situation in which the argument is a literal in the range
150 @mIN_INTLIKE@..@mAX_INTLILKE@. NB: for @Char@-like closures we can
151 work with any old argument, but for @Int@-like ones the argument has
152 to be a literal. Reason: @Char@ like closures have an argument type
153 which is guaranteed in range.
155 Because of this, we use can safely return an addressing mode.
157 We don't support this optimisation when compiling into Windows DLLs yet
158 because they don't support cross package data references well.
161 buildDynCon binder _cc con [arg]
162 | maybeIntLikeCon con
163 #if defined(mingw32_TARGET_OS)
166 , StgLitArg (MachInt val) <- arg
167 , val <= fromIntegral mAX_INTLIKE -- Comparisons at type Integer!
168 , val >= fromIntegral mIN_INTLIKE -- ...ditto...
169 = do { let intlike_lbl = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_INTLIKE_closure")
170 val_int = fromIntegral val :: Int
171 offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1)
172 -- INTLIKE closures consist of a header and one word payload
173 intlike_amode = cmmLabelOffW intlike_lbl offsetW
174 ; return (litIdInfo binder (mkConLFInfo con) intlike_amode, mkNop) }
176 buildDynCon binder _cc con [arg]
177 | maybeCharLikeCon con
178 #if defined(mingw32_TARGET_OS)
181 , StgLitArg (MachChar val) <- arg
182 , let val_int = ord val :: Int
183 , val_int <= mAX_CHARLIKE
184 , val_int >= mIN_CHARLIKE
185 = do { let charlike_lbl = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_CHARLIKE_closure")
186 offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize + 1)
187 -- CHARLIKE closures consist of a header and one word payload
188 charlike_amode = cmmLabelOffW charlike_lbl offsetW
189 ; return (litIdInfo binder (mkConLFInfo con) charlike_amode, mkNop) }
191 -------- buildDynCon: the general case -----------
192 buildDynCon binder ccs con args
193 = do { let (cl_info, args_w_offsets) = layOutDynConstr con (addArgReps args)
194 -- No void args in args_w_offsets
195 ; (tmp, init) <- allocDynClosure cl_info use_cc blame_cc args_w_offsets
196 ; regIdInfo binder lf_info tmp init }
198 lf_info = mkConLFInfo con
200 use_cc -- cost-centre to stick in the object
201 | currentOrSubsumedCCS ccs = curCCS
202 | otherwise = CmmLit (mkCCostCentreStack ccs)
204 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
207 ---------------------------------------------------------------
208 -- Binding constructor arguments
209 ---------------------------------------------------------------
211 bindConArgs :: AltCon -> LocalReg -> [Id] -> FCode [LocalReg]
212 -- bindConArgs is called from cgAlt of a case
213 -- (bindConArgs con args) augments the environment with bindings for the
214 -- binders args, assuming that we have just returned from a 'case' which
216 bindConArgs (DataAlt con) base args
217 = ASSERT(not (isUnboxedTupleCon con))
218 mapM bind_arg args_w_offsets
220 (_, args_w_offsets) = layOutDynConstr con (addIdReps args)
224 -- The binding below forces the masking out of the tag bits
225 -- when accessing the constructor field.
226 bind_arg :: (NonVoid Id, VirtualHpOffset) -> FCode LocalReg
227 bind_arg (arg, offset)
228 = do { emit $ mkTaggedObjectLoad (idToReg arg) base offset tag
231 bindConArgs _other_con _base args
232 = ASSERT( null args ) return []