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