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