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