ca6b404084c198d2e1636c63e87d75a992d84925
[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 #include "HsVersions.h"
65
66 import StgSyn
67 import SMRep
68 import Cmm
69 import PprCmmExpr()
70
71 import BlockId
72 import CLabel
73 import Id
74 import IdInfo
75 import DataCon
76 import Name
77 import Type
78 import TyCoRep
79 import TcType
80 import TyCon
81 import BasicTypes
82 import Outputable
83 import DynFlags
84 import Util
85
86 -----------------------------------------------------------------------------
87 -- Data types and synonyms
88 -----------------------------------------------------------------------------
89
90 -- These data types are mostly used by other modules, especially StgCmmMonad,
91 -- but we define them here because some functions in this module need to
92 -- have access to them as well
93
94 data CgLoc
95 = CmmLoc CmmExpr -- A stable CmmExpr; that is, one not mentioning
96 -- Hp, so that it remains valid across calls
97
98 | LneLoc BlockId [LocalReg] -- A join point
99 -- A join point (= let-no-escape) should only
100 -- be tail-called, and in a saturated way.
101 -- To tail-call it, assign to these locals,
102 -- and branch to the block id
103
104 instance Outputable CgLoc where
105 ppr (CmmLoc e) = text "cmm" <+> ppr e
106 ppr (LneLoc b rs) = text "lne" <+> ppr b <+> ppr rs
107
108 type SelfLoopInfo = (Id, BlockId, [LocalReg])
109
110 -- used by ticky profiling
111 isKnownFun :: LambdaFormInfo -> Bool
112 isKnownFun LFReEntrant{} = True
113 isKnownFun LFLetNoEscape = True
114 isKnownFun _ = False
115
116
117 -----------------------------------------------------------------------------
118 -- Representations
119 -----------------------------------------------------------------------------
120
121 -- Why are these here?
122
123 idPrimRep :: Id -> PrimRep
124 idPrimRep id = typePrimRep (idType id)
125 -- NB: typePrimRep fails on unboxed tuples,
126 -- but by StgCmm no Ids have unboxed tuple type
127
128 addIdReps :: [Id] -> [(PrimRep, Id)]
129 addIdReps ids = [(idPrimRep id, id) | id <- ids]
130
131 addArgReps :: [StgArg] -> [(PrimRep, StgArg)]
132 addArgReps args = [(argPrimRep arg, arg) | arg <- args]
133
134 argPrimRep :: StgArg -> PrimRep
135 argPrimRep arg = typePrimRep (stgArgType arg)
136
137
138 -----------------------------------------------------------------------------
139 -- LambdaFormInfo
140 -----------------------------------------------------------------------------
141
142 -- Information about an identifier, from the code generator's point of
143 -- view. Every identifier is bound to a LambdaFormInfo in the
144 -- environment, which gives the code generator enough info to be able to
145 -- tail call or return that identifier.
146
147 data LambdaFormInfo
148 = LFReEntrant -- Reentrant closure (a function)
149 TopLevelFlag -- True if top level
150 OneShotInfo
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 _ _ [] _
232 = pprPanic "mkLFReEntrant" empty
233 mkLFReEntrant top fvs args arg_descr
234 = LFReEntrant top os_info (length args) (null fvs) arg_descr
235 where os_info = idOneShotInfo (head args)
236
237 -------------
238 mkLFThunk :: Type -> TopLevelFlag -> [Id] -> UpdateFlag -> LambdaFormInfo
239 mkLFThunk thunk_ty top fvs upd_flag
240 = ASSERT( not (isUpdatable upd_flag) || not (isUnliftedType thunk_ty) )
241 LFThunk top (null fvs)
242 (isUpdatable upd_flag)
243 NonStandardThunk
244 (might_be_a_function thunk_ty)
245
246 --------------
247 might_be_a_function :: Type -> Bool
248 -- Return False only if we are *sure* it's a data type
249 -- Look through newtypes etc as much as poss
250 might_be_a_function ty
251 | UnaryRep rep <- repType ty
252 , Just tc <- tyConAppTyCon_maybe rep
253 , isDataTyCon tc
254 = False
255 | otherwise
256 = True
257
258 -------------
259 mkConLFInfo :: DataCon -> LambdaFormInfo
260 mkConLFInfo con = LFCon con
261
262 -------------
263 mkSelectorLFInfo :: Id -> Int -> Bool -> LambdaFormInfo
264 mkSelectorLFInfo id offset updatable
265 = LFThunk NotTopLevel False updatable (SelectorThunk offset)
266 (might_be_a_function (idType id))
267
268 -------------
269 mkApLFInfo :: Id -> UpdateFlag -> Arity -> LambdaFormInfo
270 mkApLFInfo id upd_flag arity
271 = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)
272 (might_be_a_function (idType id))
273
274 -------------
275 mkLFImported :: Id -> LambdaFormInfo
276 mkLFImported id
277 | Just con <- isDataConWorkId_maybe id
278 , isNullaryRepDataCon con
279 = LFCon con -- An imported nullary constructor
280 -- We assume that the constructor is evaluated so that
281 -- the id really does point directly to the constructor
282
283 | arity > 0
284 = LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr")
285
286 | otherwise
287 = mkLFArgument id -- Not sure of exact arity
288 where
289 arity = idRepArity id
290
291 -----------------------------------------------------
292 -- Dynamic pointer tagging
293 -----------------------------------------------------
294
295 type ConTagZ = Int -- A *zero-indexed* contructor tag
296
297 type DynTag = Int -- The tag on a *pointer*
298 -- (from the dynamic-tagging paper)
299
300 -- Note [Data constructor dynamic tags]
301 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
302 --
303 -- The family size of a data type (the number of constructors
304 -- or the arity of a function) can be either:
305 -- * small, if the family size < 2**tag_bits
306 -- * big, otherwise.
307 --
308 -- Small families can have the constructor tag in the tag bits.
309 -- Big families only use the tag value 1 to represent evaluatedness.
310 -- We don't have very many tag bits: for example, we have 2 bits on
311 -- x86-32 and 3 bits on x86-64.
312
313 isSmallFamily :: DynFlags -> Int -> Bool
314 isSmallFamily dflags fam_size = fam_size <= mAX_PTR_TAG dflags
315
316 -- We keep the *zero-indexed* tag in the srt_len field of the info
317 -- table of a data constructor.
318 dataConTagZ :: DataCon -> ConTagZ
319 dataConTagZ con = dataConTag con - fIRST_TAG
320
321 tagForCon :: DynFlags -> DataCon -> DynTag
322 tagForCon dflags con
323 | isSmallFamily dflags fam_size = con_tag + 1
324 | otherwise = 1
325 where
326 con_tag = dataConTagZ con
327 fam_size = tyConFamilySize (dataConTyCon con)
328
329 tagForArity :: DynFlags -> RepArity -> DynTag
330 tagForArity dflags arity
331 | isSmallFamily dflags arity = arity
332 | otherwise = 0
333
334 lfDynTag :: DynFlags -> LambdaFormInfo -> DynTag
335 -- Return the tag in the low order bits of a variable bound
336 -- to this LambdaForm
337 lfDynTag dflags (LFCon con) = tagForCon dflags con
338 lfDynTag dflags (LFReEntrant _ _ arity _ _) = tagForArity dflags arity
339 lfDynTag _ _other = 0
340
341
342 -----------------------------------------------------------------------------
343 -- Observing LambdaFormInfo
344 -----------------------------------------------------------------------------
345
346 -------------
347 maybeIsLFCon :: LambdaFormInfo -> Maybe DataCon
348 maybeIsLFCon (LFCon con) = Just con
349 maybeIsLFCon _ = Nothing
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 :: DynFlags -> 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 dflags (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 || gopt Opt_SccProfilingOn dflags
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 TcGenDeriv.) -}
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 getCallMethod :: DynFlags
496 -> Name -- Function being applied
497 -> Id -- Function Id used to chech if it can refer to
498 -- CAF's and whether the function is tail-calling
499 -- itself
500 -> LambdaFormInfo -- Its info
501 -> RepArity -- Number of available arguments
502 -> RepArity -- Number of them being void arguments
503 -> CgLoc -- Passed in from cgIdApp so that we can
504 -- handle let-no-escape bindings and self-recursive
505 -- tail calls using the same data constructor,
506 -- JumpToIt. This saves us one case branch in
507 -- cgIdApp
508 -> Maybe SelfLoopInfo -- can we perform a self-recursive tail call?
509 -> CallMethod
510
511 getCallMethod dflags _ id _ n_args v_args _cg_loc
512 (Just (self_loop_id, block_id, args))
513 | gopt Opt_Loopification dflags
514 , id == self_loop_id
515 , n_args - v_args == length args
516 -- If these patterns match then we know that:
517 -- * loopification optimisation is turned on
518 -- * function is performing a self-recursive call in a tail position
519 -- * number of non-void parameters of the function matches functions arity.
520 -- See Note [Self-recursive tail calls] and Note [Void arguments in
521 -- self-recursive tail calls] in StgCmmExpr for more details
522 = JumpToIt block_id args
523
524 getCallMethod dflags name id (LFReEntrant _ _ arity _ _) n_args _v_args _cg_loc
525 _self_loop_info
526 | n_args == 0 = ASSERT( arity /= 0 )
527 ReturnIt -- No args at all
528 | n_args < arity = SlowCall -- Not enough args
529 | otherwise = DirectEntry (enterIdLabel dflags name (idCafInfo id)) arity
530
531 getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info
532 = ASSERT( n_args == 0 ) ReturnIt
533
534 getCallMethod _ _name _ (LFCon _) n_args _v_args _cg_loc _self_loop_info
535 = ASSERT( n_args == 0 ) ReturnIt
536 -- n_args=0 because it'd be ill-typed to apply a saturated
537 -- constructor application to anything
538
539 getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun)
540 n_args _v_args _cg_loc _self_loop_info
541 | is_fun -- it *might* be a function, so we must "call" it (which is always safe)
542 = SlowCall -- We cannot just enter it [in eval/apply, the entry code
543 -- is the fast-entry code]
544
545 -- Since is_fun is False, we are *definitely* looking at a data value
546 | updatable || gopt Opt_Ticky dflags -- to catch double entry
547 {- OLD: || opt_SMP
548 I decided to remove this, because in SMP mode it doesn't matter
549 if we enter the same thunk multiple times, so the optimisation
550 of jumping directly to the entry code is still valid. --SDM
551 -}
552 = EnterIt
553
554 -- even a non-updatable selector thunk can be updated by the garbage
555 -- collector, so we must enter it. (#8817)
556 | SelectorThunk{} <- std_form_info
557 = EnterIt
558
559 -- We used to have ASSERT( n_args == 0 ), but actually it is
560 -- possible for the optimiser to generate
561 -- let bot :: Int = error Int "urk"
562 -- in (bot `cast` unsafeCoerce Int (Int -> Int)) 3
563 -- This happens as a result of the case-of-error transformation
564 -- So the right thing to do is just to enter the thing
565
566 | otherwise -- Jump direct to code for single-entry thunks
567 = ASSERT( n_args == 0 )
568 DirectEntry (thunkEntryLabel dflags name (idCafInfo id) std_form_info
569 updatable) 0
570
571 getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info
572 = SlowCall -- might be a function
573
574 getCallMethod _ name _ (LFUnknown False) n_args _v_args _cg_loc _self_loop_info
575 = ASSERT2( n_args == 0, ppr name <+> ppr n_args )
576 EnterIt -- Not a function
577
578 getCallMethod _ _name _ LFLetNoEscape _n_args _v_args (LneLoc blk_id lne_regs)
579 _self_loop_info
580 = JumpToIt blk_id lne_regs
581
582 getCallMethod _ _ _ _ _ _ _ _ = panic "Unknown call method"
583
584 -----------------------------------------------------------------------------
585 -- staticClosureRequired
586 -----------------------------------------------------------------------------
587
588 {- staticClosureRequired is never called (hence commented out)
589
590 SimonMar writes (Sept 07) It's an optimisation we used to apply at
591 one time, I believe, but it got lost probably in the rewrite of
592 the RTS/code generator. I left that code there to remind me to
593 look into whether it was worth doing sometime
594
595 {- Avoiding generating entries and info tables
596 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
597 At present, for every function we generate all of the following,
598 just in case. But they aren't always all needed, as noted below:
599
600 [NB1: all of this applies only to *functions*. Thunks always
601 have closure, info table, and entry code.]
602
603 [NB2: All are needed if the function is *exported*, just to play safe.]
604
605 * Fast-entry code ALWAYS NEEDED
606
607 * Slow-entry code
608 Needed iff (a) we have any un-saturated calls to the function
609 OR (b) the function is passed as an arg
610 OR (c) we're in the parallel world and the function has free vars
611 [Reason: in parallel world, we always enter functions
612 with free vars via the closure.]
613
614 * The function closure
615 Needed iff (a) we have any un-saturated calls to the function
616 OR (b) the function is passed as an arg
617 OR (c) if the function has free vars (ie not top level)
618
619 Why case (a) here? Because if the arg-satis check fails,
620 UpdatePAP stuffs a pointer to the function closure in the PAP.
621 [Could be changed; UpdatePAP could stuff in a code ptr instead,
622 but doesn't seem worth it.]
623
624 [NB: these conditions imply that we might need the closure
625 without the slow-entry code. Here's how.
626
627 f x y = let g w = ...x..y..w...
628 in
629 ...(g t)...
630
631 Here we need a closure for g which contains x and y,
632 but since the calls are all saturated we just jump to the
633 fast entry point for g, with R1 pointing to the closure for g.]
634
635
636 * Standard info table
637 Needed iff (a) we have any un-saturated calls to the function
638 OR (b) the function is passed as an arg
639 OR (c) the function has free vars (ie not top level)
640
641 NB. In the sequential world, (c) is only required so that the function closure has
642 an info table to point to, to keep the storage manager happy.
643 If (c) alone is true we could fake up an info table by choosing
644 one of a standard family of info tables, whose entry code just
645 bombs out.
646
647 [NB In the parallel world (c) is needed regardless because
648 we enter functions with free vars via the closure.]
649
650 If (c) is retained, then we'll sometimes generate an info table
651 (for storage mgr purposes) without slow-entry code. Then we need
652 to use an error label in the info table to substitute for the absent
653 slow entry code.
654 -}
655
656 staticClosureRequired
657 :: Name
658 -> StgBinderInfo
659 -> LambdaFormInfo
660 -> Bool
661 staticClosureRequired binder bndr_info
662 (LFReEntrant top_level _ _ _ _) -- It's a function
663 = ASSERT( isTopLevel top_level )
664 -- Assumption: it's a top-level, no-free-var binding
665 not (satCallsOnly bndr_info)
666
667 staticClosureRequired binder other_binder_info other_lf_info = True
668 -}
669
670 -----------------------------------------------------------------------------
671 -- Data types for closure information
672 -----------------------------------------------------------------------------
673
674
675 {- ClosureInfo: information about a binding
676
677 We make a ClosureInfo for each let binding (both top level and not),
678 but not bindings for data constructors: for those we build a CmmInfoTable
679 directly (see mkDataConInfoTable).
680
681 To a first approximation:
682 ClosureInfo = (LambdaFormInfo, CmmInfoTable)
683
684 A ClosureInfo has enough information
685 a) to construct the info table itself, and build other things
686 related to the binding (e.g. slow entry points for a function)
687 b) to allocate a closure containing that info pointer (i.e.
688 it knows the info table label)
689 -}
690
691 data ClosureInfo
692 = ClosureInfo {
693 closureName :: !Name, -- The thing bound to this closure
694 -- we don't really need this field: it's only used in generating
695 -- code for ticky and profiling, and we could pass the information
696 -- around separately, but it doesn't do much harm to keep it here.
697
698 closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon
699 -- this tells us about what the closure contains: it's right-hand-side.
700
701 -- the rest is just an unpacked CmmInfoTable.
702 closureInfoLabel :: !CLabel,
703 closureSMRep :: !SMRep, -- representation used by storage mgr
704 closureProf :: !ProfilingInfo
705 }
706
707 -- | Convert from 'ClosureInfo' to 'CmmInfoTable'.
708 mkCmmInfo :: ClosureInfo -> CmmInfoTable
709 mkCmmInfo ClosureInfo {..}
710 = CmmInfoTable { cit_lbl = closureInfoLabel
711 , cit_rep = closureSMRep
712 , cit_prof = closureProf
713 , cit_srt = NoC_SRT }
714
715 --------------------------------------
716 -- Building ClosureInfos
717 --------------------------------------
718
719 mkClosureInfo :: DynFlags
720 -> Bool -- Is static
721 -> Id
722 -> LambdaFormInfo
723 -> Int -> Int -- Total and pointer words
724 -> String -- String descriptor
725 -> ClosureInfo
726 mkClosureInfo dflags is_static id lf_info tot_wds ptr_wds val_descr
727 = ClosureInfo { closureName = name
728 , closureLFInfo = lf_info
729 , closureInfoLabel = info_lbl -- These three fields are
730 , closureSMRep = sm_rep -- (almost) an info table
731 , closureProf = prof } -- (we don't have an SRT yet)
732 where
733 name = idName id
734 sm_rep = mkHeapRep dflags is_static ptr_wds nonptr_wds (lfClosureType lf_info)
735 prof = mkProfilingInfo dflags id val_descr
736 nonptr_wds = tot_wds - ptr_wds
737
738 info_lbl = mkClosureInfoTableLabel id lf_info
739
740 --------------------------------------
741 -- Other functions over ClosureInfo
742 --------------------------------------
743
744 -- Eager blackholing is normally disabled, but can be turned on with
745 -- -feager-blackholing. When it is on, we replace the info pointer of
746 -- the thunk with stg_EAGER_BLACKHOLE_info on entry.
747
748 -- If we wanted to do eager blackholing with slop filling,
749 -- we'd need to do it at the *end* of a basic block, otherwise
750 -- we overwrite the free variables in the thunk that we still
751 -- need. We have a patch for this from Andy Cheadle, but not
752 -- incorporated yet. --SDM [6/2004]
753 --
754 -- Previously, eager blackholing was enabled when ticky-ticky
755 -- was on. But it didn't work, and it wasn't strictly necessary
756 -- to bring back minimal ticky-ticky, so now EAGER_BLACKHOLING
757 -- is unconditionally disabled. -- krc 1/2007
758 --
759 -- Static closures are never themselves black-holed.
760
761 blackHoleOnEntry :: ClosureInfo -> Bool
762 blackHoleOnEntry cl_info
763 | isStaticRep (closureSMRep cl_info)
764 = False -- Never black-hole a static closure
765
766 | otherwise
767 = case closureLFInfo cl_info of
768 LFReEntrant {} -> False
769 LFLetNoEscape -> False
770 LFThunk _ _no_fvs upd _ _ -> upd -- See Note [Black-holing non-updatable thunks]
771 _other -> panic "blackHoleOnEntry"
772
773 {- Note [Black-holing non-updatable thunks]
774 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
775 We must not black-hole non-updatable (single-entry) thunks otherwise
776 we run into issues like Trac #10414. Specifically:
777
778 * There is no reason to black-hole a non-updatable thunk: it should
779 not be competed for by multiple threads
780
781 * It could, conceivably, cause a space leak if we don't black-hole
782 it, if there was a live but never-followed pointer pointing to it.
783 Let's hope that doesn't happen.
784
785 * It is dangerous to black-hole a non-updatable thunk because
786 - is not updated (of course)
787 - hence, if it is black-holed and another thread tries to evalute
788 it, that thread will block forever
789 This actually happened in Trac #10414. So we do not black-hole
790 non-updatable thunks.
791
792 * How could two threads evaluate the same non-updatable (single-entry)
793 thunk? See Reid Barton's example below.
794
795 * Only eager blackholing could possibly black-hole a non-updatable
796 thunk, because lazy black-holing only affects thunks with an
797 update frame on the stack.
798
799 Here is and example due to Reid Barton (Trac #10414):
800 x = \u [] concat [[1], []]
801 with the following definitions,
802
803 concat x = case x of
804 [] -> []
805 (:) x xs -> (++) x (concat xs)
806
807 (++) xs ys = case xs of
808 [] -> ys
809 (:) x rest -> (:) x ((++) rest ys)
810
811 Where we use the syntax @\u []@ to denote an updatable thunk and @\s []@ to
812 denote a single-entry (i.e. non-updatable) thunk. After a thread evaluates @x@
813 to WHNF and calls @(++)@ the heap will contain the following thunks,
814
815 x = 1 : y
816 y = \u [] (++) [] z
817 z = \s [] concat []
818
819 Now that the stage is set, consider the follow evaluations by two racing threads
820 A and B,
821
822 1. Both threads enter @y@ before either is able to replace it with an
823 indirection
824
825 2. Thread A does the case analysis in @(++)@ and consequently enters @z@,
826 replacing it with a black-hole
827
828 3. At some later point thread B does the same case analysis and also attempts
829 to enter @z@. However, it finds that it has been replaced with a black-hole
830 so it blocks.
831
832 4. Thread A eventually finishes evaluating @z@ (to @[]@) and updates @y@
833 accordingly. It does *not* update @z@, however, as it is single-entry. This
834 leaves Thread B blocked forever on a black-hole which will never be
835 updated.
836
837 To avoid this sort of condition we never black-hole non-updatable thunks.
838 -}
839
840 isStaticClosure :: ClosureInfo -> Bool
841 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
842
843 closureUpdReqd :: ClosureInfo -> Bool
844 closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info
845
846 lfUpdatable :: LambdaFormInfo -> Bool
847 lfUpdatable (LFThunk _ _ upd _ _) = upd
848 lfUpdatable _ = False
849
850 closureSingleEntry :: ClosureInfo -> Bool
851 closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
852 closureSingleEntry (ClosureInfo { closureLFInfo = LFReEntrant _ OneShotLam _ _ _}) = True
853 closureSingleEntry _ = False
854
855 closureReEntrant :: ClosureInfo -> Bool
856 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant {} }) = True
857 closureReEntrant _ = False
858
859 closureFunInfo :: ClosureInfo -> Maybe (RepArity, ArgDescr)
860 closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info
861
862 lfFunInfo :: LambdaFormInfo -> Maybe (RepArity, ArgDescr)
863 lfFunInfo (LFReEntrant _ _ arity _ arg_desc) = Just (arity, arg_desc)
864 lfFunInfo _ = Nothing
865
866 funTag :: DynFlags -> ClosureInfo -> DynTag
867 funTag dflags (ClosureInfo { closureLFInfo = lf_info })
868 = lfDynTag dflags lf_info
869
870 isToplevClosure :: ClosureInfo -> Bool
871 isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
872 = case lf_info of
873 LFReEntrant TopLevel _ _ _ _ -> True
874 LFThunk TopLevel _ _ _ _ -> True
875 _other -> False
876
877 --------------------------------------
878 -- Label generation
879 --------------------------------------
880
881 staticClosureLabel :: ClosureInfo -> CLabel
882 staticClosureLabel = toClosureLbl . closureInfoLabel
883
884 closureSlowEntryLabel :: ClosureInfo -> CLabel
885 closureSlowEntryLabel = toSlowEntryLbl . closureInfoLabel
886
887 closureLocalEntryLabel :: DynFlags -> ClosureInfo -> CLabel
888 closureLocalEntryLabel dflags
889 | tablesNextToCode dflags = toInfoLbl . closureInfoLabel
890 | otherwise = toEntryLbl . closureInfoLabel
891
892 mkClosureInfoTableLabel :: Id -> LambdaFormInfo -> CLabel
893 mkClosureInfoTableLabel id lf_info
894 = case lf_info of
895 LFThunk _ _ upd_flag (SelectorThunk offset) _
896 -> mkSelectorInfoLabel upd_flag offset
897
898 LFThunk _ _ upd_flag (ApThunk arity) _
899 -> mkApInfoTableLabel upd_flag arity
900
901 LFThunk{} -> std_mk_lbl name cafs
902 LFReEntrant{} -> std_mk_lbl name cafs
903 _other -> panic "closureInfoTableLabel"
904
905 where
906 name = idName id
907
908 std_mk_lbl | is_local = mkLocalInfoTableLabel
909 | otherwise = mkInfoTableLabel
910
911 cafs = idCafInfo id
912 is_local = isDataConWorkId id
913 -- Make the _info pointer for the implicit datacon worker
914 -- binding local. The reason we can do this is that importing
915 -- code always either uses the _closure or _con_info. By the
916 -- invariants in CorePrep anything else gets eta expanded.
917
918
919 thunkEntryLabel :: DynFlags -> Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel
920 -- thunkEntryLabel is a local help function, not exported. It's used from
921 -- getCallMethod.
922 thunkEntryLabel dflags _thunk_id _ (ApThunk arity) upd_flag
923 = enterApLabel dflags upd_flag arity
924 thunkEntryLabel dflags _thunk_id _ (SelectorThunk offset) upd_flag
925 = enterSelectorLabel dflags upd_flag offset
926 thunkEntryLabel dflags thunk_id c _ _
927 = enterIdLabel dflags thunk_id c
928
929 enterApLabel :: DynFlags -> Bool -> Arity -> CLabel
930 enterApLabel dflags is_updatable arity
931 | tablesNextToCode dflags = mkApInfoTableLabel is_updatable arity
932 | otherwise = mkApEntryLabel is_updatable arity
933
934 enterSelectorLabel :: DynFlags -> Bool -> WordOff -> CLabel
935 enterSelectorLabel dflags upd_flag offset
936 | tablesNextToCode dflags = mkSelectorInfoLabel upd_flag offset
937 | otherwise = mkSelectorEntryLabel upd_flag offset
938
939 enterIdLabel :: DynFlags -> Name -> CafInfo -> CLabel
940 enterIdLabel dflags id c
941 | tablesNextToCode dflags = mkInfoTableLabel id c
942 | otherwise = mkEntryLabel id c
943
944
945 --------------------------------------
946 -- Profiling
947 --------------------------------------
948
949 -- Profiling requires two pieces of information to be determined for
950 -- each closure's info table --- description and type.
951
952 -- The description is stored directly in the @CClosureInfoTable@ when the
953 -- info table is built.
954
955 -- The type is determined from the type information stored with the @Id@
956 -- in the closure info using @closureTypeDescr@.
957
958 mkProfilingInfo :: DynFlags -> Id -> String -> ProfilingInfo
959 mkProfilingInfo dflags id val_descr
960 | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo
961 | otherwise = ProfilingInfo ty_descr_w8 val_descr_w8
962 where
963 ty_descr_w8 = stringToWord8s (getTyDescription (idType id))
964 val_descr_w8 = stringToWord8s val_descr
965
966 getTyDescription :: Type -> String
967 getTyDescription ty
968 = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
969 case tau_ty of
970 TyVarTy _ -> "*"
971 AppTy fun _ -> getTyDescription fun
972 TyConApp tycon _ -> getOccString tycon
973 ForAllTy (Anon _) res -> '-' : '>' : fun_result res
974 ForAllTy (Named {}) ty -> getTyDescription ty
975 LitTy n -> getTyLitDescription n
976 CastTy ty _ -> getTyDescription ty
977 CoercionTy co -> pprPanic "getTyDescription" (ppr co)
978 }
979 where
980 fun_result (ForAllTy (Anon _) res) = '>' : fun_result res
981 fun_result other = getTyDescription other
982
983 getTyLitDescription :: TyLit -> String
984 getTyLitDescription l =
985 case l of
986 NumTyLit n -> show n
987 StrTyLit n -> show n
988
989 --------------------------------------
990 -- CmmInfoTable-related things
991 --------------------------------------
992
993 mkDataConInfoTable :: DynFlags -> DataCon -> Bool -> Int -> Int -> CmmInfoTable
994 mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds
995 = CmmInfoTable { cit_lbl = info_lbl
996 , cit_rep = sm_rep
997 , cit_prof = prof
998 , cit_srt = NoC_SRT }
999 where
1000 name = dataConName data_con
1001
1002 info_lbl | is_static = mkStaticInfoTableLabel name NoCafRefs
1003 | otherwise = mkConInfoTableLabel name NoCafRefs
1004
1005 sm_rep = mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type
1006
1007 cl_type = Constr (dataConTagZ data_con) (dataConIdentity data_con)
1008
1009 prof | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo
1010 | otherwise = ProfilingInfo ty_descr val_descr
1011
1012 ty_descr = stringToWord8s $ occNameString $ getOccName $ dataConTyCon data_con
1013 val_descr = stringToWord8s $ occNameString $ getOccName data_con
1014
1015 -- We need a black-hole closure info to pass to @allocDynClosure@ when we
1016 -- want to allocate the black hole on entry to a CAF.
1017
1018 cafBlackHoleInfoTable :: CmmInfoTable
1019 cafBlackHoleInfoTable
1020 = CmmInfoTable { cit_lbl = mkCAFBlackHoleInfoTableLabel
1021 , cit_rep = blackHoleRep
1022 , cit_prof = NoProfilingInfo
1023 , cit_srt = NoC_SRT }
1024
1025 indStaticInfoTable :: CmmInfoTable
1026 indStaticInfoTable
1027 = CmmInfoTable { cit_lbl = mkIndStaticInfoLabel
1028 , cit_rep = indStaticRep
1029 , cit_prof = NoProfilingInfo
1030 , cit_srt = NoC_SRT }
1031
1032 staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool
1033 -- A static closure needs a link field to aid the GC when traversing
1034 -- the static closure graph. But it only needs such a field if either
1035 -- a) it has an SRT
1036 -- b) it's a constructor with one or more pointer fields
1037 -- In case (b), the constructor's fields themselves play the role
1038 -- of the SRT.
1039 --
1040 -- At this point, the cit_srt field has not been calculated (that
1041 -- happens right at the end of the Cmm pipeline), but we do have the
1042 -- VarSet of CAFs that CoreToStg attached, and if that is empty there
1043 -- will definitely not be an SRT.
1044 --
1045 staticClosureNeedsLink has_srt CmmInfoTable{ cit_rep = smrep }
1046 | isConRep smrep = not (isStaticNoCafCon smrep)
1047 | otherwise = has_srt -- needsSRT (cit_srt info_tbl)