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