2 % (c) The Univserity of Glasgow 1992-2004
5 Data structures which describe closures, and
6 operations over those data structures
8 Nothing monadic in here
10 Much of the rationale for these things is in the ``details'' part of
15 ClosureInfo, LambdaFormInfo, SMRep, -- all abstract
18 ArgDescr(..), Liveness(..),
21 mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,
22 mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
24 mkClosureInfo, mkConInfo,
26 closureSize, closureNonHdrSize,
27 closureGoodStuffSize, closurePtrsSize,
30 closureName, infoTableLabelFromCI,
31 closureLabelFromCI, closureSRT,
32 closureLFInfo, closureSMRep, closureUpdReqd,
33 closureSingleEntry, closureReEntrant, isConstrClosure_maybe,
34 closureFunInfo, isStandardFormThunk, isKnownFun,
36 enterIdLabel, enterReturnPtLabel,
39 CallMethod(..), getCallMethod,
43 staticClosureRequired,
47 closureValDescr, closureTypeDescr, -- profiling
50 cafBlackHoleClosureInfo, seCafBlackHoleClosureInfo,
52 staticClosureNeedsLink,
55 #include "../includes/MachDeps.h"
56 #include "HsVersions.h"
59 import SMRep -- all of it
63 import Constants ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject )
64 import CmdLineOpts ( opt_SccProfilingOn, opt_OmitBlackHoling,
65 opt_Parallel, opt_DoTickyProfiling,
67 import Id ( Id, idType, idArity, idName )
68 import DataCon ( DataCon, dataConTyCon, isNullaryDataCon, dataConName )
69 import Name ( Name, nameUnique, getOccName, getOccString )
70 import OccName ( occNameUserString )
71 import Type ( isUnLiftedType, Type, repType, splitTyConApp_maybe )
72 import TcType ( tcSplitSigmaTy )
73 import TyCon ( isFunTyCon, isAbstractTyCon )
74 import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel, ipNameName )
79 import TypeRep -- TEMP
83 %************************************************************************
85 \subsection[ClosureInfo-datatypes]{Data types for closure information}
87 %************************************************************************
89 Information about a closure, from the code generator's point of view.
91 A ClosureInfo decribes the info pointer of a closure. It has
93 a) to construct the info table itself
94 b) to allocate a closure containing that info pointer (i.e.
95 it knows the info table label)
97 We make a ClosureInfo for
98 - each let binding (both top level and not)
99 - each data constructor (for its shared static and
105 closureName :: !Name, -- The thing bound to this closure
106 closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon (see below)
107 closureSMRep :: !SMRep, -- representation used by storage mgr
108 closureSRT :: !C_SRT, -- What SRT applies to this closure
109 closureType :: !Type, -- Type of closure (ToDo: remove)
110 closureDescr :: !String -- closure description (for profiling)
113 -- Constructor closures don't have a unique info table label (they use
114 -- the constructor's info table), and they don't have an SRT.
116 closureCon :: !DataCon,
117 closureSMRep :: !SMRep
120 -- C_SRT is what StgSyn.SRT gets translated to...
121 -- we add a label for the table, and expect only the 'offset/length' form
124 | C_SRT !CLabel !WordOff !StgHalfWord {-bitmap or escape-}
126 needsSRT :: C_SRT -> Bool
127 needsSRT NoC_SRT = False
128 needsSRT (C_SRT _ _ _) = True
131 %************************************************************************
133 \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
135 %************************************************************************
137 Information about an identifier, from the code generator's point of
138 view. Every identifier is bound to a LambdaFormInfo in the
139 environment, which gives the code generator enough info to be able to
140 tail call or return that identifier.
142 Note that a closure is usually bound to an identifier, so a
143 ClosureInfo contains a LambdaFormInfo.
147 = LFReEntrant -- Reentrant closure (a function)
148 TopLevelFlag -- True if top level
149 !Int -- Arity. Invariant: always > 0
150 !Bool -- True <=> no fvs
151 ArgDescr -- Argument descriptor (should reall be in ClosureInfo)
153 | LFCon -- A saturated constructor application
154 DataCon -- The constructor
156 | LFThunk -- Thunk (zero arity)
158 !Bool -- True <=> no free vars
159 !Bool -- True <=> updatable (i.e., *not* single-entry)
161 !Bool -- True <=> *might* be a function type
163 | LFUnknown -- Used for function arguments and imported things.
164 -- We know nothing about this closure. Treat like
165 -- updatable "LFThunk"...
166 -- Imported things which we do know something about use
167 -- one of the other LF constructors (eg LFReEntrant for
169 !Bool -- True <=> *might* be a function type
171 | LFLetNoEscape -- See LetNoEscape module for precise description of
175 | LFBlackHole -- Used for the closures allocated to hold the result
176 -- of a CAF. We want the target of the update frame to
177 -- be in the heap, so we make a black hole to hold it.
178 CLabel -- Flavour (info label, eg CAF_BLACKHOLE_info).
181 -------------------------
182 -- An ArgDsecr describes the argument pattern of a function
185 = ArgSpec -- Fits one of the standard patterns
186 !Int -- RTS type identifier ARG_P, ARG_N, ...
188 | ArgGen -- General case
189 Liveness -- Details about the arguments
192 -------------------------
193 -- We represent liveness bitmaps as a Bitmap (whose internal
194 -- representation really is a bitmap). These are pinned onto case return
195 -- vectors to indicate the state of the stack for the garbage collector.
197 -- In the compiled program, liveness bitmaps that fit inside a single
198 -- word (StgWord) are stored as a single word, while larger bitmaps are
199 -- stored as a pointer to an array of words.
202 = SmallLiveness -- Liveness info that fits in one word
203 StgWord -- Here's the bitmap
205 | BigLiveness -- Liveness info witha a multi-word bitmap
206 CLabel -- Label for the bitmap
209 -------------------------
210 -- StandardFormInfo tells whether this thunk has one of
211 -- a small number of standard forms
213 data StandardFormInfo
215 -- Not of of the standard forms
218 -- A SelectorThunk is of form
220 -- con a1,..,an -> ak
221 -- and the constructor is from a single-constr type.
222 WordOff -- 0-origin offset of ak within the "goods" of
223 -- constructor (Recall that the a1,...,an may be laid
224 -- out in the heap in a non-obvious order.)
227 -- An ApThunk is of form
229 -- The code for the thunk just pushes x2..xn on the stack and enters x1.
230 -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
231 -- in the RTS to save space.
235 %************************************************************************
237 \subsection[ClosureInfo-construction]{Functions which build LFInfos}
239 %************************************************************************
242 mkLFReEntrant :: TopLevelFlag -- True of top level
245 -> ArgDescr -- Argument descriptor
248 mkLFReEntrant top fvs args arg_descr
249 = LFReEntrant top (length args) (null fvs) arg_descr
251 mkLFThunk thunk_ty top fvs upd_flag
252 = ASSERT( not (isUpdatable upd_flag) || not (isUnLiftedType thunk_ty) )
253 LFThunk top (null fvs)
254 (isUpdatable upd_flag)
256 (might_be_a_function thunk_ty)
258 might_be_a_function :: Type -> Bool
259 might_be_a_function ty
260 | Just (tc,_) <- splitTyConApp_maybe (repType ty),
261 not (isFunTyCon tc) && not (isAbstractTyCon tc) = False
262 -- don't forget to check for abstract types, which might
267 @mkConLFInfo@ is similar, for constructors.
270 mkConLFInfo :: DataCon -> LambdaFormInfo
271 mkConLFInfo con = LFCon con
273 mkSelectorLFInfo id offset updatable
274 = LFThunk NotTopLevel False updatable (SelectorThunk offset)
275 (might_be_a_function (idType id))
277 mkApLFInfo id upd_flag arity
278 = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)
279 (might_be_a_function (idType id))
282 Miscellaneous LF-infos.
285 mkLFArgument id = LFUnknown (might_be_a_function (idType id))
287 mkLFLetNoEscape = LFLetNoEscape
289 mkLFImported :: Id -> LambdaFormInfo
292 n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr") -- n > 0
293 other -> mkLFArgument id -- Not sure of exact arity
296 %************************************************************************
298 Building ClosureInfos
300 %************************************************************************
303 mkClosureInfo :: Bool -- Is static
306 -> Int -> Int -- Total and pointer words
308 -> String -- String descriptor
310 mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr
311 = ClosureInfo { closureName = name,
312 closureLFInfo = lf_info,
313 closureSMRep = sm_rep,
314 closureSRT = srt_info,
315 closureType = idType id,
316 closureDescr = descr }
319 sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds
321 mkConInfo :: Bool -- Is static
323 -> Int -> Int -- Total and pointer words
325 mkConInfo is_static data_con tot_wds ptr_wds
326 = ConInfo { closureSMRep = sm_rep,
327 closureCon = data_con }
329 sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds
332 %************************************************************************
334 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
336 %************************************************************************
339 closureSize :: ClosureInfo -> WordOff
340 closureSize cl_info = fixedHdrSize + closureNonHdrSize cl_info
342 closureNonHdrSize :: ClosureInfo -> WordOff
343 closureNonHdrSize cl_info
344 = tot_wds + computeSlopSize tot_wds
345 (closureSMRep cl_info)
346 (closureNeedsUpdSpace cl_info)
348 tot_wds = closureGoodStuffSize cl_info
350 -- we leave space for an update if either (a) the closure is updatable
351 -- or (b) it is a static thunk. This is because a static thunk needs
352 -- a static link field in a predictable place (after the slop), regardless
353 -- of whether it is updatable or not.
354 closureNeedsUpdSpace (ClosureInfo { closureLFInfo =
355 LFThunk TopLevel _ _ _ _ }) = True
356 closureNeedsUpdSpace cl_info = closureUpdReqd cl_info
358 slopSize :: ClosureInfo -> WordOff
360 = computeSlopSize (closureGoodStuffSize cl_info)
361 (closureSMRep cl_info)
362 (closureNeedsUpdSpace cl_info)
364 closureGoodStuffSize :: ClosureInfo -> WordOff
365 closureGoodStuffSize cl_info
366 = let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info)
369 closurePtrsSize :: ClosureInfo -> WordOff
370 closurePtrsSize cl_info
371 = let (ptrs, _) = sizes_from_SMRep (closureSMRep cl_info)
375 sizes_from_SMRep :: SMRep -> (WordOff,WordOff)
376 sizes_from_SMRep (GenericRep _ ptrs nonptrs _) = (ptrs, nonptrs)
377 sizes_from_SMRep BlackHoleRep = (0, 0)
380 Computing slop size. WARNING: this looks dodgy --- it has deep
381 knowledge of what the storage manager does with the various
387 Updateable closures must be @mIN_UPD_SIZE@.
390 Indirections require 1 word
392 Appels collector indirections 2 words
394 THEREFORE: @mIN_UPD_SIZE = 2@.
397 Collectable closures which are allocated in the heap
398 must be @mIN_SIZE_NonUpdHeapObject@.
400 Copying collector forward pointer requires 1 word
402 THEREFORE: @mIN_SIZE_NonUpdHeapObject = 1@
405 Static closures have an extra ``static link field'' at the end, but we
406 don't bother taking that into account here.
409 computeSlopSize :: WordOff -> SMRep -> Bool -> WordOff
411 computeSlopSize tot_wds (GenericRep _ _ _ _) True -- Updatable
412 = max 0 (mIN_UPD_SIZE - tot_wds)
414 computeSlopSize tot_wds (GenericRep True _ _ _) False -- Non updatable
417 computeSlopSize tot_wds (GenericRep False _ _ _) False -- Non updatable
418 = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds) -- Dynamic
420 computeSlopSize tot_wds BlackHoleRep _ -- Updatable
421 = max 0 (mIN_UPD_SIZE - tot_wds)
424 %************************************************************************
426 \subsection[SMreps]{Choosing SM reps}
428 %************************************************************************
432 :: Bool -- True <=> static closure
434 -> WordOff -> WordOff -- Tot wds, ptr wds
437 chooseSMRep is_static lf_info tot_wds ptr_wds
439 nonptr_wds = tot_wds - ptr_wds
440 closure_type = getClosureType is_static ptr_wds lf_info
442 GenericRep is_static ptr_wds nonptr_wds closure_type
444 -- We *do* get non-updatable top-level thunks sometimes. eg. f = g
445 -- gets compiled to a jump to g (if g has non-zero arity), instead of
446 -- messing around with update frames and PAPs. We set the closure type
447 -- to FUN_STATIC in this case.
449 getClosureType :: Bool -> WordOff -> LambdaFormInfo -> ClosureType
450 getClosureType is_static ptr_wds lf_info
452 LFCon con | is_static && ptr_wds == 0 -> ConstrNoCaf
453 | otherwise -> Constr
454 LFReEntrant _ _ _ _ -> Fun
455 LFThunk _ _ _ (SelectorThunk _) _ -> ThunkSelector
456 LFThunk _ _ _ _ _ -> Thunk
457 _ -> panic "getClosureType"
460 %************************************************************************
462 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
464 %************************************************************************
466 Be sure to see the stg-details notes about these...
469 nodeMustPointToIt :: LambdaFormInfo -> Bool
470 nodeMustPointToIt (LFReEntrant top _ no_fvs _)
471 = not no_fvs || -- Certainly if it has fvs we need to point to it
473 -- If it is not top level we will point to it
474 -- We can have a \r closure with no_fvs which
475 -- is not top level as special case cgRhsClosure
476 -- has been dissabled in favour of let floating
478 -- For lex_profiling we also access the cost centre for a
479 -- non-inherited function i.e. not top level
480 -- the not top case above ensures this is ok.
482 nodeMustPointToIt (LFCon _) = True
484 -- Strictly speaking, the above two don't need Node to point
485 -- to it if the arity = 0. But this is a *really* unlikely
486 -- situation. If we know it's nil (say) and we are entering
487 -- it. Eg: let x = [] in x then we will certainly have inlined
488 -- x, since nil is a simple atom. So we gain little by not
489 -- having Node point to known zero-arity things. On the other
490 -- hand, we do lose something; Patrick's code for figuring out
491 -- when something has been updated but not entered relies on
492 -- having Node point to the result of an update. SLPJ
495 nodeMustPointToIt (LFThunk _ no_fvs updatable NonStandardThunk _)
496 = updatable || not no_fvs || opt_SccProfilingOn
497 -- For the non-updatable (single-entry case):
499 -- True if has fvs (in which case we need access to them, and we
500 -- should black-hole it)
501 -- or profiling (in which case we need to recover the cost centre
504 nodeMustPointToIt (LFThunk _ no_fvs updatable some_standard_form_thunk _)
505 = True -- Node must point to any standard-form thunk
507 nodeMustPointToIt (LFUnknown _) = True
508 nodeMustPointToIt (LFBlackHole _) = True -- BH entry may require Node to point
509 nodeMustPointToIt (LFLetNoEscape _) = False
512 The entry conventions depend on the type of closure being entered,
513 whether or not it has free variables, and whether we're running
514 sequentially or in parallel.
516 \begin{tabular}{lllll}
517 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
518 Unknown & no & yes & stack & node \\
519 Known fun ($\ge$ 1 arg), no fvs & no & no & registers & fast entry (enough args) \\
520 \ & \ & \ & \ & slow entry (otherwise) \\
521 Known fun ($\ge$ 1 arg), fvs & no & yes & registers & fast entry (enough args) \\
522 0 arg, no fvs @\r,\s@ & no & no & n/a & direct entry \\
523 0 arg, no fvs @\u@ & no & yes & n/a & node \\
524 0 arg, fvs @\r,\s@ & no & yes & n/a & direct entry \\
525 0 arg, fvs @\u@ & no & yes & n/a & node \\
527 Unknown & yes & yes & stack & node \\
528 Known fun ($\ge$ 1 arg), no fvs & yes & no & registers & fast entry (enough args) \\
529 \ & \ & \ & \ & slow entry (otherwise) \\
530 Known fun ($\ge$ 1 arg), fvs & yes & yes & registers & node \\
531 0 arg, no fvs @\r,\s@ & yes & no & n/a & direct entry \\
532 0 arg, no fvs @\u@ & yes & yes & n/a & node \\
533 0 arg, fvs @\r,\s@ & yes & yes & n/a & node \\
534 0 arg, fvs @\u@ & yes & yes & n/a & node\\
537 When black-holing, single-entry closures could also be entered via node
538 (rather than directly) to catch double-entry.
542 = EnterIt -- no args, not a function
544 | JumpToIt CLabel -- no args, not a function, but we
545 -- know what its entry code is
547 | ReturnIt -- it's a function, but we have
548 -- zero args to apply to it, so just
551 | ReturnCon DataCon -- It's a data constructor, just return it
553 | SlowCall -- Unknown fun, or known fun with
556 | DirectEntry -- Jump directly, with args in regs
557 CLabel -- The code label
560 getCallMethod :: Name -- Function being applied
561 -> LambdaFormInfo -- Its info
562 -> Int -- Number of available arguments
565 getCallMethod name lf_info n_args
566 | nodeMustPointToIt lf_info && opt_Parallel
567 = -- If we're parallel, then we must always enter via node.
568 -- The reason is that the closure may have been
569 -- fetched since we allocated it.
572 getCallMethod name (LFReEntrant _ arity _ _) n_args
573 | n_args == 0 = ASSERT( arity /= 0 )
574 ReturnIt -- No args at all
575 | n_args < arity = SlowCall -- Not enough args
576 | otherwise = DirectEntry (enterIdLabel name) arity
578 getCallMethod name (LFCon con) n_args
579 = ASSERT( n_args == 0 )
582 getCallMethod name (LFThunk _ _ updatable std_form_info is_fun) n_args
583 | is_fun -- Must always "call" a function-typed
584 = SlowCall -- thing, cannot just enter it [in eval/apply, the entry code
585 -- is the fast-entry code]
587 | updatable || opt_DoTickyProfiling -- to catch double entry
588 || opt_SMP -- Always enter via node on SMP, since the
589 -- thunk might have been blackholed in the
591 = ASSERT( n_args == 0 ) EnterIt
593 | otherwise -- Jump direct to code for single-entry thunks
594 = ASSERT( n_args == 0 )
595 JumpToIt (thunkEntryLabel name std_form_info updatable)
597 getCallMethod name (LFUnknown True) n_args
598 = SlowCall -- might be a function
600 getCallMethod name (LFUnknown False) n_args
601 = ASSERT2 ( n_args == 0, ppr name <+> ppr n_args )
602 EnterIt -- Not a function
604 getCallMethod name (LFBlackHole _) n_args
605 = SlowCall -- Presumably the black hole has by now
606 -- been updated, but we don't know with
607 -- what, so we slow call it
609 getCallMethod name (LFLetNoEscape 0) n_args
610 = JumpToIt (enterReturnPtLabel (nameUnique name))
612 getCallMethod name (LFLetNoEscape arity) n_args
613 | n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity
614 | otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity)
616 blackHoleOnEntry :: ClosureInfo -> Bool
617 -- Static closures are never themselves black-holed.
618 -- Updatable ones will be overwritten with a CAFList cell, which points to a
620 -- Single-entry ones have no fvs to plug, and we trust they don't form part
623 blackHoleOnEntry ConInfo{} = False
624 blackHoleOnEntry (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
626 = False -- Never black-hole a static closure
630 LFReEntrant _ _ _ _ -> False
631 LFLetNoEscape _ -> False
632 LFThunk _ no_fvs updatable _ _
634 then not opt_OmitBlackHoling
635 else opt_DoTickyProfiling || not no_fvs
636 -- the former to catch double entry,
637 -- and the latter to plug space-leaks. KSW/SDM 1999-04.
639 other -> panic "blackHoleOnEntry" -- Should never happen
641 isStandardFormThunk :: LambdaFormInfo -> Bool
642 isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
643 isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _) = True
644 isStandardFormThunk other_lf_info = False
646 isKnownFun :: LambdaFormInfo -> Bool
647 isKnownFun (LFReEntrant _ _ _ _) = True
648 isKnownFun (LFLetNoEscape _) = True
652 -----------------------------------------------------------------------------
656 staticClosureNeedsLink :: ClosureInfo -> Bool
657 -- A static closure needs a link field to aid the GC when traversing
658 -- the static closure graph. But it only needs such a field if either
660 -- b) it's a constructor with one or more pointer fields
661 -- In case (b), the constructor's fields themselves play the role
663 staticClosureNeedsLink (ClosureInfo { closureSRT = srt })
665 staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })
666 = not (isNullaryDataCon con) && not_nocaf_constr
670 GenericRep _ _ _ ConstrNoCaf -> False
674 Avoiding generating entries and info tables
675 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
676 At present, for every function we generate all of the following,
677 just in case. But they aren't always all needed, as noted below:
679 [NB1: all of this applies only to *functions*. Thunks always
680 have closure, info table, and entry code.]
682 [NB2: All are needed if the function is *exported*, just to play safe.]
685 * Fast-entry code ALWAYS NEEDED
688 Needed iff (a) we have any un-saturated calls to the function
689 OR (b) the function is passed as an arg
690 OR (c) we're in the parallel world and the function has free vars
691 [Reason: in parallel world, we always enter functions
692 with free vars via the closure.]
694 * The function closure
695 Needed iff (a) we have any un-saturated calls to the function
696 OR (b) the function is passed as an arg
697 OR (c) if the function has free vars (ie not top level)
699 Why case (a) here? Because if the arg-satis check fails,
700 UpdatePAP stuffs a pointer to the function closure in the PAP.
701 [Could be changed; UpdatePAP could stuff in a code ptr instead,
702 but doesn't seem worth it.]
704 [NB: these conditions imply that we might need the closure
705 without the slow-entry code. Here's how.
707 f x y = let g w = ...x..y..w...
711 Here we need a closure for g which contains x and y,
712 but since the calls are all saturated we just jump to the
713 fast entry point for g, with R1 pointing to the closure for g.]
716 * Standard info table
717 Needed iff (a) we have any un-saturated calls to the function
718 OR (b) the function is passed as an arg
719 OR (c) the function has free vars (ie not top level)
721 NB. In the sequential world, (c) is only required so that the function closure has
722 an info table to point to, to keep the storage manager happy.
723 If (c) alone is true we could fake up an info table by choosing
724 one of a standard family of info tables, whose entry code just
727 [NB In the parallel world (c) is needed regardless because
728 we enter functions with free vars via the closure.]
730 If (c) is retained, then we'll sometimes generate an info table
731 (for storage mgr purposes) without slow-entry code. Then we need
732 to use an error label in the info table to substitute for the absent
736 staticClosureRequired
741 staticClosureRequired binder bndr_info
742 (LFReEntrant top_level _ _ _) -- It's a function
743 = ASSERT( isTopLevel top_level )
744 -- Assumption: it's a top-level, no-free-var binding
745 not (satCallsOnly bndr_info)
747 staticClosureRequired binder other_binder_info other_lf_info = True
750 %************************************************************************
752 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
754 %************************************************************************
758 isStaticClosure :: ClosureInfo -> Bool
759 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
761 closureUpdReqd :: ClosureInfo -> Bool
762 closureUpdReqd (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _ }) = upd
763 closureUpdReqd (ClosureInfo { closureLFInfo = LFBlackHole _ }) = True
764 -- Black-hole closures are allocated to receive the results of an
765 -- alg case with a named default... so they need to be updated.
766 closureUpdReqd other_closure = False
768 closureSingleEntry :: ClosureInfo -> Bool
769 closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
770 closureSingleEntry other_closure = False
772 closureReEntrant :: ClosureInfo -> Bool
773 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
774 closureReEntrant other_closure = False
776 isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon
777 isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con
778 isConstrClosure_maybe _ = Nothing
780 closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
781 closureFunInfo (ClosureInfo { closureLFInfo = LFReEntrant _ arity _ arg_desc})
782 = Just (arity, arg_desc)
788 isToplevClosure :: ClosureInfo -> Bool
789 isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
791 LFReEntrant TopLevel _ _ _ -> True
792 LFThunk TopLevel _ _ _ _ -> True
794 isToplevClosure _ = False
800 infoTableLabelFromCI :: ClosureInfo -> CLabel
801 infoTableLabelFromCI (ClosureInfo { closureName = name,
802 closureLFInfo = lf_info,
803 closureSMRep = rep })
805 LFBlackHole info -> info
807 LFThunk _ _ upd_flag (SelectorThunk offset) _ ->
808 mkSelectorInfoLabel upd_flag offset
810 LFThunk _ _ upd_flag (ApThunk arity) _ ->
811 mkApInfoTableLabel upd_flag arity
813 LFThunk{} -> mkInfoTableLabel name
815 LFReEntrant _ _ _ _ -> mkInfoTableLabel name
817 other -> panic "infoTableLabelFromCI"
819 infoTableLabelFromCI (ConInfo { closureCon = con, closureSMRep = rep })
820 = mkConInfoPtr con rep
823 mkConInfoPtr :: DataCon -> SMRep -> CLabel
825 | isStaticRep rep = mkStaticInfoTableLabel name
826 | otherwise = mkConInfoTableLabel name
828 name = dataConName con
830 closureLabelFromCI (ClosureInfo { closureName = nm }) = mkClosureLabel nm
831 closureLabelFromCI _ = panic "closureLabelFromCI"
833 -- thunkEntryLabel is a local help function, not exported. It's used from both
834 -- entryLabelFromCI and getCallMethod.
836 thunkEntryLabel thunk_id (ApThunk arity) is_updatable
837 = enterApLabel is_updatable arity
838 thunkEntryLabel thunk_id (SelectorThunk offset) upd_flag
839 = enterSelectorLabel upd_flag offset
840 thunkEntryLabel thunk_id _ is_updatable
841 = enterIdLabel thunk_id
843 enterApLabel is_updatable arity
844 | tablesNextToCode = mkApInfoTableLabel is_updatable arity
845 | otherwise = mkApEntryLabel is_updatable arity
847 enterSelectorLabel upd_flag offset
848 | tablesNextToCode = mkSelectorInfoLabel upd_flag offset
849 | otherwise = mkSelectorEntryLabel upd_flag offset
852 | tablesNextToCode = mkInfoTableLabel id
853 | otherwise = mkEntryLabel id
855 enterReturnPtLabel name
856 | tablesNextToCode = mkReturnInfoLabel name
857 | otherwise = mkReturnPtLabel name
861 We need a black-hole closure info to pass to @allocDynClosure@ when we
862 want to allocate the black hole on entry to a CAF. These are the only
863 ways to build an LFBlackHole, maintaining the invariant that it really
864 is a black hole and not something else.
867 cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
869 = ClosureInfo { closureName = nm,
870 closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel,
871 closureSMRep = BlackHoleRep,
872 closureSRT = NoC_SRT,
875 cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
877 seCafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
879 = ClosureInfo { closureName = nm,
880 closureLFInfo = LFBlackHole mkSECAFBlackHoleInfoTableLabel,
881 closureSMRep = BlackHoleRep,
882 closureSRT = NoC_SRT,
885 seCafBlackHoleClosureInfo _ = panic "seCafBlackHoleClosureInfo"
888 %************************************************************************
890 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
892 %************************************************************************
894 Profiling requires two pieces of information to be determined for
895 each closure's info table --- description and type.
897 The description is stored directly in the @CClosureInfoTable@ when the
900 The type is determined from the type information stored with the @Id@
901 in the closure info using @closureTypeDescr@.
904 closureValDescr, closureTypeDescr :: ClosureInfo -> String
905 closureValDescr (ClosureInfo {closureDescr = descr})
907 closureValDescr (ConInfo {closureCon = con})
908 = occNameUserString (getOccName con)
910 closureTypeDescr (ClosureInfo { closureType = ty })
911 = getTyDescription ty
912 closureTypeDescr (ConInfo { closureCon = data_con })
913 = occNameUserString (getOccName (dataConTyCon data_con))
915 getTyDescription :: Type -> String
917 = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
920 AppTy fun _ -> getTyDescription fun
921 FunTy _ res -> '-' : '>' : fun_result res
922 NewTcApp tycon _ -> getOccString tycon
923 TyConApp tycon _ -> getOccString tycon
924 NoteTy (FTVNote _) ty -> getTyDescription ty
925 NoteTy (SynNote ty1) _ -> getTyDescription ty1
926 PredTy sty -> getPredTyDescription sty
927 ForAllTy _ ty -> getTyDescription ty
930 fun_result (FunTy _ res) = '>' : fun_result res
931 fun_result other = getTyDescription other
933 getPredTyDescription (ClassP cl tys) = getOccString cl
934 getPredTyDescription (IParam ip ty) = getOccString (ipNameName ip)