never executed always true always false
1
2
3 -----------------------------------------------------------------------------
4 --
5 -- Stg to C--: code generation for constructors
6 --
7 -- This module provides the support code for StgToCmm to deal with
8 -- constructors on the RHSs of let(rec)s.
9 --
10 -- (c) The University of Glasgow 2004-2006
11 --
12 -----------------------------------------------------------------------------
13
14 module GHC.StgToCmm.DataCon (
15 cgTopRhsCon, buildDynCon, bindConArgs
16 ) where
17
18 import GHC.Prelude
19
20 import GHC.Platform
21 import GHC.Platform.Profile
22
23 import GHC.Stg.Syntax
24 import GHC.Core ( AltCon(..) )
25
26 import GHC.StgToCmm.Monad
27 import GHC.StgToCmm.Env
28 import GHC.StgToCmm.Heap
29 import GHC.StgToCmm.Layout
30 import GHC.StgToCmm.Utils
31 import GHC.StgToCmm.Closure
32
33 import GHC.Cmm.Expr
34 import GHC.Cmm.Utils
35 import GHC.Cmm.CLabel
36 import GHC.Cmm.Graph
37 import GHC.Runtime.Heap.Layout
38 import GHC.Types.CostCentre
39 import GHC.Unit
40 import GHC.Core.DataCon
41 import GHC.Driver.Session
42 import GHC.Data.FastString
43 import GHC.Types.Id
44 import GHC.Types.Id.Info( CafInfo( NoCafRefs ) )
45 import GHC.Types.Name (isInternalName)
46 import GHC.Types.RepType (countConRepArgs)
47 import GHC.Types.Literal
48 import GHC.Builtin.Utils
49 import GHC.Utils.Panic
50 import GHC.Utils.Panic.Plain
51 import GHC.Utils.Misc
52 import GHC.Utils.Monad (mapMaybeM)
53
54 import Control.Monad
55 import Data.Char
56
57 ---------------------------------------------------------------
58 -- Top-level constructors
59 ---------------------------------------------------------------
60
61 cgTopRhsCon :: DynFlags
62 -> Id -- Name of thing bound to this RHS
63 -> DataCon -- Id
64 -> ConstructorNumber
65 -> [NonVoid StgArg] -- Args
66 -> (CgIdInfo, FCode ())
67 cgTopRhsCon dflags id con mn args
68 | Just static_info <- precomputedStaticConInfo_maybe dflags id con args
69 , let static_code | isInternalName name = pure ()
70 | otherwise = gen_code
71 = -- There is a pre-allocated static closure available; use it
72 -- See Note [Precomputed static closures].
73 -- For External bindings we must keep the binding,
74 -- since importing modules will refer to it by name;
75 -- but for Internal ones we can drop it altogether
76 -- See Note [About the NameSorts] in "GHC.Types.Name" for Internal/External
77 (static_info, static_code)
78
79 -- Otherwise generate a closure for the constructor.
80 | otherwise
81 = (id_Info, gen_code)
82
83 where
84 platform = targetPlatform dflags
85 id_Info = litIdInfo platform id (mkConLFInfo con) (CmmLabel closure_label)
86 name = idName id
87 caffy = idCafInfo id -- any stgArgHasCafRefs args
88 closure_label = mkClosureLabel name caffy
89
90 gen_code =
91 do { profile <- getProfile
92 ; this_mod <- getModuleName
93 ; when (platformOS platform == OSMinGW32) $
94 -- Windows DLLs have a problem with static cross-DLL refs.
95 massert (not (isDllConApp dflags this_mod con (map fromNonVoid args)))
96 ; assert (args `lengthIs` countConRepArgs con ) return ()
97
98 -- LAY IT OUT
99 ; let
100 (tot_wds, -- #ptr_wds + #nonptr_wds
101 ptr_wds, -- #ptr_wds
102 nv_args_w_offsets) =
103 mkVirtHeapOffsetsWithPadding profile StdHeader (addArgReps args)
104
105 ; let
106 -- Decompose padding into units of length 8, 4, 2, or 1 bytes to
107 -- allow the implementation of mk_payload to use widthFromBytes,
108 -- which only handles these cases.
109 fix_padding (x@(Padding n off) : rest)
110 | n == 0 = fix_padding rest
111 | n `elem` [1,2,4,8] = x : fix_padding rest
112 | n > 8 = add_pad 8
113 | n > 4 = add_pad 4
114 | n > 2 = add_pad 2
115 | otherwise = add_pad 1
116 where add_pad m = Padding m off : fix_padding (Padding (n-m) (off+m) : rest)
117 fix_padding (x : rest) = x : fix_padding rest
118 fix_padding [] = []
119
120 mk_payload (Padding len _) = return (CmmInt 0 (widthFromBytes len))
121 mk_payload (FieldOff arg _) = do
122 amode <- getArgAmode arg
123 case amode of
124 CmmLit lit -> return lit
125 _ -> panic "GHC.StgToCmm.DataCon.cgTopRhsCon"
126
127 nonptr_wds = tot_wds - ptr_wds
128
129 -- we're not really going to emit an info table, so having
130 -- to make a CmmInfoTable is a bit overkill, but mkStaticClosureFields
131 -- needs to poke around inside it.
132 info_tbl = mkDataConInfoTable profile con (addModuleLoc this_mod mn) True ptr_wds nonptr_wds
133
134
135 ; payload <- mapM mk_payload (fix_padding nv_args_w_offsets)
136 -- NB1: nv_args_w_offsets is sorted into ptrs then non-ptrs
137 -- NB2: all the amodes should be Lits!
138 -- TODO (osa): Why?
139
140 -- BUILD THE OBJECT
141 --
142 -- We're generating info tables, so we don't know and care about
143 -- what the actual arguments are. Using () here as the place holder.
144
145 ; emitDataCon closure_label info_tbl dontCareCCS payload }
146
147 addModuleLoc :: Module -> ConstructorNumber -> ConInfoTableLocation
148 addModuleLoc this_mod mn = do
149 case mn of
150 NoNumber -> DefinitionSite
151 Numbered n -> UsageSite this_mod n
152
153 ---------------------------------------------------------------
154 -- Lay out and allocate non-top-level constructors
155 ---------------------------------------------------------------
156
157 buildDynCon :: Id -- Name of the thing to which this constr will
158 -- be bound
159 -> ConstructorNumber
160 -> Bool -- is it genuinely bound to that name, or just
161 -- for profiling?
162 -> CostCentreStack -- Where to grab cost centre from;
163 -- current CCS if currentOrSubsumedCCS
164 -> DataCon -- The data constructor
165 -> [NonVoid StgArg] -- Its args
166 -> FCode (CgIdInfo, FCode CmmAGraph)
167 -- Return details about how to find it and initialization code
168 buildDynCon binder mn actually_bound cc con args
169 = do dflags <- getDynFlags
170 buildDynCon' dflags binder mn actually_bound cc con args
171
172
173 buildDynCon' :: DynFlags
174 -> Id -> ConstructorNumber
175 -> Bool
176 -> CostCentreStack
177 -> DataCon
178 -> [NonVoid StgArg]
179 -> FCode (CgIdInfo, FCode CmmAGraph)
180
181 {- We used to pass a boolean indicating whether all the
182 args were of size zero, so we could use a static
183 constructor; but I concluded that it just isn't worth it.
184 Now I/O uses unboxed tuples there just aren't any constructors
185 with all size-zero args.
186
187 The reason for having a separate argument, rather than looking at
188 the addr modes of the args is that we may be in a "knot", and
189 premature looking at the args will cause the compiler to black-hole!
190 -}
191
192 buildDynCon' dflags binder _ _ _cc con args
193 | Just cgInfo <- precomputedStaticConInfo_maybe dflags binder con args
194 -- , pprTrace "noCodeLocal:" (ppr (binder,con,args,cgInfo)) True
195 = return (cgInfo, return mkNop)
196
197 -------- buildDynCon': the general case -----------
198 buildDynCon' _ binder mn actually_bound ccs con args
199 = do { (id_info, reg) <- rhsIdInfo binder lf_info
200 ; return (id_info, gen_code reg)
201 }
202 where
203 lf_info = mkConLFInfo con
204
205 gen_code reg
206 = do { modu <- getModuleName
207 ; profile <- getProfile
208 ; let platform = profilePlatform profile
209 (tot_wds, ptr_wds, args_w_offsets)
210 = mkVirtConstrOffsets profile (addArgReps args)
211 nonptr_wds = tot_wds - ptr_wds
212 info_tbl = mkDataConInfoTable profile con (addModuleLoc modu mn) False
213 ptr_wds nonptr_wds
214 ; let ticky_name | actually_bound = Just binder
215 | otherwise = Nothing
216
217 ; hp_plus_n <- allocDynClosure ticky_name info_tbl lf_info
218 use_cc blame_cc args_w_offsets
219 ; return (mkRhsInit platform reg lf_info hp_plus_n) }
220 where
221 use_cc -- cost-centre to stick in the object
222 | isCurrentCCS ccs = cccsExpr
223 | otherwise = panic "buildDynCon: non-current CCS not implemented"
224
225 blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
226
227 {- Note [Precomputed static closures]
228 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
229
230 For Char/Int closures there are some value closures
231 built into the RTS. This is the case for all values in
232 the range mINT_INTLIKE .. mAX_INTLIKE (or CHARLIKE).
233 See Note [CHARLIKE and INTLIKE closures.] in the RTS code.
234
235 Similarly zero-arity constructors have a closure
236 in their defining Module we can use.
237
238 If possible we prefer to refer to those existing
239 closure instead of building new ones.
240
241 This is true at compile time where we do this replacement
242 in this module.
243 But also at runtime where the GC does the same (but only for
244 INT/CHAR closures).
245
246 `precomputedStaticConInfo_maybe` checks if a given constructor application
247 can be replaced with a reference to a existing static closure.
248
249 If so the code will reference the existing closure when accessing
250 the binding.
251 Unless the binding is visible to other modules we also generate
252 no code for the binding itself. We can do this since then we can
253 always reference the existing closure.
254
255 See Note [About the NameSorts] for the definition of external names.
256 For external bindings we must still generate a closure,
257 but won't use it inside this module.
258 This can sometimes reduce cache pressure. Since:
259 * If somebody uses the exported binding:
260 + This module will reference the existing closure.
261 + GC will reference the existing closure.
262 + The importing module will reference the built closure.
263 * If nobody uses the exported binding:
264 + This module will reference the RTS closures.
265 + GC references the RTS closures
266
267 In the later case we avoided loading the built closure into the cache which
268 is what we optimize for here.
269
270 Consider this example using Ints.
271
272 module M(externalInt, foo, bar) where
273
274 externalInt = 1 :: Int
275 internalInt = 1 :: Int
276 { -# NOINLINE foo #- }
277 foo = Just internalInt :: Maybe Int
278 bar = Just externalInt
279
280 ==================== STG: ====================
281 externalInt = I#! [1#];
282
283 bar = Just! [externalInt];
284
285 internalInt_rc = I#! [2#];
286
287 foo = Just! [internalInt_rc];
288
289 For externally visible bindings we must generate closures
290 since those may be referenced by their symbol `<name>_closure`
291 when imported.
292
293 `externalInt` is visible to other modules so we generate a closure:
294
295 [section ""data" . M.externalInt_closure" {
296 M.externalInt_closure:
297 const GHC.Types.I#_con_info;
298 const 1;
299 }]
300
301 It will be referenced inside this module via `M.externalInt_closure+1`
302
303 `internalInt` is however a internal name. As such we generate no code for
304 it. References to it are replaced with references to the static closure as
305 we can see in the closure built for `foo`:
306
307 [section ""data" . M.foo_closure" {
308 M.foo_closure:
309 const GHC.Maybe.Just_con_info;
310 const stg_INTLIKE_closure+289; // == I# 2
311 const 3;
312 }]
313
314 This holds for both local and top level bindings.
315
316 We don't support this optimization when compiling into Windows DLLs yet
317 because they don't support cross package data references well.
318 -}
319
320 -- (precomputedStaticConInfo_maybe dflags id con args)
321 -- returns (Just cg_id_info)
322 -- if there is a precomputed static closure for (con args).
323 -- In that case, cg_id_info addresses it.
324 -- See Note [Precomputed static closures]
325 precomputedStaticConInfo_maybe :: DynFlags -> Id -> DataCon -> [NonVoid StgArg] -> Maybe CgIdInfo
326 precomputedStaticConInfo_maybe dflags binder con []
327 -- Nullary constructors
328 | isNullaryRepDataCon con
329 = Just $ litIdInfo (targetPlatform dflags) binder (mkConLFInfo con)
330 (CmmLabel (mkClosureLabel (dataConName con) NoCafRefs))
331 precomputedStaticConInfo_maybe dflags binder con [arg]
332 -- Int/Char values with existing closures in the RTS
333 | intClosure || charClosure
334 , platformOS platform /= OSMinGW32 || not (positionIndependent dflags)
335 , Just val <- getClosurePayload arg
336 , inRange val
337 = let intlike_lbl = mkCmmClosureLabel rtsUnitId (fsLit label)
338 val_int = fromIntegral val :: Int
339 offsetW = (val_int - (fromIntegral min_static_range)) * (fixedHdrSizeW profile + 1)
340 -- INTLIKE/CHARLIKE closures consist of a header and one word payload
341 static_amode = cmmLabelOffW platform intlike_lbl offsetW
342 in Just $ litIdInfo platform binder (mkConLFInfo con) static_amode
343 where
344 profile = targetProfile dflags
345 platform = profilePlatform profile
346 intClosure = maybeIntLikeCon con
347 charClosure = maybeCharLikeCon con
348 getClosurePayload (NonVoid (StgLitArg (LitNumber LitNumInt val))) = Just val
349 getClosurePayload (NonVoid (StgLitArg (LitChar val))) = Just $ (fromIntegral . ord $ val)
350 getClosurePayload _ = Nothing
351 -- Avoid over/underflow by comparisons at type Integer!
352 inRange :: Integer -> Bool
353 inRange val
354 = val >= min_static_range && val <= max_static_range
355
356 constants = platformConstants platform
357
358 min_static_range :: Integer
359 min_static_range
360 | intClosure = fromIntegral (pc_MIN_INTLIKE constants)
361 | charClosure = fromIntegral (pc_MIN_CHARLIKE constants)
362 | otherwise = panic "precomputedStaticConInfo_maybe: Unknown closure type"
363 max_static_range
364 | intClosure = fromIntegral (pc_MAX_INTLIKE constants)
365 | charClosure = fromIntegral (pc_MAX_CHARLIKE constants)
366 | otherwise = panic "precomputedStaticConInfo_maybe: Unknown closure type"
367 label
368 | intClosure = "stg_INTLIKE"
369 | charClosure = "stg_CHARLIKE"
370 | otherwise = panic "precomputedStaticConInfo_maybe: Unknown closure type"
371
372 precomputedStaticConInfo_maybe _ _ _ _ = Nothing
373
374 ---------------------------------------------------------------
375 -- Binding constructor arguments
376 ---------------------------------------------------------------
377
378 bindConArgs :: AltCon -> LocalReg -> [NonVoid Id] -> FCode [LocalReg]
379 -- bindConArgs is called from cgAlt of a case
380 -- (bindConArgs con args) augments the environment with bindings for the
381 -- binders args, assuming that we have just returned from a 'case' which
382 -- found a con
383 bindConArgs (DataAlt con) base args
384 = assert (not (isUnboxedTupleDataCon con)) $
385 do profile <- getProfile
386 platform <- getPlatform
387 let (_, _, args_w_offsets) = mkVirtConstrOffsets profile (addIdReps args)
388 tag = tagForCon platform con
389
390 -- The binding below forces the masking out of the tag bits
391 -- when accessing the constructor field.
392 bind_arg :: (NonVoid Id, ByteOff) -> FCode (Maybe LocalReg)
393 bind_arg (arg@(NonVoid b), offset)
394 | isDeadBinder b -- See Note [Dead-binder optimisation] in GHC.StgToCmm.Expr
395 = return Nothing
396 | otherwise
397 = do { emit $ mkTaggedObjectLoad platform (idToReg platform arg)
398 base offset tag
399 ; Just <$> bindArgToReg arg }
400
401 mapMaybeM bind_arg args_w_offsets
402
403 bindConArgs _other_con _base args
404 = assert (null args ) return []