never executed always true always false
1
2 {-# LANGUAGE RecordWildCards #-}
3 {-# LANGUAGE LambdaCase #-}
4 {-# LANGUAGE MultiParamTypeClasses #-}
5 {-# LANGUAGE FlexibleInstances #-}
6
7
8 -----------------------------------------------------------------------------
9 --
10 -- Stg to C-- code generation:
11 --
12 -- The types LambdaFormInfo
13 -- ClosureInfo
14 --
15 -- Nothing monadic in here!
16 --
17 -----------------------------------------------------------------------------
18
19 module GHC.StgToCmm.Closure (
20 DynTag, tagForCon, isSmallFamily,
21
22 idPrimRep, isVoidRep, isGcPtrRep, addIdReps, addArgReps,
23 argPrimRep,
24
25 NonVoid(..), fromNonVoid, nonVoidIds, nonVoidStgArgs,
26 assertNonVoidIds, assertNonVoidStgArgs,
27
28 -- * LambdaFormInfo
29 LambdaFormInfo, -- Abstract
30 StandardFormInfo, -- ...ditto...
31 mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,
32 mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
33 mkLFStringLit,
34 lfDynTag,
35 isLFThunk, isLFReEntrant, lfUpdatable,
36
37 -- * Used by other modules
38 CgLoc(..), SelfLoopInfo, CallMethod(..),
39 nodeMustPointToIt, isKnownFun, funTag, tagForArity,
40 CallOpts(..), getCallMethod,
41
42 -- * ClosureInfo
43 ClosureInfo,
44 mkClosureInfo,
45 mkCmmInfo,
46
47 -- ** Inspection
48 closureLFInfo, closureName,
49
50 -- ** Labels
51 -- These just need the info table label
52 closureInfoLabel, staticClosureLabel,
53 closureSlowEntryLabel, closureLocalEntryLabel,
54
55 -- ** Predicates
56 -- These are really just functions on LambdaFormInfo
57 closureUpdReqd,
58 closureReEntrant, closureFunInfo,
59 isToplevClosure,
60
61 blackHoleOnEntry, -- Needs LambdaFormInfo and SMRep
62 isStaticClosure, -- Needs SMPre
63
64 -- * InfoTables
65 mkDataConInfoTable,
66 cafBlackHoleInfoTable,
67 indStaticInfoTable,
68 staticClosureNeedsLink,
69 ) where
70
71 import GHC.Prelude
72 import GHC.Platform
73 import GHC.Platform.Profile
74
75 import GHC.Stg.Syntax
76 import GHC.Runtime.Heap.Layout
77 import GHC.Cmm
78 import GHC.Cmm.Utils
79 import GHC.Cmm.Ppr.Expr() -- For Outputable instances
80 import GHC.StgToCmm.Types
81
82 import GHC.Types.CostCentre
83 import GHC.Cmm.BlockId
84 import GHC.Cmm.CLabel
85 import GHC.Types.Id
86 import GHC.Types.Id.Info
87 import GHC.Core.DataCon
88 import GHC.Types.Name
89 import GHC.Core.Type
90 import GHC.Core.TyCo.Rep
91 import GHC.Tc.Utils.TcType
92 import GHC.Core.TyCon
93 import GHC.Types.RepType
94 import GHC.Types.Basic
95 import GHC.Utils.Outputable
96 import GHC.Utils.Panic
97 import GHC.Utils.Panic.Plain
98 import GHC.Utils.Misc
99
100 import Data.Coerce (coerce)
101 import qualified Data.ByteString.Char8 as BS8
102
103 -----------------------------------------------------------------------------
104 -- Data types and synonyms
105 -----------------------------------------------------------------------------
106
107 -- These data types are mostly used by other modules, especially
108 -- GHC.StgToCmm.Monad, but we define them here because some functions in this
109 -- module need to have access to them as well
110
111 data CgLoc
112 = CmmLoc CmmExpr -- A stable CmmExpr; that is, one not mentioning
113 -- Hp, so that it remains valid across calls
114
115 | LneLoc BlockId [LocalReg] -- A join point
116 -- A join point (= let-no-escape) should only
117 -- be tail-called, and in a saturated way.
118 -- To tail-call it, assign to these locals,
119 -- and branch to the block id
120
121 instance OutputableP Platform CgLoc where
122 pdoc = pprCgLoc
123
124 pprCgLoc :: Platform -> CgLoc -> SDoc
125 pprCgLoc platform = \case
126 CmmLoc e -> text "cmm" <+> pdoc platform e
127 LneLoc b rs -> text "lne" <+> ppr b <+> ppr rs
128
129 type SelfLoopInfo = (Id, BlockId, [LocalReg])
130
131 -- used by ticky profiling
132 isKnownFun :: LambdaFormInfo -> Bool
133 isKnownFun LFReEntrant{} = True
134 isKnownFun LFLetNoEscape = True
135 isKnownFun _ = False
136
137
138 -------------------------------------
139 -- Non-void types
140 -------------------------------------
141 -- We frequently need the invariant that an Id or a an argument
142 -- is of a non-void type. This type is a witness to the invariant.
143
144 newtype NonVoid a = NonVoid a
145 deriving (Eq, Show)
146
147 fromNonVoid :: NonVoid a -> a
148 fromNonVoid (NonVoid a) = a
149
150 instance (Outputable a) => Outputable (NonVoid a) where
151 ppr (NonVoid a) = ppr a
152
153 nonVoidIds :: [Id] -> [NonVoid Id]
154 nonVoidIds ids = [NonVoid id | id <- ids, not (isVoidTy (idType id))]
155
156 -- | Used in places where some invariant ensures that all these Ids are
157 -- non-void; e.g. constructor field binders in case expressions.
158 -- See Note [Post-unarisation invariants] in "GHC.Stg.Unarise".
159 assertNonVoidIds :: [Id] -> [NonVoid Id]
160 assertNonVoidIds ids = assert (not (any (isVoidTy . idType) ids)) $
161 coerce ids
162
163 nonVoidStgArgs :: [StgArg] -> [NonVoid StgArg]
164 nonVoidStgArgs args = [NonVoid arg | arg <- args, not (isVoidTy (stgArgType arg))]
165
166 -- | Used in places where some invariant ensures that all these arguments are
167 -- non-void; e.g. constructor arguments.
168 -- See Note [Post-unarisation invariants] in "GHC.Stg.Unarise".
169 assertNonVoidStgArgs :: [StgArg] -> [NonVoid StgArg]
170 assertNonVoidStgArgs args = assert (not (any (isVoidTy . stgArgType) args)) $
171 coerce args
172
173
174 -----------------------------------------------------------------------------
175 -- Representations
176 -----------------------------------------------------------------------------
177
178 -- Why are these here?
179
180 -- | Assumes that there is precisely one 'PrimRep' of the type. This assumption
181 -- holds after unarise.
182 -- See Note [Post-unarisation invariants]
183 idPrimRep :: Id -> PrimRep
184 idPrimRep id = typePrimRep1 (idType id)
185 -- See also Note [VoidRep] in GHC.Types.RepType
186
187 -- | Assumes that Ids have one PrimRep, which holds after unarisation.
188 -- See Note [Post-unarisation invariants]
189 addIdReps :: [NonVoid Id] -> [NonVoid (PrimRep, Id)]
190 addIdReps = map (\id -> let id' = fromNonVoid id
191 in NonVoid (idPrimRep id', id'))
192
193 -- | Assumes that arguments have one PrimRep, which holds after unarisation.
194 -- See Note [Post-unarisation invariants]
195 addArgReps :: [NonVoid StgArg] -> [NonVoid (PrimRep, StgArg)]
196 addArgReps = map (\arg -> let arg' = fromNonVoid arg
197 in NonVoid (argPrimRep arg', arg'))
198
199 -- | Assumes that the argument has one PrimRep, which holds after unarisation.
200 -- See Note [Post-unarisation invariants]
201 argPrimRep :: StgArg -> PrimRep
202 argPrimRep arg = typePrimRep1 (stgArgType arg)
203
204 ------------------------------------------------------
205 -- Building LambdaFormInfo
206 ------------------------------------------------------
207
208 mkLFArgument :: Id -> LambdaFormInfo
209 mkLFArgument id
210 | isUnliftedType ty = LFUnlifted
211 | might_be_a_function ty = LFUnknown True
212 | otherwise = LFUnknown False
213 where
214 ty = idType id
215
216 -------------
217 mkLFLetNoEscape :: LambdaFormInfo
218 mkLFLetNoEscape = LFLetNoEscape
219
220 -------------
221 mkLFReEntrant :: TopLevelFlag -- True of top level
222 -> [Id] -- Free vars
223 -> [Id] -- Args
224 -> ArgDescr -- Argument descriptor
225 -> LambdaFormInfo
226
227 mkLFReEntrant _ _ [] _
228 = pprPanic "mkLFReEntrant" empty
229 mkLFReEntrant top fvs args arg_descr
230 = LFReEntrant top (length args) (null fvs) arg_descr
231
232 -------------
233 mkLFThunk :: Type -> TopLevelFlag -> [Id] -> UpdateFlag -> LambdaFormInfo
234 mkLFThunk thunk_ty top fvs upd_flag
235 = assert (not (isUpdatable upd_flag) || not (isUnliftedType thunk_ty)) $
236 LFThunk top (null fvs)
237 (isUpdatable upd_flag)
238 NonStandardThunk
239 (might_be_a_function thunk_ty)
240
241 --------------
242 might_be_a_function :: Type -> Bool
243 -- Return False only if we are *sure* it's a data type
244 -- Look through newtypes etc as much as poss
245 might_be_a_function ty
246 | [LiftedRep] <- typePrimRep ty
247 , Just tc <- tyConAppTyCon_maybe (unwrapType ty)
248 , isDataTyCon tc
249 = False
250 | otherwise
251 = True
252
253 -------------
254 mkConLFInfo :: DataCon -> LambdaFormInfo
255 mkConLFInfo con = LFCon con
256
257 -------------
258 mkSelectorLFInfo :: Id -> Int -> Bool -> LambdaFormInfo
259 mkSelectorLFInfo id offset updatable
260 = LFThunk NotTopLevel False updatable (SelectorThunk offset)
261 (might_be_a_function (idType id))
262
263 -------------
264 mkApLFInfo :: Id -> UpdateFlag -> Arity -> LambdaFormInfo
265 mkApLFInfo id upd_flag arity
266 = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)
267 (might_be_a_function (idType id))
268
269 -------------
270 mkLFImported :: Id -> LambdaFormInfo
271 mkLFImported id =
272 -- See Note [Conveying CAF-info and LFInfo between modules] in
273 -- GHC.StgToCmm.Types
274 case idLFInfo_maybe id of
275 Just lf_info ->
276 -- Use the LambdaFormInfo from the interface
277 lf_info
278 Nothing
279 -- Interface doesn't have a LambdaFormInfo, make a conservative one from
280 -- the type.
281 | Just con <- isDataConWorkId_maybe id
282 , isNullaryRepDataCon con
283 -> LFCon con -- An imported nullary constructor
284 -- We assume that the constructor is evaluated so that
285 -- the id really does point directly to the constructor
286
287 | arity > 0
288 -> LFReEntrant TopLevel arity True ArgUnknown
289
290 | otherwise
291 -> mkLFArgument id -- Not sure of exact arity
292 where
293 arity = idFunRepArity id
294
295 -------------
296 mkLFStringLit :: LambdaFormInfo
297 mkLFStringLit = LFUnlifted
298
299 -----------------------------------------------------
300 -- Dynamic pointer tagging
301 -----------------------------------------------------
302
303 type DynTag = Int -- The tag on a *pointer*
304 -- (from the dynamic-tagging paper)
305
306 -- Note [Data constructor dynamic tags]
307 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
308 --
309 -- The family size of a data type (the number of constructors
310 -- or the arity of a function) can be either:
311 -- * small, if the family size < 2**tag_bits
312 -- * big, otherwise.
313 --
314 -- Small families can have the constructor tag in the tag bits.
315 -- Big families always use the tag values 1..mAX_PTR_TAG to represent
316 -- evaluatedness, the last one lumping together all overflowing ones.
317 -- We don't have very many tag bits: for example, we have 2 bits on
318 -- x86-32 and 3 bits on x86-64.
319 --
320 -- Also see Note [Tagging big families] in GHC.StgToCmm.Expr
321 --
322 -- The interpreter also needs to be updated if we change the
323 -- tagging strategy. See Note [Data constructor dynamic tags] in
324 -- rts/Interpreter.c
325
326 isSmallFamily :: Platform -> Int -> Bool
327 isSmallFamily platform fam_size = fam_size <= mAX_PTR_TAG platform
328
329 tagForCon :: Platform -> DataCon -> DynTag
330 tagForCon platform con = min (dataConTag con) (mAX_PTR_TAG platform)
331 -- NB: 1-indexed
332
333 tagForArity :: Platform -> RepArity -> DynTag
334 tagForArity platform arity
335 | isSmallFamily platform arity = arity
336 | otherwise = 0
337
338 -- | Return the tag in the low order bits of a variable bound
339 -- to this LambdaForm
340 lfDynTag :: Platform -> LambdaFormInfo -> DynTag
341 lfDynTag platform lf = case lf of
342 LFCon con -> tagForCon platform con
343 LFReEntrant _ arity _ _ -> tagForArity platform arity
344 _other -> 0
345
346
347 -----------------------------------------------------------------------------
348 -- Observing LambdaFormInfo
349 -----------------------------------------------------------------------------
350
351 ------------
352 isLFThunk :: LambdaFormInfo -> Bool
353 isLFThunk (LFThunk {}) = True
354 isLFThunk _ = False
355
356 isLFReEntrant :: LambdaFormInfo -> Bool
357 isLFReEntrant (LFReEntrant {}) = True
358 isLFReEntrant _ = False
359
360 -----------------------------------------------------------------------------
361 -- Choosing SM reps
362 -----------------------------------------------------------------------------
363
364 lfClosureType :: LambdaFormInfo -> ClosureTypeInfo
365 lfClosureType (LFReEntrant _ arity _ argd) = Fun arity argd
366 lfClosureType (LFCon con) = Constr (dataConTagZ con)
367 (dataConIdentity con)
368 lfClosureType (LFThunk _ _ _ is_sel _) = thunkClosureType is_sel
369 lfClosureType _ = panic "lfClosureType"
370
371 thunkClosureType :: StandardFormInfo -> ClosureTypeInfo
372 thunkClosureType (SelectorThunk off) = ThunkSelector off
373 thunkClosureType _ = Thunk
374
375 -- We *do* get non-updatable top-level thunks sometimes. eg. f = g
376 -- gets compiled to a jump to g (if g has non-zero arity), instead of
377 -- messing around with update frames and PAPs. We set the closure type
378 -- to FUN_STATIC in this case.
379
380 -----------------------------------------------------------------------------
381 -- nodeMustPointToIt
382 -----------------------------------------------------------------------------
383
384 nodeMustPointToIt :: Profile -> LambdaFormInfo -> Bool
385 -- If nodeMustPointToIt is true, then the entry convention for
386 -- this closure has R1 (the "Node" register) pointing to the
387 -- closure itself --- the "self" argument
388
389 nodeMustPointToIt _ (LFReEntrant top _ no_fvs _)
390 = not no_fvs -- Certainly if it has fvs we need to point to it
391 || isNotTopLevel top -- See Note [GC recovery]
392 -- For lex_profiling we also access the cost centre for a
393 -- non-inherited (i.e. non-top-level) function.
394 -- The isNotTopLevel test above ensures this is ok.
395
396 nodeMustPointToIt profile (LFThunk top no_fvs updatable NonStandardThunk _)
397 = not no_fvs -- Self parameter
398 || isNotTopLevel top -- Note [GC recovery]
399 || updatable -- Need to push update frame
400 || profileIsProfiling profile
401 -- For the non-updatable (single-entry case):
402 --
403 -- True if has fvs (in which case we need access to them, and we
404 -- should black-hole it)
405 -- or profiling (in which case we need to recover the cost centre
406 -- from inside it) ToDo: do we need this even for
407 -- top-level thunks? If not,
408 -- isNotTopLevel subsumes this
409
410 nodeMustPointToIt _ (LFThunk {}) -- Node must point to a standard-form thunk
411 = True
412
413 nodeMustPointToIt _ (LFCon _) = True
414
415 -- Strictly speaking, the above two don't need Node to point
416 -- to it if the arity = 0. But this is a *really* unlikely
417 -- situation. If we know it's nil (say) and we are entering
418 -- it. Eg: let x = [] in x then we will certainly have inlined
419 -- x, since nil is a simple atom. So we gain little by not
420 -- having Node point to known zero-arity things. On the other
421 -- hand, we do lose something; Patrick's code for figuring out
422 -- when something has been updated but not entered relies on
423 -- having Node point to the result of an update. SLPJ
424 -- 27/11/92.
425
426 nodeMustPointToIt _ (LFUnknown _) = True
427 nodeMustPointToIt _ LFUnlifted = False
428 nodeMustPointToIt _ LFLetNoEscape = False
429
430 {- Note [GC recovery]
431 ~~~~~~~~~~~~~~~~~~~~~
432 If we a have a local let-binding (function or thunk)
433 let f = <body> in ...
434 AND <body> allocates, then the heap-overflow check needs to know how
435 to re-start the evaluation. It uses the "self" pointer to do this.
436 So even if there are no free variables in <body>, we still make
437 nodeMustPointToIt be True for non-top-level bindings.
438
439 Why do any such bindings exist? After all, let-floating should have
440 floated them out. Well, a clever optimiser might leave one there to
441 avoid a space leak, deliberately recomputing a thunk. Also (and this
442 really does happen occasionally) let-floating may make a function f smaller
443 so it can be inlined, so now (f True) may generate a local no-fv closure.
444 This actually happened during bootstrapping GHC itself, with f=mkRdrFunBind
445 in GHC.Tc.Deriv.Generate.) -}
446
447 -----------------------------------------------------------------------------
448 -- getCallMethod
449 -----------------------------------------------------------------------------
450
451 {- The entry conventions depend on the type of closure being entered,
452 whether or not it has free variables, and whether we're running
453 sequentially or in parallel.
454
455 Closure Node Argument Enter
456 Characteristics Par Req'd Passing Via
457 ---------------------------------------------------------------------------
458 Unknown & no & yes & stack & node
459 Known fun (>1 arg), no fvs & no & no & registers & fast entry (enough args)
460 & slow entry (otherwise)
461 Known fun (>1 arg), fvs & no & yes & registers & fast entry (enough args)
462 0 arg, no fvs \r,\s & no & no & n/a & direct entry
463 0 arg, no fvs \u & no & yes & n/a & node
464 0 arg, fvs \r,\s,selector & no & yes & n/a & node
465 0 arg, fvs \r,\s & no & yes & n/a & direct entry
466 0 arg, fvs \u & no & yes & n/a & node
467 Unknown & yes & yes & stack & node
468 Known fun (>1 arg), no fvs & yes & no & registers & fast entry (enough args)
469 & slow entry (otherwise)
470 Known fun (>1 arg), fvs & yes & yes & registers & node
471 0 arg, fvs \r,\s,selector & yes & yes & n/a & node
472 0 arg, no fvs \r,\s & yes & no & n/a & direct entry
473 0 arg, no fvs \u & yes & yes & n/a & node
474 0 arg, fvs \r,\s & yes & yes & n/a & node
475 0 arg, fvs \u & yes & yes & n/a & node
476
477 When black-holing, single-entry closures could also be entered via node
478 (rather than directly) to catch double-entry. -}
479
480 data CallMethod
481 = EnterIt -- No args, not a function
482
483 | JumpToIt BlockId [LocalReg] -- A join point or a header of a local loop
484
485 | ReturnIt -- It's a value (function, unboxed value,
486 -- or constructor), so just return it.
487
488 | SlowCall -- Unknown fun, or known fun with
489 -- too few args.
490
491 | DirectEntry -- Jump directly, with args in regs
492 CLabel -- The code label
493 RepArity -- Its arity
494
495 data CallOpts = CallOpts
496 { co_profile :: !Profile -- ^ Platform profile
497 , co_loopification :: !Bool -- ^ Loopification enabled (cf @-floopification@)
498 , co_ticky :: !Bool -- ^ Ticky profiling enabled (cf @-ticky@)
499 }
500
501 getCallMethod :: CallOpts
502 -> Name -- Function being applied
503 -> Id -- Function Id used to chech if it can refer to
504 -- CAF's and whether the function is tail-calling
505 -- itself
506 -> LambdaFormInfo -- Its info
507 -> RepArity -- Number of available arguments
508 -> RepArity -- Number of them being void arguments
509 -> CgLoc -- Passed in from cgIdApp so that we can
510 -- handle let-no-escape bindings and self-recursive
511 -- tail calls using the same data constructor,
512 -- JumpToIt. This saves us one case branch in
513 -- cgIdApp
514 -> Maybe SelfLoopInfo -- can we perform a self-recursive tail call?
515 -> CallMethod
516
517 getCallMethod opts _ id _ n_args v_args _cg_loc
518 (Just (self_loop_id, block_id, args))
519 | co_loopification opts
520 , id == self_loop_id
521 , args `lengthIs` (n_args - v_args)
522 -- If these patterns match then we know that:
523 -- * loopification optimisation is turned on
524 -- * function is performing a self-recursive call in a tail position
525 -- * number of non-void parameters of the function matches functions arity.
526 -- See Note [Self-recursive tail calls] and Note [Void arguments in
527 -- self-recursive tail calls] in GHC.StgToCmm.Expr for more details
528 = JumpToIt block_id args
529
530 getCallMethod opts name id (LFReEntrant _ arity _ _) n_args _v_args _cg_loc
531 _self_loop_info
532 | n_args == 0 -- No args at all
533 && not (profileIsProfiling (co_profile opts))
534 -- See Note [Evaluating functions with profiling] in rts/Apply.cmm
535 = assert (arity /= 0) ReturnIt
536 | n_args < arity = SlowCall -- Not enough args
537 | otherwise = DirectEntry (enterIdLabel (profilePlatform (co_profile opts)) name (idCafInfo id)) arity
538
539 getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info
540 = assert (n_args == 0) ReturnIt
541
542 getCallMethod _ _name _ (LFCon _) n_args _v_args _cg_loc _self_loop_info
543 = assert (n_args == 0) ReturnIt
544 -- n_args=0 because it'd be ill-typed to apply a saturated
545 -- constructor application to anything
546
547 getCallMethod opts name id (LFThunk _ _ updatable std_form_info is_fun)
548 n_args _v_args _cg_loc _self_loop_info
549 | is_fun -- it *might* be a function, so we must "call" it (which is always safe)
550 = SlowCall -- We cannot just enter it [in eval/apply, the entry code
551 -- is the fast-entry code]
552
553 -- Since is_fun is False, we are *definitely* looking at a data value
554 | updatable || co_ticky opts -- to catch double entry
555 {- OLD: || opt_SMP
556 I decided to remove this, because in SMP mode it doesn't matter
557 if we enter the same thunk multiple times, so the optimisation
558 of jumping directly to the entry code is still valid. --SDM
559 -}
560 = EnterIt
561
562 -- even a non-updatable selector thunk can be updated by the garbage
563 -- collector, so we must enter it. (#8817)
564 | SelectorThunk{} <- std_form_info
565 = EnterIt
566
567 -- We used to have assert (n_args == 0 ), but actually it is
568 -- possible for the optimiser to generate
569 -- let bot :: Int = error Int "urk"
570 -- in (bot `cast` unsafeCoerce Int (Int -> Int)) 3
571 -- This happens as a result of the case-of-error transformation
572 -- So the right thing to do is just to enter the thing
573
574 | otherwise -- Jump direct to code for single-entry thunks
575 = assert (n_args == 0) $
576 DirectEntry (thunkEntryLabel (profilePlatform (co_profile opts)) name (idCafInfo id) std_form_info
577 updatable) 0
578
579 getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info
580 = SlowCall -- might be a function
581
582 getCallMethod _ name _ (LFUnknown False) n_args _v_args _cg_loc _self_loop_info
583 = assertPpr (n_args == 0) (ppr name <+> ppr n_args)
584 EnterIt -- Not a function
585
586 getCallMethod _ _name _ LFLetNoEscape _n_args _v_args (LneLoc blk_id lne_regs)
587 _self_loop_info
588 = JumpToIt blk_id lne_regs
589
590 getCallMethod _ _ _ _ _ _ _ _ = panic "Unknown call method"
591
592 -----------------------------------------------------------------------------
593 -- Data types for closure information
594 -----------------------------------------------------------------------------
595
596
597 {- ClosureInfo: information about a binding
598
599 We make a ClosureInfo for each let binding (both top level and not),
600 but not bindings for data constructors: for those we build a CmmInfoTable
601 directly (see mkDataConInfoTable).
602
603 To a first approximation:
604 ClosureInfo = (LambdaFormInfo, CmmInfoTable)
605
606 A ClosureInfo has enough information
607 a) to construct the info table itself, and build other things
608 related to the binding (e.g. slow entry points for a function)
609 b) to allocate a closure containing that info pointer (i.e.
610 it knows the info table label)
611 -}
612
613 data ClosureInfo
614 = ClosureInfo {
615 closureName :: !Name, -- The thing bound to this closure
616 -- we don't really need this field: it's only used in generating
617 -- code for ticky and profiling, and we could pass the information
618 -- around separately, but it doesn't do much harm to keep it here.
619
620 closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon
621 -- this tells us about what the closure contains: it's right-hand-side.
622
623 -- the rest is just an unpacked CmmInfoTable.
624 closureInfoLabel :: !CLabel,
625 closureSMRep :: !SMRep, -- representation used by storage mgr
626 closureProf :: !ProfilingInfo
627 }
628
629 -- | Convert from 'ClosureInfo' to 'CmmInfoTable'.
630 mkCmmInfo :: ClosureInfo -> Id -> CostCentreStack -> CmmInfoTable
631 mkCmmInfo ClosureInfo {..} id ccs
632 = CmmInfoTable { cit_lbl = closureInfoLabel
633 , cit_rep = closureSMRep
634 , cit_prof = closureProf
635 , cit_srt = Nothing
636 , cit_clo = if isStaticRep closureSMRep
637 then Just (id,ccs)
638 else Nothing }
639
640 --------------------------------------
641 -- Building ClosureInfos
642 --------------------------------------
643
644 mkClosureInfo :: Profile
645 -> Bool -- Is static
646 -> Id
647 -> LambdaFormInfo
648 -> Int -> Int -- Total and pointer words
649 -> String -- String descriptor
650 -> ClosureInfo
651 mkClosureInfo profile is_static id lf_info tot_wds ptr_wds val_descr
652 = ClosureInfo { closureName = name
653 , closureLFInfo = lf_info
654 , closureInfoLabel = info_lbl -- These three fields are
655 , closureSMRep = sm_rep -- (almost) an info table
656 , closureProf = prof } -- (we don't have an SRT yet)
657 where
658 name = idName id
659 sm_rep = mkHeapRep profile is_static ptr_wds nonptr_wds (lfClosureType lf_info)
660 prof = mkProfilingInfo profile id val_descr
661 nonptr_wds = tot_wds - ptr_wds
662
663 info_lbl = mkClosureInfoTableLabel (profilePlatform profile) id lf_info
664
665 --------------------------------------
666 -- Other functions over ClosureInfo
667 --------------------------------------
668
669 -- Eager blackholing is normally disabled, but can be turned on with
670 -- -feager-blackholing. When it is on, we replace the info pointer of
671 -- the thunk with stg_EAGER_BLACKHOLE_info on entry.
672
673 -- If we wanted to do eager blackholing with slop filling,
674 -- we'd need to do it at the *end* of a basic block, otherwise
675 -- we overwrite the free variables in the thunk that we still
676 -- need. We have a patch for this from Andy Cheadle, but not
677 -- incorporated yet. --SDM [6/2004]
678 --
679 -- Previously, eager blackholing was enabled when ticky-ticky
680 -- was on. But it didn't work, and it wasn't strictly necessary
681 -- to bring back minimal ticky-ticky, so now EAGER_BLACKHOLING
682 -- is unconditionally disabled. -- krc 1/2007
683 --
684 -- Static closures are never themselves black-holed.
685
686 blackHoleOnEntry :: ClosureInfo -> Bool
687 blackHoleOnEntry cl_info
688 | isStaticRep (closureSMRep cl_info)
689 = False -- Never black-hole a static closure
690
691 | otherwise
692 = case closureLFInfo cl_info of
693 LFReEntrant {} -> False
694 LFLetNoEscape -> False
695 LFThunk _ _no_fvs upd _ _ -> upd -- See Note [Black-holing non-updatable thunks]
696 _other -> panic "blackHoleOnEntry"
697
698 {- Note [Black-holing non-updatable thunks]
699 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
700 We must not black-hole non-updatable (single-entry) thunks otherwise
701 we run into issues like #10414. Specifically:
702
703 * There is no reason to black-hole a non-updatable thunk: it should
704 not be competed for by multiple threads
705
706 * It could, conceivably, cause a space leak if we don't black-hole
707 it, if there was a live but never-followed pointer pointing to it.
708 Let's hope that doesn't happen.
709
710 * It is dangerous to black-hole a non-updatable thunk because
711 - is not updated (of course)
712 - hence, if it is black-holed and another thread tries to evaluate
713 it, that thread will block forever
714 This actually happened in #10414. So we do not black-hole
715 non-updatable thunks.
716
717 * How could two threads evaluate the same non-updatable (single-entry)
718 thunk? See Reid Barton's example below.
719
720 * Only eager blackholing could possibly black-hole a non-updatable
721 thunk, because lazy black-holing only affects thunks with an
722 update frame on the stack.
723
724 Here is and example due to Reid Barton (#10414):
725 x = \u [] concat [[1], []]
726 with the following definitions,
727
728 concat x = case x of
729 [] -> []
730 (:) x xs -> (++) x (concat xs)
731
732 (++) xs ys = case xs of
733 [] -> ys
734 (:) x rest -> (:) x ((++) rest ys)
735
736 Where we use the syntax @\u []@ to denote an updatable thunk and @\s []@ to
737 denote a single-entry (i.e. non-updatable) thunk. After a thread evaluates @x@
738 to WHNF and calls @(++)@ the heap will contain the following thunks,
739
740 x = 1 : y
741 y = \u [] (++) [] z
742 z = \s [] concat []
743
744 Now that the stage is set, consider the follow evaluations by two racing threads
745 A and B,
746
747 1. Both threads enter @y@ before either is able to replace it with an
748 indirection
749
750 2. Thread A does the case analysis in @(++)@ and consequently enters @z@,
751 replacing it with a black-hole
752
753 3. At some later point thread B does the same case analysis and also attempts
754 to enter @z@. However, it finds that it has been replaced with a black-hole
755 so it blocks.
756
757 4. Thread A eventually finishes evaluating @z@ (to @[]@) and updates @y@
758 accordingly. It does *not* update @z@, however, as it is single-entry. This
759 leaves Thread B blocked forever on a black-hole which will never be
760 updated.
761
762 To avoid this sort of condition we never black-hole non-updatable thunks.
763 -}
764
765 isStaticClosure :: ClosureInfo -> Bool
766 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
767
768 closureUpdReqd :: ClosureInfo -> Bool
769 closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info
770
771 lfUpdatable :: LambdaFormInfo -> Bool
772 lfUpdatable (LFThunk _ _ upd _ _) = upd
773 lfUpdatable _ = False
774
775 closureReEntrant :: ClosureInfo -> Bool
776 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant {} }) = True
777 closureReEntrant _ = False
778
779 closureFunInfo :: ClosureInfo -> Maybe (RepArity, ArgDescr)
780 closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info
781
782 lfFunInfo :: LambdaFormInfo -> Maybe (RepArity, ArgDescr)
783 lfFunInfo (LFReEntrant _ arity _ arg_desc) = Just (arity, arg_desc)
784 lfFunInfo _ = Nothing
785
786 funTag :: Platform -> ClosureInfo -> DynTag
787 funTag platform (ClosureInfo { closureLFInfo = lf_info })
788 = lfDynTag platform lf_info
789
790 isToplevClosure :: ClosureInfo -> Bool
791 isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
792 = case lf_info of
793 LFReEntrant TopLevel _ _ _ -> True
794 LFThunk TopLevel _ _ _ _ -> True
795 _other -> False
796
797 --------------------------------------
798 -- Label generation
799 --------------------------------------
800
801 staticClosureLabel :: Platform -> ClosureInfo -> CLabel
802 staticClosureLabel platform = toClosureLbl platform . closureInfoLabel
803
804 closureSlowEntryLabel :: Platform -> ClosureInfo -> CLabel
805 closureSlowEntryLabel platform = toSlowEntryLbl platform . closureInfoLabel
806
807 closureLocalEntryLabel :: Platform -> ClosureInfo -> CLabel
808 closureLocalEntryLabel platform
809 | platformTablesNextToCode platform = toInfoLbl platform . closureInfoLabel
810 | otherwise = toEntryLbl platform . closureInfoLabel
811
812 mkClosureInfoTableLabel :: Platform -> Id -> LambdaFormInfo -> CLabel
813 mkClosureInfoTableLabel platform id lf_info
814 = case lf_info of
815 LFThunk _ _ upd_flag (SelectorThunk offset) _
816 -> mkSelectorInfoLabel platform upd_flag offset
817
818 LFThunk _ _ upd_flag (ApThunk arity) _
819 -> mkApInfoTableLabel platform upd_flag arity
820
821 LFThunk{} -> std_mk_lbl name cafs
822 LFReEntrant{} -> std_mk_lbl name cafs
823 _other -> panic "closureInfoTableLabel"
824
825 where
826 name = idName id
827
828 std_mk_lbl | is_local = mkLocalInfoTableLabel
829 | otherwise = mkInfoTableLabel
830
831 cafs = idCafInfo id
832 is_local = isDataConWorkId id
833 -- Make the _info pointer for the implicit datacon worker
834 -- binding local. The reason we can do this is that importing
835 -- code always either uses the _closure or _con_info. By the
836 -- invariants in "GHC.CoreToStg.Prep" anything else gets eta expanded.
837
838
839 -- | thunkEntryLabel is a local help function, not exported. It's used from
840 -- getCallMethod.
841 thunkEntryLabel :: Platform -> Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel
842 thunkEntryLabel platform thunk_id caf_info sfi upd_flag = case sfi of
843 ApThunk arity -> enterApLabel platform upd_flag arity
844 SelectorThunk offset -> enterSelectorLabel platform upd_flag offset
845 _ -> enterIdLabel platform thunk_id caf_info
846
847 enterApLabel :: Platform -> Bool -> Arity -> CLabel
848 enterApLabel platform is_updatable arity
849 | platformTablesNextToCode platform = mkApInfoTableLabel platform is_updatable arity
850 | otherwise = mkApEntryLabel platform is_updatable arity
851
852 enterSelectorLabel :: Platform -> Bool -> WordOff -> CLabel
853 enterSelectorLabel platform upd_flag offset
854 | platformTablesNextToCode platform = mkSelectorInfoLabel platform upd_flag offset
855 | otherwise = mkSelectorEntryLabel platform upd_flag offset
856
857 enterIdLabel :: Platform -> Name -> CafInfo -> CLabel
858 enterIdLabel platform id c
859 | platformTablesNextToCode platform = mkInfoTableLabel id c
860 | otherwise = mkEntryLabel id c
861
862
863 --------------------------------------
864 -- Profiling
865 --------------------------------------
866
867 -- Profiling requires two pieces of information to be determined for
868 -- each closure's info table --- description and type.
869
870 -- The description is stored directly in the @CClosureInfoTable@ when the
871 -- info table is built.
872
873 -- The type is determined from the type information stored with the @Id@
874 -- in the closure info using @closureTypeDescr@.
875
876 mkProfilingInfo :: Profile -> Id -> String -> ProfilingInfo
877 mkProfilingInfo profile id val_descr
878 | not (profileIsProfiling profile) = NoProfilingInfo
879 | otherwise = ProfilingInfo ty_descr_w8 (BS8.pack val_descr)
880 where
881 ty_descr_w8 = BS8.pack (getTyDescription (idType id))
882
883 getTyDescription :: Type -> String
884 getTyDescription ty
885 = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
886 case tau_ty of
887 TyVarTy _ -> "*"
888 AppTy fun _ -> getTyDescription fun
889 TyConApp tycon _ -> getOccString tycon
890 FunTy {} -> '-' : fun_result tau_ty
891 ForAllTy _ ty -> getTyDescription ty
892 LitTy n -> getTyLitDescription n
893 CastTy ty _ -> getTyDescription ty
894 CoercionTy co -> pprPanic "getTyDescription" (ppr co)
895 }
896 where
897 fun_result (FunTy { ft_res = res }) = '>' : fun_result res
898 fun_result other = getTyDescription other
899
900 getTyLitDescription :: TyLit -> String
901 getTyLitDescription l =
902 case l of
903 NumTyLit n -> show n
904 StrTyLit n -> show n
905 CharTyLit n -> show n
906
907 --------------------------------------
908 -- CmmInfoTable-related things
909 --------------------------------------
910
911 mkDataConInfoTable :: Profile -> DataCon -> ConInfoTableLocation -> Bool -> Int -> Int -> CmmInfoTable
912 mkDataConInfoTable profile data_con mn is_static ptr_wds nonptr_wds
913 = CmmInfoTable { cit_lbl = info_lbl
914 , cit_rep = sm_rep
915 , cit_prof = prof
916 , cit_srt = Nothing
917 , cit_clo = Nothing }
918 where
919 name = dataConName data_con
920 info_lbl = mkConInfoTableLabel name mn -- NoCAFRefs
921 sm_rep = mkHeapRep profile is_static ptr_wds nonptr_wds cl_type
922 cl_type = Constr (dataConTagZ data_con) (dataConIdentity data_con)
923 -- We keep the *zero-indexed* tag in the srt_len field
924 -- of the info table of a data constructor.
925
926 prof | not (profileIsProfiling profile) = NoProfilingInfo
927 | otherwise = ProfilingInfo ty_descr val_descr
928
929 ty_descr = BS8.pack $ occNameString $ getOccName $ dataConTyCon data_con
930 val_descr = BS8.pack $ occNameString $ getOccName data_con
931
932 -- We need a black-hole closure info to pass to @allocDynClosure@ when we
933 -- want to allocate the black hole on entry to a CAF.
934
935 cafBlackHoleInfoTable :: CmmInfoTable
936 cafBlackHoleInfoTable
937 = CmmInfoTable { cit_lbl = mkCAFBlackHoleInfoTableLabel
938 , cit_rep = blackHoleRep
939 , cit_prof = NoProfilingInfo
940 , cit_srt = Nothing
941 , cit_clo = Nothing }
942
943 indStaticInfoTable :: CmmInfoTable
944 indStaticInfoTable
945 = CmmInfoTable { cit_lbl = mkIndStaticInfoLabel
946 , cit_rep = indStaticRep
947 , cit_prof = NoProfilingInfo
948 , cit_srt = Nothing
949 , cit_clo = Nothing }
950
951 staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool
952 -- A static closure needs a link field to aid the GC when traversing
953 -- the static closure graph. But it only needs such a field if either
954 -- a) it has an SRT
955 -- b) it's a constructor with one or more pointer fields
956 -- In case (b), the constructor's fields themselves play the role
957 -- of the SRT.
958 staticClosureNeedsLink has_srt CmmInfoTable{ cit_rep = smrep }
959 | isConRep smrep = not (isStaticNoCafCon smrep)
960 | otherwise = has_srt