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