2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: ClosureInfo.lhs,v 1.31 1998/12/02 13:17:55 simonm Exp $
6 \section[ClosureInfo]{Data structures which describe closures}
8 Much of the rationale for these things is in the ``details'' part of
13 ClosureInfo, LambdaFormInfo, SMRep, -- all abstract
18 mkClosureLFInfo, mkConLFInfo, mkSelectorLFInfo,
19 mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
22 closureSize, closureNonHdrSize,
23 closureGoodStuffSize, closurePtrsSize,
26 layOutDynClosure, layOutDynCon, layOutStaticClosure,
27 layOutStaticNoFVClosure,
30 nodeMustPointToIt, getEntryConvention,
31 FCode, CgInfoDownwards, CgState,
35 staticClosureRequired,
36 slowFunEntryCodeRequired, funInfoTableRequired,
38 closureName, infoTableLabelFromCI, fastLabelFromCI,
41 closureLFInfo, closureSMRep, closureUpdReqd,
42 closureSingleEntry, closureSemiTag,
47 closureTypeDescr, -- profiling
56 #include "HsVersions.h"
58 import AbsCSyn ( MagicId, node, VirtualHeapOffset, HeapOffset )
62 import Constants ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject )
63 import CgRetConv ( assignRegs )
64 import CLabel ( CLabel, mkStdEntryLabel, mkFastEntryLabel,
66 mkConInfoTableLabel, mkStaticClosureLabel,
67 mkBlackHoleInfoTableLabel,
68 mkStaticInfoTableLabel, mkStaticConEntryLabel,
69 mkConEntryLabel, mkClosureLabel,
70 mkSelectorInfoLabel, mkSelectorEntryLabel,
71 mkApInfoTableLabel, mkApEntryLabel,
74 import CmdLineOpts ( opt_SccProfilingOn, opt_OmitBlackHoling,
76 import Id ( Id, idType, getIdArity )
77 import DataCon ( DataCon, dataConTag, fIRST_TAG,
78 isNullaryDataCon, isTupleCon, dataConName
80 import IdInfo ( ArityInfo(..) )
81 import Name ( Name, isExternallyVisibleName, nameUnique )
82 import PprType ( getTyDescription )
83 import PrimRep ( getPrimRepSize, separateByPtrFollowness, PrimRep )
84 import SMRep -- all of it
85 import Type ( isUnLiftedType, Type )
86 import BasicTypes ( TopLevelFlag(..) )
87 import Util ( mapAccumL )
91 The ``wrapper'' data type for closure information:
96 Name -- The thing bound to this closure
97 LambdaFormInfo -- info derivable from the *source*
98 SMRep -- representation used by storage manager
101 %************************************************************************
103 \subsection[ClosureInfo-datatypes]{Data types for closure information}
105 %************************************************************************
107 %************************************************************************
109 \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
111 %************************************************************************
115 = LFReEntrant -- Reentrant closure; used for PAPs too
116 Type -- Type of closure (ToDo: remove)
117 TopLevelFlag -- True if top level
119 !Bool -- True <=> no fvs
121 | LFCon -- Constructor
122 DataCon -- The constructor
123 Bool -- True <=> zero arity
126 DataCon -- The tuple constructor
127 Bool -- True <=> zero arity
129 | LFThunk -- Thunk (zero arity)
130 Type -- Type of the thunk (ToDo: remove)
132 !Bool -- True <=> no free vars
133 Bool -- True <=> updatable (i.e., *not* single-entry)
136 | LFArgument -- Used for function arguments. We know nothing about
137 -- this closure. Treat like updatable "LFThunk"...
139 | LFImported -- Used for imported things. We know nothing about this
140 -- closure. Treat like updatable "LFThunk"...
141 -- Imported things which we do know something about use
142 -- one of the other LF constructors (eg LFReEntrant for
145 | LFLetNoEscape -- See LetNoEscape module for precise description of
149 | LFBlackHole -- Used for the closures allocated to hold the result
151 -- of a CAF. We want the target of the update frame to
152 -- be in the heap, so we make a black hole to hold it.
155 data StandardFormInfo -- Tells whether this thunk has one of a small number
158 = NonStandardThunk -- No, it isn't
161 Int -- 0-origin offset of ak within the "goods" of
162 -- constructor (Recall that the a1,...,an may be laid
163 -- out in the heap in a non-obvious order.)
165 {- A SelectorThunk is of form
170 and the constructor is from a single-constr type.
176 {- An ApThunk is of form
180 The code for the thunk just pushes x2..xn on the stack and enters x1.
181 There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
182 in the RTS to save space.
187 %************************************************************************
189 \subsection[ClosureInfo-construction]{Functions which build LFInfos}
191 %************************************************************************
193 @mkClosureLFInfo@ figures out the appropriate LFInfo for the closure.
196 mkClosureLFInfo :: Id -- The binder
197 -> TopLevelFlag -- True of top level
199 -> UpdateFlag -- Update flag
203 mkClosureLFInfo bndr top fvs upd_flag args@(_:_) -- Non-empty args
204 = LFReEntrant (idType bndr) top (length args) (null fvs)
206 mkClosureLFInfo bndr top fvs ReEntrant []
207 = LFReEntrant (idType bndr) top 0 (null fvs)
209 mkClosureLFInfo bndr top fvs upd_flag []
211 | isUnLiftedType ty = pprPanic "mkClosureLFInfo" (ppr bndr <+> ppr ty)
214 = LFThunk ty top (null fvs) (isUpdatable upd_flag) NonStandardThunk
219 @mkConLFInfo@ is similar, for constructors.
222 mkConLFInfo :: DataCon -> LambdaFormInfo
225 = -- the isNullaryDataCon will do this: ASSERT(isDataCon con)
226 (if isTupleCon con then LFTuple else LFCon) con (isNullaryDataCon con)
228 mkSelectorLFInfo rhs_ty offset updatable
229 = LFThunk rhs_ty NotTopLevel False updatable (SelectorThunk offset)
231 mkApLFInfo rhs_ty upd_flag arity
232 = LFThunk rhs_ty NotTopLevel (arity == 0) (isUpdatable upd_flag)
236 Miscellaneous LF-infos.
239 mkLFArgument = LFArgument
240 mkLFBlackHole = LFBlackHole
241 mkLFLetNoEscape = LFLetNoEscape
243 mkLFImported :: Id -> LambdaFormInfo
245 = case getIdArity id of
246 ArityExactly 0 -> LFThunk (idType id)
247 TopLevel True{-no fvs-}
248 True{-updatable-} NonStandardThunk
249 ArityExactly n -> LFReEntrant (idType id) TopLevel n True -- n > 0
250 other -> LFImported -- Not sure of exact arity
253 %************************************************************************
255 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
257 %************************************************************************
260 closureSize :: ClosureInfo -> HeapOffset
261 closureSize cl_info@(MkClosureInfo _ _ sm_rep)
262 = fixedHdrSize + closureNonHdrSize cl_info
264 closureNonHdrSize :: ClosureInfo -> Int
265 closureNonHdrSize cl_info@(MkClosureInfo _ lf_info sm_rep)
266 = tot_wds + computeSlopSize tot_wds sm_rep (closureUpdReqd cl_info)
267 --ToDo: pass lf_info?
269 tot_wds = closureGoodStuffSize cl_info
271 closureGoodStuffSize :: ClosureInfo -> Int
272 closureGoodStuffSize (MkClosureInfo _ _ sm_rep)
273 = let (ptrs, nonptrs) = sizes_from_SMRep sm_rep
276 closurePtrsSize :: ClosureInfo -> Int
277 closurePtrsSize (MkClosureInfo _ _ sm_rep)
278 = let (ptrs, _) = sizes_from_SMRep sm_rep
282 sizes_from_SMRep :: SMRep -> (Int,Int)
283 sizes_from_SMRep (GenericRep ptrs nonptrs _) = (ptrs, nonptrs)
284 sizes_from_SMRep (StaticRep ptrs nonptrs _) = (ptrs, nonptrs)
285 sizes_from_SMRep ConstantRep = (0, 0)
286 sizes_from_SMRep BlackHoleRep = (0, 0)
289 Computing slop size. WARNING: this looks dodgy --- it has deep
290 knowledge of what the storage manager does with the various
296 Updateable closures must be @mIN_UPD_SIZE@.
299 Indirections require 1 word
301 Appels collector indirections 2 words
303 THEREFORE: @mIN_UPD_SIZE = 2@.
306 Collectable closures which are allocated in the heap
307 must be @mIN_SIZE_NonUpdHeapObject@.
309 Copying collector forward pointer requires 1 word
311 THEREFORE: @mIN_SIZE_NonUpdHeapObject = 1@
314 Static closures have an extra ``static link field'' at the end, but we
315 don't bother taking that into account here.
318 slopSize cl_info@(MkClosureInfo _ lf_info sm_rep)
319 = computeSlopSize (closureGoodStuffSize cl_info) sm_rep
320 (closureUpdReqd cl_info)
322 computeSlopSize :: Int -> SMRep -> Bool -> Int
324 computeSlopSize tot_wds (StaticRep _ _ _) True -- Updatable
325 = max 0 (mIN_UPD_SIZE - tot_wds)
326 computeSlopSize tot_wds (StaticRep _ _ _) False
327 = 0 -- non updatable, non-heap object
328 computeSlopSize tot_wds (GenericRep _ _ _) True -- Updatable
329 = max 0 (mIN_UPD_SIZE - tot_wds)
330 computeSlopSize tot_wds (GenericRep _ _ _) False
331 = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds)
332 computeSlopSize tot_wds ConstantRep _
334 computeSlopSize tot_wds BlackHoleRep _ -- Updatable
335 = max 0 (mIN_UPD_SIZE - tot_wds)
338 %************************************************************************
340 \subsection[layOutDynClosure]{Lay out a dynamic closure}
342 %************************************************************************
345 layOutDynClosure, layOutStaticClosure
346 :: Name -- STG identifier of this closure
347 -> (a -> PrimRep) -- how to get a PrimRep for the fields
348 -> [a] -- the "things" being layed out
349 -> LambdaFormInfo -- what sort of closure it is
350 -> (ClosureInfo, -- info about the closure
351 [(a, VirtualHeapOffset)]) -- things w/ offsets pinned on them
353 layOutDynClosure name kind_fn things lf_info
354 = (MkClosureInfo name lf_info sm_rep,
357 (tot_wds, -- #ptr_wds + #nonptr_wds
359 things_w_offsets) = mkVirtHeapOffsets sm_rep kind_fn things
360 sm_rep = chooseDynSMRep lf_info tot_wds ptr_wds
363 A wrapper for when used with data constructors:
366 layOutDynCon :: DataCon
369 -> (ClosureInfo, [(a,VirtualHeapOffset)])
371 layOutDynCon con kind_fn args
372 = layOutDynClosure (dataConName con) kind_fn args (mkConLFInfo con)
375 %************************************************************************
377 \subsection[layOutStaticClosure]{Lay out a static closure}
379 %************************************************************************
381 layOutStaticClosure is only used for laying out static constructors at
384 Static closures for functions are laid out using
385 layOutStaticNoFVClosure.
388 layOutStaticClosure name kind_fn things lf_info
389 = (MkClosureInfo name lf_info
390 (StaticRep ptr_wds (tot_wds - ptr_wds) closure_type),
393 (tot_wds, -- #ptr_wds + #nonptr_wds
395 things_w_offsets) = mkVirtHeapOffsets (StaticRep bot bot bot) kind_fn things
396 -- constructors with no pointer fields will definitely be NOCAF things.
397 -- this is a compromise until we can generate both kinds of constructor
398 -- (a normal static kind and the NOCAF_STATIC kind).
399 closure_type = case lf_info of
400 LFCon _ _ | ptr_wds == 0 -> CONSTR_NOCAF
401 _ -> getClosureType lf_info
403 bot = panic "layoutStaticClosure"
405 layOutStaticNoFVClosure :: Name -> LambdaFormInfo -> ClosureInfo
406 layOutStaticNoFVClosure name lf_info
407 = MkClosureInfo name lf_info (StaticRep 0 0 (getClosureType lf_info))
410 %************************************************************************
412 \subsection[SMreps]{Choosing SM reps}
414 %************************************************************************
419 -> Int -> Int -- Tot wds, ptr wds
422 chooseDynSMRep lf_info tot_wds ptr_wds
424 nonptr_wds = tot_wds - ptr_wds
425 closure_type = getClosureType lf_info
428 LFTuple _ True -> ConstantRep
429 LFCon _ True -> ConstantRep
430 _ -> GenericRep ptr_wds nonptr_wds closure_type
432 getClosureType :: LambdaFormInfo -> ClosureType
433 getClosureType lf_info =
435 LFCon con True -> CONSTR_NOCAF
436 LFCon con False -> CONSTR
437 LFReEntrant _ _ _ _ -> FUN
438 LFTuple _ _ -> CONSTR
439 LFThunk _ _ _ _ (SelectorThunk _) -> THUNK_SELECTOR
440 LFThunk _ _ _ _ _ -> THUNK
441 _ -> panic "getClosureType"
442 -- ToDo: could be anything else here?
445 %************************************************************************
447 \subsection[mkVirtHeapOffsets]{Assigning heap offsets in a closure}
449 %************************************************************************
451 @mkVirtHeapOffsets@ (the heap version) always returns boxed things with
452 smaller offsets than the unboxed things, and furthermore, the offsets in
456 mkVirtHeapOffsets :: SMRep -- Representation to be used by storage manager
457 -> (a -> PrimRep) -- To be able to grab kinds;
458 -- w/ a kind, we can find boxedness
459 -> [a] -- Things to make offsets for
460 -> (Int, -- *Total* number of words allocated
461 Int, -- Number of words allocated for *pointers*
462 [(a, VirtualHeapOffset)])
463 -- Things with their offsets from start of
464 -- object in order of increasing offset
466 -- First in list gets lowest offset, which is initial offset + 1.
468 mkVirtHeapOffsets sm_rep kind_fun things
469 = let (ptrs, non_ptrs) = separateByPtrFollowness kind_fun things
470 (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
471 (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
473 (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
475 computeOffset wds_so_far thing
476 = (wds_so_far + (getPrimRepSize . kind_fun) thing,
477 (thing, fixedHdrSize + wds_so_far)
481 %************************************************************************
483 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
485 %************************************************************************
487 Be sure to see the stg-details notes about these...
490 nodeMustPointToIt :: LambdaFormInfo -> FCode Bool
491 nodeMustPointToIt lf_info
494 LFReEntrant ty top arity no_fvs -> returnFC (
495 not no_fvs || -- Certainly if it has fvs we need to point to it
496 case top of { TopLevel -> False; _ -> True }
497 -- If it is not top level we will point to it
498 -- We can have a \r closure with no_fvs which
499 -- is not top level as special case cgRhsClosure
500 -- has been dissabled in favour of let floating
502 -- For lex_profiling we also access the cost centre for a
503 -- non-inherited function i.e. not top level
504 -- the not top case above ensures this is ok.
507 LFCon _ zero_arity -> returnFC True
508 LFTuple _ zero_arity -> returnFC True
510 -- Strictly speaking, the above two don't need Node to point
511 -- to it if the arity = 0. But this is a *really* unlikely
512 -- situation. If we know it's nil (say) and we are entering
513 -- it. Eg: let x = [] in x then we will certainly have inlined
514 -- x, since nil is a simple atom. So we gain little by not
515 -- having Node point to known zero-arity things. On the other
516 -- hand, we do lose something; Patrick's code for figuring out
517 -- when something has been updated but not entered relies on
518 -- having Node point to the result of an update. SLPJ
521 LFThunk _ _ no_fvs updatable NonStandardThunk
522 -> returnFC (updatable || not no_fvs || opt_SccProfilingOn)
524 -- For the non-updatable (single-entry case):
526 -- True if has fvs (in which case we need access to them, and we
527 -- should black-hole it)
528 -- or profiling (in which case we need to recover the cost centre
531 LFThunk _ _ no_fvs updatable some_standard_form_thunk
533 -- Node must point to any standard-form thunk.
535 LFArgument -> returnFC True
536 LFImported -> returnFC True
537 LFBlackHole -> returnFC True
538 -- BH entry may require Node to point
540 LFLetNoEscape _ -> returnFC False
543 The entry conventions depend on the type of closure being entered,
544 whether or not it has free variables, and whether we're running
545 sequentially or in parallel.
547 \begin{tabular}{lllll}
548 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
549 Unknown & no & yes & stack & node \\
550 Known fun ($\ge$ 1 arg), no fvs & no & no & registers & fast entry (enough args) \\
551 \ & \ & \ & \ & slow entry (otherwise) \\
552 Known fun ($\ge$ 1 arg), fvs & no & yes & registers & fast entry (enough args) \\
553 0 arg, no fvs @\r,\s@ & no & no & n/a & direct entry \\
554 0 arg, no fvs @\u@ & no & yes & n/a & node \\
555 0 arg, fvs @\r,\s@ & no & yes & n/a & direct entry \\
556 0 arg, fvs @\u@ & no & yes & n/a & node \\
558 Unknown & yes & yes & stack & node \\
559 Known fun ($\ge$ 1 arg), no fvs & yes & no & registers & fast entry (enough args) \\
560 \ & \ & \ & \ & slow entry (otherwise) \\
561 Known fun ($\ge$ 1 arg), fvs & yes & yes & registers & node \\
562 0 arg, no fvs @\r,\s@ & yes & no & n/a & direct entry \\
563 0 arg, no fvs @\u@ & yes & yes & n/a & node \\
564 0 arg, fvs @\r,\s@ & yes & yes & n/a & node \\
565 0 arg, fvs @\u@ & yes & yes & n/a & node\\
568 When black-holing, single-entry closures could also be entered via node
569 (rather than directly) to catch double-entry.
573 = ViaNode -- The "normal" convention
575 | StdEntry CLabel -- Jump to this code, with args on stack
577 | DirectEntry -- Jump directly, with args in regs
578 CLabel -- The code label
580 [MagicId] -- Its register assignments
583 getEntryConvention :: Name -- Function being applied
584 -> LambdaFormInfo -- Its info
585 -> [PrimRep] -- Available arguments
586 -> FCode EntryConvention
588 getEntryConvention name lf_info arg_kinds
589 = nodeMustPointToIt lf_info `thenFC` \ node_points ->
592 -- if we're parallel, then we must always enter via node. The reason
593 -- is that the closure may have been fetched since we allocated it.
595 if (node_points && opt_Parallel) then ViaNode else
597 -- Commented out by SDM after futher thoughts:
598 -- - the only closure type that can be blackholed is a thunk
599 -- - we already enter thunks via node (unless the closure is
600 -- non-updatable, in which case why is it being re-entered...)
604 LFReEntrant _ _ arity _ ->
605 if arity == 0 || (length arg_kinds) < arity then
606 StdEntry (mkStdEntryLabel name)
608 DirectEntry (mkFastEntryLabel name arity) arity arg_regs
610 (arg_regs, _) = assignRegs live_regs (take arity arg_kinds)
611 live_regs = if node_points then [node] else []
613 LFCon con True{-zero_arity-}
614 -- a real constructor. Don't bother entering it, just jump
615 -- to the constructor entry code directly.
616 -> --false:ASSERT (null arg_kinds)
617 -- Should have no args (meaning what?)
618 StdEntry (mkStaticConEntryLabel (dataConName con))
620 LFCon con False{-non-zero_arity-}
621 -> --false:ASSERT (null arg_kinds)
622 -- Should have no args (meaning what?)
623 StdEntry (mkConEntryLabel (dataConName con))
625 LFTuple tup zero_arity
626 -> --false:ASSERT (null arg_kinds)
627 -- Should have no args (meaning what?)
628 StdEntry (mkConEntryLabel (dataConName tup))
630 LFThunk _ _ _ updatable std_form_info
633 else StdEntry (thunkEntryLabel name std_form_info updatable)
635 LFArgument -> ViaNode
636 LFImported -> ViaNode
637 LFBlackHole -> ViaNode -- Presumably the black hole has by now
638 -- been updated, but we don't know with
639 -- what, so we enter via Node
642 -> StdEntry (mkReturnPtLabel (nameUnique name))
645 -> ASSERT(arity == length arg_kinds)
646 DirectEntry (mkReturnPtLabel (nameUnique name)) arity arg_regs
648 (arg_regs, _) = assignRegs [] arg_kinds
649 -- node never points to a LetNoEscape, see above --SDM
650 --live_regs = if node_points then [node] else []
653 blackHoleOnEntry :: ClosureInfo -> Bool
655 -- Static closures are never themselves black-holed.
656 -- Updatable ones will be overwritten with a CAFList cell, which points to a
658 -- Single-entry ones have no fvs to plug, and we trust they don't form part
661 blackHoleOnEntry (MkClosureInfo _ _ (StaticRep _ _ _)) = False
663 blackHoleOnEntry (MkClosureInfo _ lf_info _)
665 LFReEntrant _ _ _ _ -> False
666 LFLetNoEscape _ -> False
667 LFThunk _ _ no_fvs updatable _
669 then not opt_OmitBlackHoling
671 other -> panic "blackHoleOnEntry" -- Should never happen
673 isStandardFormThunk :: LambdaFormInfo -> Bool
675 isStandardFormThunk (LFThunk _ _ _ _ (SelectorThunk _)) = True
676 isStandardFormThunk (LFThunk _ _ _ _ (ApThunk _)) = True
677 isStandardFormThunk other_lf_info = False
679 maybeSelectorInfo (MkClosureInfo _ (LFThunk _ _ _ _
680 (SelectorThunk offset)) _) = Just offset
681 maybeSelectorInfo _ = Nothing
683 -- Does this thunk's info table have an SRT?
685 needsSRT :: ClosureInfo -> Bool
686 needsSRT (MkClosureInfo _ info _) =
688 LFThunk _ _ _ _ (SelectorThunk _) -> False -- not for selectors
689 LFThunk _ _ _ _ _ -> True
690 LFReEntrant _ _ _ _ -> True
694 Avoiding generating entries and info tables
695 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
696 At present, for every function we generate all of the following,
697 just in case. But they aren't always all needed, as noted below:
699 [NB1: all of this applies only to *functions*. Thunks always
700 have closure, info table, and entry code.]
702 [NB2: All are needed if the function is *exported*, just to play safe.]
705 * Fast-entry code ALWAYS NEEDED
708 Needed iff (a) we have any un-saturated calls to the function
709 OR (b) the function is passed as an arg
710 OR (c) we're in the parallel world and the function has free vars
711 [Reason: in parallel world, we always enter functions
712 with free vars via the closure.]
714 * The function closure
715 Needed iff (a) we have any un-saturated calls to the function
716 OR (b) the function is passed as an arg
717 OR (c) if the function has free vars (ie not top level)
719 Why case (a) here? Because if the arg-satis check fails,
720 UpdatePAP stuffs a pointer to the function closure in the PAP.
721 [Could be changed; UpdatePAP could stuff in a code ptr instead,
722 but doesn't seem worth it.]
724 [NB: these conditions imply that we might need the closure
725 without the slow-entry code. Here's how.
727 f x y = let g w = ...x..y..w...
731 Here we need a closure for g which contains x and y,
732 but since the calls are all saturated we just jump to the
733 fast entry point for g, with R1 pointing to the closure for g.]
736 * Standard info table
737 Needed iff (a) we have any un-saturated calls to the function
738 OR (b) the function is passed as an arg
739 OR (c) the function has free vars (ie not top level)
741 NB. In the sequential world, (c) is only required so that the function closure has
742 an info table to point to, to keep the storage manager happy.
743 If (c) alone is true we could fake up an info table by choosing
744 one of a standard family of info tables, whose entry code just
747 [NB In the parallel world (c) is needed regardless because
748 we enter functions with free vars via the closure.]
750 If (c) is retained, then we'll sometimes generate an info table
751 (for storage mgr purposes) without slow-entry code. Then we need
752 to use an error label in the info table to substitute for the absent
756 staticClosureRequired
761 staticClosureRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _)
762 (LFReEntrant _ top_level _ _) -- It's a function
763 = ASSERT( case top_level of { TopLevel -> True; other -> False } )
764 -- Assumption: it's a top-level, no-free-var binding
765 arg_occ -- There's an argument occurrence
766 || unsat_occ -- There's an unsaturated call
767 || isExternallyVisibleName binder
769 staticClosureRequired binder other_binder_info other_lf_info = True
771 slowFunEntryCodeRequired -- Assumption: it's a function, not a thunk.
776 slowFunEntryCodeRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _) entry_conv
777 = arg_occ -- There's an argument occurrence
778 || unsat_occ -- There's an unsaturated call
779 || isExternallyVisibleName binder
780 || (case entry_conv of { DirectEntry _ _ _ -> False; other -> True })
781 {- The last case deals with the parallel world; a function usually
782 as a DirectEntry convention, but if it doesn't we must generate slow-entry code -}
784 slowFunEntryCodeRequired binder NoStgBinderInfo _ = True
791 funInfoTableRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _)
792 (LFReEntrant _ top_level _ _)
793 = (case top_level of { NotTopLevel -> True; TopLevel -> False })
794 || arg_occ -- There's an argument occurrence
795 || unsat_occ -- There's an unsaturated call
796 || isExternallyVisibleName binder
798 funInfoTableRequired other_binder_info binder other_lf_info = True
801 %************************************************************************
803 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
805 %************************************************************************
809 isStaticClosure :: ClosureInfo -> Bool
810 isStaticClosure (MkClosureInfo _ _ rep) = isStaticRep rep
812 closureName :: ClosureInfo -> Name
813 closureName (MkClosureInfo name _ _) = name
815 closureSMRep :: ClosureInfo -> SMRep
816 closureSMRep (MkClosureInfo _ _ sm_rep) = sm_rep
818 closureLFInfo :: ClosureInfo -> LambdaFormInfo
819 closureLFInfo (MkClosureInfo _ lf_info _) = lf_info
821 closureUpdReqd :: ClosureInfo -> Bool
823 closureUpdReqd (MkClosureInfo _ (LFThunk _ _ _ upd _) _) = upd
824 closureUpdReqd (MkClosureInfo _ LFBlackHole _) = True
825 -- Black-hole closures are allocated to receive the results of an
826 -- alg case with a named default... so they need to be updated.
827 closureUpdReqd other_closure = False
829 closureSingleEntry :: ClosureInfo -> Bool
831 closureSingleEntry (MkClosureInfo _ (LFThunk _ _ _ upd _) _) = not upd
832 closureSingleEntry other_closure = False
836 closureSemiTag :: ClosureInfo -> Maybe Int
838 closureSemiTag (MkClosureInfo _ lf_info _)
840 LFCon data_con _ -> Just (dataConTag data_con - fIRST_TAG)
841 LFTuple _ _ -> Just 0
846 isToplevClosure :: ClosureInfo -> Bool
848 isToplevClosure (MkClosureInfo _ lf_info _)
850 LFReEntrant _ TopLevel _ _ -> True
851 LFThunk _ TopLevel _ _ _ -> True
856 isLetNoEscape :: ClosureInfo -> Bool
858 isLetNoEscape (MkClosureInfo _ (LFLetNoEscape _) _) = True
859 isLetNoEscape _ = False
865 fastLabelFromCI :: ClosureInfo -> CLabel
866 fastLabelFromCI (MkClosureInfo name (LFReEntrant _ _ arity _) _)
867 = mkFastEntryLabel name arity
869 fastLabelFromCI (MkClosureInfo name _ _)
870 = pprPanic "fastLabelFromCI" (ppr name)
872 infoTableLabelFromCI :: ClosureInfo -> CLabel
873 infoTableLabelFromCI (MkClosureInfo id lf_info rep)
875 LFCon con _ -> mkConInfoPtr con rep
876 LFTuple tup _ -> mkConInfoPtr tup rep
878 LFBlackHole -> mkBlackHoleInfoTableLabel
880 LFThunk _ _ _ upd_flag (SelectorThunk offset) ->
881 mkSelectorInfoLabel upd_flag offset
883 LFThunk _ _ _ upd_flag (ApThunk arity) ->
884 mkApInfoTableLabel upd_flag arity
886 other -> {-NO: if isStaticRep rep
887 then mkStaticInfoTableLabel id
888 else -} mkInfoTableLabel id
890 mkConInfoPtr :: DataCon -> SMRep -> CLabel
893 StaticRep _ _ _ -> mkStaticInfoTableLabel name
894 _ -> mkConInfoTableLabel name
896 name = dataConName con
898 mkConEntryPtr :: DataCon -> SMRep -> CLabel
899 mkConEntryPtr con rep
901 StaticRep _ _ _ -> mkStaticConEntryLabel (dataConName con)
902 _ -> mkConEntryLabel (dataConName con)
904 name = dataConName con
906 closureLabelFromCI (MkClosureInfo name _ rep)
908 = mkStaticClosureLabel name
909 -- This case catches those pesky static closures for nullary constructors
911 closureLabelFromCI (MkClosureInfo id _ other_rep) = mkClosureLabel id
913 entryLabelFromCI :: ClosureInfo -> CLabel
914 entryLabelFromCI (MkClosureInfo id lf_info rep)
916 LFThunk _ _ _ upd_flag std_form_info -> thunkEntryLabel id std_form_info upd_flag
917 LFCon con _ -> mkConEntryPtr con rep
918 LFTuple tup _ -> mkConEntryPtr tup rep
919 other -> mkStdEntryLabel id
921 -- thunkEntryLabel is a local help function, not exported. It's used from both
922 -- entryLabelFromCI and getEntryConvention.
924 thunkEntryLabel thunk_id (ApThunk arity) is_updatable
925 = mkApEntryLabel is_updatable arity
926 thunkEntryLabel thunk_id (SelectorThunk offset) upd_flag
927 = mkSelectorEntryLabel upd_flag offset
928 thunkEntryLabel thunk_id _ is_updatable
929 = mkStdEntryLabel thunk_id
933 allocProfilingMsg :: ClosureInfo -> FAST_STRING
935 allocProfilingMsg (MkClosureInfo _ lf_info _)
937 LFReEntrant _ _ _ _ -> SLIT("TICK_ALLOC_FUN")
938 LFCon _ _ -> SLIT("TICK_ALLOC_CON")
939 LFTuple _ _ -> SLIT("TICK_ALLOC_CON")
940 LFThunk _ _ _ _ _ -> SLIT("TICK_ALLOC_THK")
941 LFBlackHole -> SLIT("TICK_ALLOC_BH")
942 LFImported -> panic "TICK_ALLOC_IMP"
945 We need a black-hole closure info to pass to @allocDynClosure@ when we
946 want to allocate the black hole on entry to a CAF.
949 blackHoleClosureInfo (MkClosureInfo name _ _)
950 = MkClosureInfo name LFBlackHole BlackHoleRep
953 %************************************************************************
955 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
957 %************************************************************************
959 Profiling requires two pieces of information to be determined for
960 each closure's info table --- description and type.
962 The description is stored directly in the @CClosureInfoTable@ when the
965 The type is determined from the type information stored with the @Id@
966 in the closure info using @closureTypeDescr@.
969 closureTypeDescr :: ClosureInfo -> String
970 closureTypeDescr (MkClosureInfo name (LFThunk ty _ _ _ _) _)
971 = getTyDescription ty
972 closureTypeDescr (MkClosureInfo name (LFReEntrant ty _ _ _) _)
973 = getTyDescription ty
974 closureTypeDescr (MkClosureInfo name lf _)
975 = showSDoc (ppr name)