2 % (c) The University of Glasgow 2006
3 % (c) The Univserity of Glasgow 1992-2004
6 Data structures which describe closures, and
7 operations over those data structures
9 Nothing monadic in here
11 Much of the rationale for these things is in the ``details'' part of
16 ClosureInfo(..), LambdaFormInfo(..), -- would be abstract but
17 StandardFormInfo(..), -- mkCmmInfo looks inside
20 ArgDescr(..), Liveness(..),
23 mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,
24 mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
26 mkClosureInfo, mkConInfo, maybeIsLFCon,
28 closureSize, closureNonHdrSize,
29 closureGoodStuffSize, closurePtrsSize,
34 isLFThunk, closureUpdReqd,
35 closureNeedsUpdSpace, closureIsThunk,
36 closureSingleEntry, closureReEntrant, isConstrClosure_maybe,
37 closureFunInfo, isStandardFormThunk, isKnownFun,
38 funTag, funTagLFInfo, tagForArity,
40 enterIdLabel, enterLocalIdLabel, enterReturnPtLabel,
43 CallMethod(..), getCallMethod,
47 staticClosureRequired,
51 closureValDescr, closureTypeDescr, -- profiling
54 cafBlackHoleClosureInfo,
56 staticClosureNeedsLink,
59 #include "../includes/MachDeps.h"
60 #include "HsVersions.h"
87 %************************************************************************
89 \subsection[ClosureInfo-datatypes]{Data types for closure information}
91 %************************************************************************
93 Information about a closure, from the code generator's point of view.
95 A ClosureInfo decribes the info pointer of a closure. It has
97 a) to construct the info table itself
98 b) to allocate a closure containing that info pointer (i.e.
99 it knows the info table label)
101 We make a ClosureInfo for
102 - each let binding (both top level and not)
103 - each data constructor (for its shared static and
109 closureName :: !Name, -- The thing bound to this closure
110 closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon (see below)
111 closureSMRep :: !SMRep, -- representation used by storage mgr
112 closureSRT :: !C_SRT, -- What SRT applies to this closure
113 closureType :: !Type, -- Type of closure (ToDo: remove)
114 closureDescr :: !String -- closure description (for profiling)
117 -- Constructor closures don't have a unique info table label (they use
118 -- the constructor's info table), and they don't have an SRT.
120 closureCon :: !DataCon,
121 closureSMRep :: !SMRep
124 -- C_SRT is what StgSyn.SRT gets translated to...
125 -- we add a label for the table, and expect only the 'offset/length' form
128 | C_SRT !CLabel !WordOff !StgHalfWord {-bitmap or escape-}
131 needsSRT :: C_SRT -> Bool
132 needsSRT NoC_SRT = False
133 needsSRT (C_SRT _ _ _) = True
135 instance Outputable C_SRT where
136 ppr (NoC_SRT) = ptext (sLit "_no_srt_")
137 ppr (C_SRT label off bitmap) = parens (ppr label <> comma <> ppr off <> comma <> text (show bitmap))
140 %************************************************************************
142 \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
144 %************************************************************************
146 Information about an identifier, from the code generator's point of
147 view. Every identifier is bound to a LambdaFormInfo in the
148 environment, which gives the code generator enough info to be able to
149 tail call or return that identifier.
151 Note that a closure is usually bound to an identifier, so a
152 ClosureInfo contains a LambdaFormInfo.
156 = LFReEntrant -- Reentrant closure (a function)
157 TopLevelFlag -- True if top level
158 !Int -- Arity. Invariant: always > 0
159 !Bool -- True <=> no fvs
160 ArgDescr -- Argument descriptor (should reall be in ClosureInfo)
162 | LFCon -- A saturated constructor application
163 DataCon -- The constructor
165 | LFThunk -- Thunk (zero arity)
167 !Bool -- True <=> no free vars
168 !Bool -- True <=> updatable (i.e., *not* single-entry)
170 !Bool -- True <=> *might* be a function type
172 | LFUnknown -- Used for function arguments and imported things.
173 -- We know nothing about this closure. Treat like
174 -- updatable "LFThunk"...
175 -- Imported things which we do know something about use
176 -- one of the other LF constructors (eg LFReEntrant for
178 !Bool -- True <=> *might* be a function type
180 | LFLetNoEscape -- See LetNoEscape module for precise description of
184 | LFBlackHole -- Used for the closures allocated to hold the result
185 -- of a CAF. We want the target of the update frame to
186 -- be in the heap, so we make a black hole to hold it.
187 CLabel -- Flavour (info label, eg CAF_BLACKHOLE_info).
190 -------------------------
191 -- An ArgDsecr describes the argument pattern of a function
194 = ArgSpec -- Fits one of the standard patterns
195 !StgHalfWord -- RTS type identifier ARG_P, ARG_N, ...
197 | ArgGen -- General case
198 Liveness -- Details about the arguments
201 -------------------------
202 -- We represent liveness bitmaps as a Bitmap (whose internal
203 -- representation really is a bitmap). These are pinned onto case return
204 -- vectors to indicate the state of the stack for the garbage collector.
206 -- In the compiled program, liveness bitmaps that fit inside a single
207 -- word (StgWord) are stored as a single word, while larger bitmaps are
208 -- stored as a pointer to an array of words.
211 = SmallLiveness -- Liveness info that fits in one word
212 StgWord -- Here's the bitmap
214 | BigLiveness -- Liveness info witha a multi-word bitmap
215 CLabel -- Label for the bitmap
218 -------------------------
219 -- StandardFormInfo tells whether this thunk has one of
220 -- a small number of standard forms
222 data StandardFormInfo
224 -- Not of of the standard forms
227 -- A SelectorThunk is of form
229 -- con a1,..,an -> ak
230 -- and the constructor is from a single-constr type.
231 WordOff -- 0-origin offset of ak within the "goods" of
232 -- constructor (Recall that the a1,...,an may be laid
233 -- out in the heap in a non-obvious order.)
236 -- An ApThunk is of form
238 -- The code for the thunk just pushes x2..xn on the stack and enters x1.
239 -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
240 -- in the RTS to save space.
244 %************************************************************************
246 \subsection[ClosureInfo-construction]{Functions which build LFInfos}
248 %************************************************************************
251 mkLFReEntrant :: TopLevelFlag -- True of top level
254 -> ArgDescr -- Argument descriptor
257 mkLFReEntrant top fvs args arg_descr
258 = LFReEntrant top (length args) (null fvs) arg_descr
260 mkLFThunk :: Type -> TopLevelFlag -> [Var] -> UpdateFlag -> LambdaFormInfo
261 mkLFThunk thunk_ty top fvs upd_flag
262 = ASSERT2( not (isUpdatable upd_flag) || not (isUnLiftedType thunk_ty), ppr thunk_ty $$ ppr fvs )
263 LFThunk top (null fvs)
264 (isUpdatable upd_flag)
266 (might_be_a_function thunk_ty)
268 might_be_a_function :: Type -> Bool
269 -- Return False only if we are *sure* it's a data type
270 -- Look through newtypes etc as much as poss
271 might_be_a_function ty
272 = case splitTyConApp_maybe (repType ty) of
273 Just (tc, _) -> not (isDataTyCon tc)
277 @mkConLFInfo@ is similar, for constructors.
280 mkConLFInfo :: DataCon -> LambdaFormInfo
281 mkConLFInfo con = LFCon con
283 maybeIsLFCon :: LambdaFormInfo -> Maybe DataCon
284 maybeIsLFCon (LFCon con) = Just con
285 maybeIsLFCon _ = Nothing
287 mkSelectorLFInfo :: Id -> WordOff -> Bool -> LambdaFormInfo
288 mkSelectorLFInfo id offset updatable
289 = LFThunk NotTopLevel False updatable (SelectorThunk offset)
290 (might_be_a_function (idType id))
292 mkApLFInfo :: Id -> UpdateFlag -> Int -> LambdaFormInfo
293 mkApLFInfo id upd_flag arity
294 = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)
295 (might_be_a_function (idType id))
298 Miscellaneous LF-infos.
301 mkLFArgument :: Id -> LambdaFormInfo
302 mkLFArgument id = LFUnknown (might_be_a_function (idType id))
304 mkLFLetNoEscape :: Int -> LambdaFormInfo
305 mkLFLetNoEscape = LFLetNoEscape
307 mkLFImported :: Id -> LambdaFormInfo
310 n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr") -- n > 0
311 _ -> mkLFArgument id -- Not sure of exact arity
315 isLFThunk :: LambdaFormInfo -> Bool
316 isLFThunk (LFThunk _ _ _ _ _) = True
317 isLFThunk (LFBlackHole _) = True
318 -- return True for a blackhole: this function is used to determine
319 -- whether to use the thunk header in SMP mode, and a blackhole
324 %************************************************************************
326 Building ClosureInfos
328 %************************************************************************
331 mkClosureInfo :: Bool -- Is static
334 -> Int -> Int -- Total and pointer words
336 -> String -- String descriptor
338 mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr
339 = ClosureInfo { closureName = name,
340 closureLFInfo = lf_info,
341 closureSMRep = sm_rep,
342 closureSRT = srt_info,
343 closureType = idType id,
344 closureDescr = descr }
347 sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds
349 mkConInfo :: Bool -- Is static
351 -> Int -> Int -- Total and pointer words
353 mkConInfo is_static data_con tot_wds ptr_wds
354 = ConInfo { closureSMRep = sm_rep,
355 closureCon = data_con }
357 sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds
360 %************************************************************************
362 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
364 %************************************************************************
367 closureSize :: ClosureInfo -> WordOff
368 closureSize cl_info = hdr_size + closureNonHdrSize cl_info
369 where hdr_size | closureIsThunk cl_info = thunkHdrSize
370 | otherwise = fixedHdrSize
371 -- All thunks use thunkHdrSize, even if they are non-updatable.
372 -- this is because we don't have separate closure types for
373 -- updatable vs. non-updatable thunks, so the GC can't tell the
374 -- difference. If we ever have significant numbers of non-
375 -- updatable thunks, it might be worth fixing this.
377 closureNonHdrSize :: ClosureInfo -> WordOff
378 closureNonHdrSize cl_info
379 = tot_wds + computeSlopSize tot_wds cl_info
381 tot_wds = closureGoodStuffSize cl_info
383 closureGoodStuffSize :: ClosureInfo -> WordOff
384 closureGoodStuffSize cl_info
385 = let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info)
388 closurePtrsSize :: ClosureInfo -> WordOff
389 closurePtrsSize cl_info
390 = let (ptrs, _) = sizes_from_SMRep (closureSMRep cl_info)
394 sizes_from_SMRep :: SMRep -> (WordOff,WordOff)
395 sizes_from_SMRep (GenericRep _ ptrs nonptrs _) = (ptrs, nonptrs)
396 sizes_from_SMRep BlackHoleRep = (0, 0)
399 Computing slop size. WARNING: this looks dodgy --- it has deep
400 knowledge of what the storage manager does with the various
403 Slop Requirements: every thunk gets an extra padding word in the
404 header, which takes the the updated value.
407 slopSize :: ClosureInfo -> WordOff
408 slopSize cl_info = computeSlopSize payload_size cl_info
409 where payload_size = closureGoodStuffSize cl_info
411 computeSlopSize :: WordOff -> ClosureInfo -> WordOff
412 computeSlopSize payload_size cl_info
413 = max 0 (minPayloadSize smrep updatable - payload_size)
415 smrep = closureSMRep cl_info
416 updatable = closureNeedsUpdSpace cl_info
418 -- we leave space for an update if either (a) the closure is updatable
419 -- or (b) it is a static thunk. This is because a static thunk needs
420 -- a static link field in a predictable place (after the slop), regardless
421 -- of whether it is updatable or not.
422 closureNeedsUpdSpace :: ClosureInfo -> Bool
423 closureNeedsUpdSpace (ClosureInfo { closureLFInfo =
424 LFThunk TopLevel _ _ _ _ }) = True
425 closureNeedsUpdSpace cl_info = closureUpdReqd cl_info
427 minPayloadSize :: SMRep -> Bool -> WordOff
428 minPayloadSize smrep updatable
430 BlackHoleRep -> min_upd_size
431 GenericRep _ _ _ _ | updatable -> min_upd_size
432 GenericRep True _ _ _ -> 0 -- static
433 GenericRep False _ _ _ -> mIN_PAYLOAD_SIZE
437 ASSERT(mIN_PAYLOAD_SIZE <= sIZEOF_StgSMPThunkHeader)
438 0 -- check that we already have enough
439 -- room for mIN_SIZE_NonUpdHeapObject,
440 -- due to the extra header word in SMP
443 %************************************************************************
445 \subsection[SMreps]{Choosing SM reps}
447 %************************************************************************
451 :: Bool -- True <=> static closure
453 -> WordOff -> WordOff -- Tot wds, ptr wds
456 chooseSMRep is_static lf_info tot_wds ptr_wds
458 nonptr_wds = tot_wds - ptr_wds
459 closure_type = getClosureType is_static ptr_wds lf_info
461 GenericRep is_static ptr_wds nonptr_wds closure_type
463 -- We *do* get non-updatable top-level thunks sometimes. eg. f = g
464 -- gets compiled to a jump to g (if g has non-zero arity), instead of
465 -- messing around with update frames and PAPs. We set the closure type
466 -- to FUN_STATIC in this case.
468 getClosureType :: Bool -> WordOff -> LambdaFormInfo -> ClosureType
469 getClosureType is_static ptr_wds lf_info
471 LFCon _ | is_static && ptr_wds == 0 -> ConstrNoCaf
472 | otherwise -> Constr
473 LFReEntrant _ _ _ _ -> Fun
474 LFThunk _ _ _ (SelectorThunk _) _ -> ThunkSelector
475 LFThunk _ _ _ _ _ -> Thunk
476 _ -> panic "getClosureType"
479 %************************************************************************
481 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
483 %************************************************************************
485 Be sure to see the stg-details notes about these...
488 nodeMustPointToIt :: LambdaFormInfo -> Bool
489 nodeMustPointToIt (LFReEntrant top _ no_fvs _)
490 = not no_fvs || -- Certainly if it has fvs we need to point to it
492 -- If it is not top level we will point to it
493 -- We can have a \r closure with no_fvs which
494 -- is not top level as special case cgRhsClosure
495 -- has been dissabled in favour of let floating
497 -- For lex_profiling we also access the cost centre for a
498 -- non-inherited function i.e. not top level
499 -- the not top case above ensures this is ok.
501 nodeMustPointToIt (LFCon _) = True
503 -- Strictly speaking, the above two don't need Node to point
504 -- to it if the arity = 0. But this is a *really* unlikely
505 -- situation. If we know it's nil (say) and we are entering
506 -- it. Eg: let x = [] in x then we will certainly have inlined
507 -- x, since nil is a simple atom. So we gain little by not
508 -- having Node point to known zero-arity things. On the other
509 -- hand, we do lose something; Patrick's code for figuring out
510 -- when something has been updated but not entered relies on
511 -- having Node point to the result of an update. SLPJ
514 nodeMustPointToIt (LFThunk _ no_fvs updatable NonStandardThunk _)
515 = updatable || not no_fvs || opt_SccProfilingOn
516 -- For the non-updatable (single-entry case):
518 -- True if has fvs (in which case we need access to them, and we
519 -- should black-hole it)
520 -- or profiling (in which case we need to recover the cost centre
523 nodeMustPointToIt (LFThunk _ _ _ _ _)
524 = True -- Node must point to any standard-form thunk
526 nodeMustPointToIt (LFUnknown _) = True
527 nodeMustPointToIt (LFBlackHole _) = True -- BH entry may require Node to point
528 nodeMustPointToIt (LFLetNoEscape _) = False
531 The entry conventions depend on the type of closure being entered,
532 whether or not it has free variables, and whether we're running
533 sequentially or in parallel.
535 \begin{tabular}{lllll}
536 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
537 Unknown & no & yes & stack & node \\
538 Known fun ($\ge$ 1 arg), no fvs & no & no & registers & fast entry (enough args) \\
539 \ & \ & \ & \ & slow entry (otherwise) \\
540 Known fun ($\ge$ 1 arg), fvs & no & yes & registers & fast entry (enough args) \\
541 0 arg, no fvs @\r,\s@ & no & no & n/a & direct entry \\
542 0 arg, no fvs @\u@ & no & yes & n/a & node \\
543 0 arg, fvs @\r,\s@ & no & yes & n/a & direct entry \\
544 0 arg, fvs @\u@ & no & yes & n/a & node \\
546 Unknown & yes & yes & stack & node \\
547 Known fun ($\ge$ 1 arg), no fvs & yes & no & registers & fast entry (enough args) \\
548 \ & \ & \ & \ & slow entry (otherwise) \\
549 Known fun ($\ge$ 1 arg), fvs & yes & yes & registers & node \\
550 0 arg, no fvs @\r,\s@ & yes & no & n/a & direct entry \\
551 0 arg, no fvs @\u@ & yes & yes & n/a & node \\
552 0 arg, fvs @\r,\s@ & yes & yes & n/a & node \\
553 0 arg, fvs @\u@ & yes & yes & n/a & node\\
556 When black-holing, single-entry closures could also be entered via node
557 (rather than directly) to catch double-entry.
561 = EnterIt -- no args, not a function
563 | JumpToIt CLabel -- no args, not a function, but we
564 -- know what its entry code is
566 | ReturnIt -- it's a function, but we have
567 -- zero args to apply to it, so just
570 | ReturnCon DataCon -- It's a data constructor, just return it
572 | SlowCall -- Unknown fun, or known fun with
575 | DirectEntry -- Jump directly, with args in regs
576 CLabel -- The code label
579 getCallMethod :: DynFlags
580 -> Name -- Function being applied
581 -> CafInfo -- Can it refer to CAF's?
582 -> LambdaFormInfo -- Its info
583 -> Int -- Number of available arguments
586 getCallMethod _ _ _ lf_info _
587 | nodeMustPointToIt lf_info && opt_Parallel
588 = -- If we're parallel, then we must always enter via node.
589 -- The reason is that the closure may have been
590 -- fetched since we allocated it.
593 getCallMethod _ name caf (LFReEntrant _ arity _ _) n_args
594 | n_args == 0 = ASSERT( arity /= 0 )
595 ReturnIt -- No args at all
596 | n_args < arity = SlowCall -- Not enough args
597 | otherwise = DirectEntry (enterIdLabel name caf) arity
599 getCallMethod _ _ _ (LFCon con) n_args
600 | opt_SccProfilingOn -- when profiling, we must always enter
601 = EnterIt -- a closure when we use it, so that the closure
602 -- can be recorded as used for LDV profiling.
604 = ASSERT( n_args == 0 )
607 getCallMethod dflags name caf (LFThunk _ _ updatable std_form_info is_fun) n_args
608 | is_fun -- it *might* be a function, so we must "call" it (which is
610 = SlowCall -- We cannot just enter it [in eval/apply, the entry code
611 -- is the fast-entry code]
613 -- Since is_fun is False, we are *definitely* looking at a data value
614 | updatable || doingTickyProfiling dflags -- to catch double entry
616 I decided to remove this, because in SMP mode it doesn't matter
617 if we enter the same thunk multiple times, so the optimisation
618 of jumping directly to the entry code is still valid. --SDM
621 -- We used to have ASSERT( n_args == 0 ), but actually it is
622 -- possible for the optimiser to generate
623 -- let bot :: Int = error Int "urk"
624 -- in (bot `cast` unsafeCoerce Int (Int -> Int)) 3
625 -- This happens as a result of the case-of-error transformation
626 -- So the right thing to do is just to enter the thing
628 | otherwise -- Jump direct to code for single-entry thunks
629 = ASSERT( n_args == 0 )
630 JumpToIt (thunkEntryLabel name caf std_form_info updatable)
632 getCallMethod _ _ _ (LFUnknown True) _
633 = SlowCall -- Might be a function
635 getCallMethod _ name _ (LFUnknown False) n_args
637 = WARN( True, ppr name <+> ppr n_args )
638 SlowCall -- Note [Unsafe coerce complications]
641 = EnterIt -- Not a function
643 getCallMethod _ _ _ (LFBlackHole _) _
644 = SlowCall -- Presumably the black hole has by now
645 -- been updated, but we don't know with
646 -- what, so we slow call it
648 getCallMethod _ name _ (LFLetNoEscape 0) _
649 = JumpToIt (enterReturnPtLabel (nameUnique name))
651 getCallMethod _ name _ (LFLetNoEscape arity) n_args
652 | n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity
653 | otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity)
655 blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool
656 -- Static closures are never themselves black-holed.
657 -- Updatable ones will be overwritten with a CAFList cell, which points to a
659 -- Single-entry ones have no fvs to plug, and we trust they don't form part
662 blackHoleOnEntry _ ConInfo{} = False
663 blackHoleOnEntry dflags (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
665 = False -- Never black-hole a static closure
669 LFReEntrant _ _ _ _ -> False
670 LFLetNoEscape _ -> False
671 LFThunk _ no_fvs updatable _ _
673 then not opt_OmitBlackHoling
674 else doingTickyProfiling dflags || not no_fvs
675 -- the former to catch double entry,
676 -- and the latter to plug space-leaks. KSW/SDM 1999-04.
678 _ -> panic "blackHoleOnEntry" -- Should never happen
680 isStandardFormThunk :: LambdaFormInfo -> Bool
681 isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
682 isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _) = True
683 isStandardFormThunk _ = False
685 isKnownFun :: LambdaFormInfo -> Bool
686 isKnownFun (LFReEntrant _ _ _ _) = True
687 isKnownFun (LFLetNoEscape _) = True
691 Note [Unsafe coerce complications]
692 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
693 In some (badly-optimised) DPH code we see this
694 Module X: rr :: Int = error Int "Urk"
695 Module Y: ...((X.rr |> g) True) ...
696 where g is an (unsafe) coercion of kind (Int ~ Bool->Bool), say
698 It's badly optimised, because knowing that 'X.rr' is bottom, we should
699 have dumped the application to True. But it should still work. These
700 strange unsafe coercions arise from the case-of-error transformation:
701 (case (error Int "foo") of { ... }) True
702 ---> (error Int "foo" |> g) True
704 Anyway, the net effect is that in STG-land, when casts are discarded,
705 we *can* see a value of type Int applied to an argument. This only happens
706 if (a) the programmer made a mistake, or (b) the value of type Int is
709 So it's wrong to trigger an ASSERT failure in this circumstance. Instead
710 we now emit a WARN -- mainly to draw attention to a probably-badly-optimised
711 program fragment -- and do the conservative thing which is SlowCall.
714 -----------------------------------------------------------------------------
718 staticClosureNeedsLink :: ClosureInfo -> Bool
719 -- A static closure needs a link field to aid the GC when traversing
720 -- the static closure graph. But it only needs such a field if either
722 -- b) it's a constructor with one or more pointer fields
723 -- In case (b), the constructor's fields themselves play the role
725 staticClosureNeedsLink (ClosureInfo { closureSRT = srt })
727 staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })
728 = not (isNullaryRepDataCon con) && not_nocaf_constr
732 GenericRep _ _ _ ConstrNoCaf -> False
736 Note [Entering error thunks]
737 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
741 fail = error Int "Urk"
744 foo True y = (fail `cast` Bool -> Bool) y
747 This looks silly, but it can arise from case-of-error. Even if it
748 does, we'd usually see that 'fail' is a bottoming function and would
749 discard the extra argument 'y'. But even if that does not occur,
750 this program is still OK. We will enter 'fail', which never returns.
752 The WARN is just to alert me to the fact that we aren't spotting that
755 (We are careful never to make a funtion value look like a data type,
756 because we can't enter a function closure -- but that is not the
760 Avoiding generating entries and info tables
761 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
762 At present, for every function we generate all of the following,
763 just in case. But they aren't always all needed, as noted below:
765 [NB1: all of this applies only to *functions*. Thunks always
766 have closure, info table, and entry code.]
768 [NB2: All are needed if the function is *exported*, just to play safe.]
771 * Fast-entry code ALWAYS NEEDED
774 Needed iff (a) we have any un-saturated calls to the function
775 OR (b) the function is passed as an arg
776 OR (c) we're in the parallel world and the function has free vars
777 [Reason: in parallel world, we always enter functions
778 with free vars via the closure.]
780 * The function closure
781 Needed iff (a) we have any un-saturated calls to the function
782 OR (b) the function is passed as an arg
783 OR (c) if the function has free vars (ie not top level)
785 Why case (a) here? Because if the arg-satis check fails,
786 UpdatePAP stuffs a pointer to the function closure in the PAP.
787 [Could be changed; UpdatePAP could stuff in a code ptr instead,
788 but doesn't seem worth it.]
790 [NB: these conditions imply that we might need the closure
791 without the slow-entry code. Here's how.
793 f x y = let g w = ...x..y..w...
797 Here we need a closure for g which contains x and y,
798 but since the calls are all saturated we just jump to the
799 fast entry point for g, with R1 pointing to the closure for g.]
802 * Standard info table
803 Needed iff (a) we have any un-saturated calls to the function
804 OR (b) the function is passed as an arg
805 OR (c) the function has free vars (ie not top level)
807 NB. In the sequential world, (c) is only required so that the function closure has
808 an info table to point to, to keep the storage manager happy.
809 If (c) alone is true we could fake up an info table by choosing
810 one of a standard family of info tables, whose entry code just
813 [NB In the parallel world (c) is needed regardless because
814 we enter functions with free vars via the closure.]
816 If (c) is retained, then we'll sometimes generate an info table
817 (for storage mgr purposes) without slow-entry code. Then we need
818 to use an error label in the info table to substitute for the absent
822 staticClosureRequired
827 staticClosureRequired _ bndr_info
828 (LFReEntrant top_level _ _ _) -- It's a function
829 = ASSERT( isTopLevel top_level )
830 -- Assumption: it's a top-level, no-free-var binding
831 not (satCallsOnly bndr_info)
833 staticClosureRequired _ _ _ = True
836 %************************************************************************
838 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
840 %************************************************************************
844 isStaticClosure :: ClosureInfo -> Bool
845 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
847 closureUpdReqd :: ClosureInfo -> Bool
848 closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info
849 closureUpdReqd ConInfo{} = False
851 lfUpdatable :: LambdaFormInfo -> Bool
852 lfUpdatable (LFThunk _ _ upd _ _) = upd
853 lfUpdatable (LFBlackHole _) = True
854 -- Black-hole closures are allocated to receive the results of an
855 -- alg case with a named default... so they need to be updated.
856 lfUpdatable _ = False
858 closureIsThunk :: ClosureInfo -> Bool
859 closureIsThunk ClosureInfo{ closureLFInfo = lf_info } = isLFThunk lf_info
860 closureIsThunk ConInfo{} = False
862 closureSingleEntry :: ClosureInfo -> Bool
863 closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
864 closureSingleEntry _ = False
866 closureReEntrant :: ClosureInfo -> Bool
867 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
868 closureReEntrant _ = False
870 isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon
871 isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con
872 isConstrClosure_maybe _ = Nothing
874 closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
875 closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info
876 closureFunInfo _ = Nothing
878 lfFunInfo :: LambdaFormInfo -> Maybe (Int, ArgDescr)
879 lfFunInfo (LFReEntrant _ arity _ arg_desc) = Just (arity, arg_desc)
880 lfFunInfo _ = Nothing
882 funTag :: ClosureInfo -> Int
883 funTag (ClosureInfo { closureLFInfo = lf_info }) = funTagLFInfo lf_info
886 -- maybe this should do constructor tags too?
887 funTagLFInfo :: LambdaFormInfo -> Int
889 -- A function is tagged with its arity
890 | Just (arity,_) <- lfFunInfo lf,
891 Just tag <- tagForArity arity
894 -- other closures (and unknown ones) are not tagged
898 tagForArity :: Int -> Maybe Int
899 tagForArity i | i <= mAX_PTR_TAG = Just i
900 | otherwise = Nothing
904 isToplevClosure :: ClosureInfo -> Bool
905 isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
907 LFReEntrant TopLevel _ _ _ -> True
908 LFThunk TopLevel _ _ _ _ -> True
910 isToplevClosure _ = False
916 infoTableLabelFromCI :: ClosureInfo -> CafInfo -> CLabel
917 infoTableLabelFromCI (ClosureInfo { closureName = name,
918 closureLFInfo = lf_info }) caf
920 LFBlackHole info -> info
922 LFThunk _ _ upd_flag (SelectorThunk offset) _ ->
923 mkSelectorInfoLabel upd_flag offset
925 LFThunk _ _ upd_flag (ApThunk arity) _ ->
926 mkApInfoTableLabel upd_flag arity
928 LFThunk{} -> mkLocalInfoTableLabel name caf
930 LFReEntrant _ _ _ _ -> mkLocalInfoTableLabel name caf
932 _ -> panic "infoTableLabelFromCI"
934 infoTableLabelFromCI (ConInfo { closureCon = con,
935 closureSMRep = rep }) caf
936 | isStaticRep rep = mkStaticInfoTableLabel name caf
937 | otherwise = mkConInfoTableLabel name caf
939 name = dataConName con
941 -- ClosureInfo for a closure (as opposed to a constructor) is always local
942 closureLabelFromCI :: ClosureInfo -> CafInfo -> CLabel
943 closureLabelFromCI (ClosureInfo { closureName = nm }) caf = mkLocalClosureLabel nm caf
944 closureLabelFromCI _ _ = panic "closureLabelFromCI"
946 -- thunkEntryLabel is a local help function, not exported. It's used from both
947 -- entryLabelFromCI and getCallMethod.
949 thunkEntryLabel :: Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel
950 thunkEntryLabel _thunk_id _ (ApThunk arity) is_updatable
951 = enterApLabel is_updatable arity
952 thunkEntryLabel _thunk_id _ (SelectorThunk offset) upd_flag
953 = enterSelectorLabel upd_flag offset
954 thunkEntryLabel thunk_id caf _ _is_updatable
955 = enterIdLabel thunk_id caf
957 enterApLabel :: Bool -> Int -> CLabel
958 enterApLabel is_updatable arity
959 | tablesNextToCode = mkApInfoTableLabel is_updatable arity
960 | otherwise = mkApEntryLabel is_updatable arity
962 enterSelectorLabel :: Bool -> Int -> CLabel
963 enterSelectorLabel upd_flag offset
964 | tablesNextToCode = mkSelectorInfoLabel upd_flag offset
965 | otherwise = mkSelectorEntryLabel upd_flag offset
967 enterIdLabel :: Name -> CafInfo -> CLabel
969 | tablesNextToCode = mkInfoTableLabel id
970 | otherwise = mkEntryLabel id
972 enterLocalIdLabel :: Name -> CafInfo -> CLabel
974 | tablesNextToCode = mkLocalInfoTableLabel id
975 | otherwise = mkLocalEntryLabel id
977 enterReturnPtLabel :: Unique -> CLabel
978 enterReturnPtLabel name
979 | tablesNextToCode = mkReturnInfoLabel name
980 | otherwise = mkReturnPtLabel name
984 We need a black-hole closure info to pass to @allocDynClosure@ when we
985 want to allocate the black hole on entry to a CAF. These are the only
986 ways to build an LFBlackHole, maintaining the invariant that it really
987 is a black hole and not something else.
990 cafBlackHoleClosureInfo :: ClosureInfo -> ClosureInfo
991 cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
993 = ClosureInfo { closureName = nm,
994 closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel,
995 closureSMRep = BlackHoleRep,
996 closureSRT = NoC_SRT,
999 cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
1002 %************************************************************************
1004 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
1006 %************************************************************************
1008 Profiling requires two pieces of information to be determined for
1009 each closure's info table --- description and type.
1011 The description is stored directly in the @CClosureInfoTable@ when the
1012 info table is built.
1014 The type is determined from the type information stored with the @Id@
1015 in the closure info using @closureTypeDescr@.
1018 closureValDescr, closureTypeDescr :: ClosureInfo -> String
1019 closureValDescr (ClosureInfo {closureDescr = descr})
1021 closureValDescr (ConInfo {closureCon = con})
1022 = occNameString (getOccName con)
1024 closureTypeDescr (ClosureInfo { closureType = ty })
1025 = getTyDescription ty
1026 closureTypeDescr (ConInfo { closureCon = data_con })
1027 = occNameString (getOccName (dataConTyCon data_con))
1029 getTyDescription :: Type -> String
1031 = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
1034 AppTy fun _ -> getTyDescription fun
1035 FunTy _ res -> '-' : '>' : fun_result res
1036 TyConApp tycon _ -> getOccString tycon
1037 PredTy sty -> getPredTyDescription sty
1038 ForAllTy _ ty -> getTyDescription ty
1041 fun_result (FunTy _ res) = '>' : fun_result res
1042 fun_result other = getTyDescription other
1044 getPredTyDescription :: PredType -> String
1045 getPredTyDescription (ClassP cl _) = getOccString cl
1046 getPredTyDescription (IParam ip _) = getOccString (ipNameName ip)
1047 getPredTyDescription (EqPred _ _) = panic "getPredTyDescription EqPred"