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