2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: ClosureInfo.lhs,v 1.39 1999/11/02 15:05:44 simonmar 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, closureReEntrant, closureSemiTag,
47 closureTypeDescr, -- profiling
51 cafBlackHoleClosureInfo, seCafBlackHoleClosureInfo,
55 staticClosureNeedsLink,
59 #include "HsVersions.h"
61 import AbsCSyn ( MagicId, node, VirtualHeapOffset, HeapOffset )
65 import Constants ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject,
66 mAX_SPEC_FUN_SIZE, mAX_SPEC_THUNK_SIZE, mAX_SPEC_CONSTR_SIZE )
67 import CgRetConv ( assignRegs )
68 import CLabel ( CLabel, mkStdEntryLabel, mkFastEntryLabel,
70 mkConInfoTableLabel, mkStaticClosureLabel,
71 mkCAFBlackHoleInfoTableLabel,
72 mkSECAFBlackHoleInfoTableLabel,
73 mkStaticInfoTableLabel, mkStaticConEntryLabel,
74 mkConEntryLabel, mkClosureLabel,
75 mkSelectorInfoLabel, mkSelectorEntryLabel,
76 mkApInfoTableLabel, mkApEntryLabel,
79 import CmdLineOpts ( opt_SccProfilingOn, opt_OmitBlackHoling,
80 opt_Parallel, opt_DoTickyProfiling,
82 import Id ( Id, idType, getIdArity )
83 import DataCon ( DataCon, dataConTag, fIRST_TAG,
84 isNullaryDataCon, isTupleCon, dataConName
86 import IdInfo ( ArityInfo(..) )
87 import Name ( Name, isExternallyVisibleName, nameUnique )
88 import PprType ( getTyDescription )
89 import PrimRep ( getPrimRepSize, separateByPtrFollowness, PrimRep )
90 import SMRep -- all of it
91 import Type ( isUnLiftedType, Type )
92 import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel )
93 import Util ( mapAccumL )
97 The ``wrapper'' data type for closure information:
102 Name -- The thing bound to this closure
103 LambdaFormInfo -- info derivable from the *source*
104 SMRep -- representation used by storage manager
107 %************************************************************************
109 \subsection[ClosureInfo-datatypes]{Data types for closure information}
111 %************************************************************************
113 %************************************************************************
115 \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
117 %************************************************************************
121 = LFReEntrant -- Reentrant closure; used for PAPs too
122 Type -- Type of closure (ToDo: remove)
123 TopLevelFlag -- True if top level
125 !Bool -- True <=> no fvs
129 | LFCon -- Constructor
130 DataCon -- The constructor
131 Bool -- True <=> zero arity
134 DataCon -- The tuple constructor
135 Bool -- True <=> zero arity
137 | LFThunk -- Thunk (zero arity)
138 Type -- Type of the thunk (ToDo: remove)
140 !Bool -- True <=> no free vars
141 Bool -- True <=> updatable (i.e., *not* single-entry)
146 | LFArgument -- Used for function arguments. We know nothing about
147 -- this closure. Treat like updatable "LFThunk"...
149 | LFImported -- Used for imported things. We know nothing about this
150 -- closure. Treat like updatable "LFThunk"...
151 -- Imported things which we do know something about use
152 -- one of the other LF constructors (eg LFReEntrant for
155 | LFLetNoEscape -- See LetNoEscape module for precise description of
159 | LFBlackHole -- Used for the closures allocated to hold the result
160 -- of a CAF. We want the target of the update frame to
161 -- be in the heap, so we make a black hole to hold it.
162 CLabel -- Flavour (info label, eg CAF_BLACKHOLE_info).
165 data StandardFormInfo -- Tells whether this thunk has one of a small number
168 = NonStandardThunk -- No, it isn't
171 Int -- 0-origin offset of ak within the "goods" of
172 -- constructor (Recall that the a1,...,an may be laid
173 -- out in the heap in a non-obvious order.)
175 {- A SelectorThunk is of form
180 and the constructor is from a single-constr type.
186 {- An ApThunk is of form
190 The code for the thunk just pushes x2..xn on the stack and enters x1.
191 There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
192 in the RTS to save space.
197 %************************************************************************
199 \subsection[ClosureInfo-construction]{Functions which build LFInfos}
201 %************************************************************************
203 @mkClosureLFInfo@ figures out the appropriate LFInfo for the closure.
206 mkClosureLFInfo :: Id -- The binder
207 -> TopLevelFlag -- True of top level
209 -> UpdateFlag -- Update flag
211 -> CLabel -- SRT label
215 mkClosureLFInfo bndr top fvs upd_flag args@(_:_) srt_label srt -- Non-empty args
216 = LFReEntrant (idType bndr) top (length args) (null fvs) srt_label srt
218 mkClosureLFInfo bndr top fvs ReEntrant [] srt_label srt
219 = LFReEntrant (idType bndr) top 0 (null fvs) srt_label srt
221 mkClosureLFInfo bndr top fvs upd_flag [] srt_label srt
223 | isUnLiftedType ty = pprPanic "mkClosureLFInfo" (ppr bndr <+> ppr ty)
226 = LFThunk ty top (null fvs) (isUpdatable upd_flag) NonStandardThunk
232 @mkConLFInfo@ is similar, for constructors.
235 mkConLFInfo :: DataCon -> LambdaFormInfo
238 = -- the isNullaryDataCon will do this: ASSERT(isDataCon con)
239 (if isTupleCon con then LFTuple else LFCon) con (isNullaryDataCon con)
241 mkSelectorLFInfo rhs_ty offset updatable
242 = LFThunk rhs_ty NotTopLevel False updatable (SelectorThunk offset)
243 (error "mkSelectorLFInfo: no srt label")
244 (error "mkSelectorLFInfo: no srt")
246 mkApLFInfo rhs_ty upd_flag arity
247 = LFThunk rhs_ty NotTopLevel (arity == 0) (isUpdatable upd_flag)
249 (error "mkApLFInfo: no srt label")
250 (error "mkApLFInfo: no srt")
253 Miscellaneous LF-infos.
256 mkLFArgument = LFArgument
257 mkLFLetNoEscape = LFLetNoEscape
259 mkLFImported :: Id -> LambdaFormInfo
261 = case getIdArity id of
262 ArityExactly 0 -> LFThunk (idType id)
263 TopLevel True{-no fvs-}
264 True{-updatable-} NonStandardThunk
265 (error "mkLFImported: no srt label")
266 (error "mkLFImported: no srt")
267 ArityExactly n -> LFReEntrant (idType id) TopLevel n True -- n > 0
268 (error "mkLFImported: no srt label")
269 (error "mkLFImported: no srt")
270 other -> LFImported -- Not sure of exact arity
273 %************************************************************************
275 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
277 %************************************************************************
280 closureSize :: ClosureInfo -> HeapOffset
281 closureSize cl_info@(MkClosureInfo _ _ sm_rep)
282 = fixedHdrSize + closureNonHdrSize cl_info
284 closureNonHdrSize :: ClosureInfo -> Int
285 closureNonHdrSize cl_info@(MkClosureInfo _ lf_info sm_rep)
286 = tot_wds + computeSlopSize tot_wds sm_rep (closureUpdReqd cl_info)
287 --ToDo: pass lf_info?
289 tot_wds = closureGoodStuffSize cl_info
291 closureGoodStuffSize :: ClosureInfo -> Int
292 closureGoodStuffSize (MkClosureInfo _ _ sm_rep)
293 = let (ptrs, nonptrs) = sizes_from_SMRep sm_rep
296 closurePtrsSize :: ClosureInfo -> Int
297 closurePtrsSize (MkClosureInfo _ _ sm_rep)
298 = let (ptrs, _) = sizes_from_SMRep sm_rep
302 sizes_from_SMRep :: SMRep -> (Int,Int)
303 sizes_from_SMRep (GenericRep ptrs nonptrs _) = (ptrs, nonptrs)
304 sizes_from_SMRep (StaticRep ptrs nonptrs _) = (ptrs, nonptrs)
305 sizes_from_SMRep ConstantRep = (0, 0)
306 sizes_from_SMRep BlackHoleRep = (0, 0)
309 Computing slop size. WARNING: this looks dodgy --- it has deep
310 knowledge of what the storage manager does with the various
316 Updateable closures must be @mIN_UPD_SIZE@.
319 Indirections require 1 word
321 Appels collector indirections 2 words
323 THEREFORE: @mIN_UPD_SIZE = 2@.
326 Collectable closures which are allocated in the heap
327 must be @mIN_SIZE_NonUpdHeapObject@.
329 Copying collector forward pointer requires 1 word
331 THEREFORE: @mIN_SIZE_NonUpdHeapObject = 1@
334 Static closures have an extra ``static link field'' at the end, but we
335 don't bother taking that into account here.
338 slopSize cl_info@(MkClosureInfo _ lf_info sm_rep)
339 = computeSlopSize (closureGoodStuffSize cl_info) sm_rep
340 (closureUpdReqd cl_info)
342 computeSlopSize :: Int -> SMRep -> Bool -> Int
344 computeSlopSize tot_wds (StaticRep _ _ _) True -- Updatable
345 = max 0 (mIN_UPD_SIZE - tot_wds)
346 computeSlopSize tot_wds (StaticRep _ _ _) False
347 = 0 -- non updatable, non-heap object
348 computeSlopSize tot_wds (GenericRep _ _ _) True -- Updatable
349 = max 0 (mIN_UPD_SIZE - tot_wds)
350 computeSlopSize tot_wds (GenericRep _ _ _) False
351 = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds)
352 computeSlopSize tot_wds ConstantRep _
354 computeSlopSize tot_wds BlackHoleRep _ -- Updatable
355 = max 0 (mIN_UPD_SIZE - tot_wds)
358 %************************************************************************
360 \subsection[layOutDynClosure]{Lay out a dynamic closure}
362 %************************************************************************
365 layOutDynClosure, layOutStaticClosure
366 :: Name -- STG identifier of this closure
367 -> (a -> PrimRep) -- how to get a PrimRep for the fields
368 -> [a] -- the "things" being layed out
369 -> LambdaFormInfo -- what sort of closure it is
370 -> (ClosureInfo, -- info about the closure
371 [(a, VirtualHeapOffset)]) -- things w/ offsets pinned on them
373 layOutDynClosure name kind_fn things lf_info
374 = (MkClosureInfo name lf_info sm_rep,
377 (tot_wds, -- #ptr_wds + #nonptr_wds
379 things_w_offsets) = mkVirtHeapOffsets sm_rep kind_fn things
380 sm_rep = chooseDynSMRep lf_info tot_wds ptr_wds
383 A wrapper for when used with data constructors:
386 layOutDynCon :: DataCon
389 -> (ClosureInfo, [(a,VirtualHeapOffset)])
391 layOutDynCon con kind_fn args
392 = layOutDynClosure (dataConName con) kind_fn args (mkConLFInfo con)
395 %************************************************************************
397 \subsection[layOutStaticClosure]{Lay out a static closure}
399 %************************************************************************
401 layOutStaticClosure is only used for laying out static constructors at
404 Static closures for functions are laid out using
405 layOutStaticNoFVClosure.
408 layOutStaticClosure name kind_fn things lf_info
409 = (MkClosureInfo name lf_info
410 (StaticRep ptr_wds (tot_wds - ptr_wds) closure_type),
413 (tot_wds, -- #ptr_wds + #nonptr_wds
415 things_w_offsets) = mkVirtHeapOffsets (StaticRep bot bot bot) kind_fn things
417 -- constructors with no pointer fields will definitely be NOCAF things.
418 -- this is a compromise until we can generate both kinds of constructor
419 -- (a normal static kind and the NOCAF_STATIC kind).
420 closure_type = case lf_info of
421 LFCon _ _ | ptr_wds == 0 -> CONSTR_NOCAF
422 _ -> getStaticClosureType lf_info
424 bot = panic "layoutStaticClosure"
426 layOutStaticNoFVClosure :: Name -> LambdaFormInfo -> ClosureInfo
427 layOutStaticNoFVClosure name lf_info
428 = MkClosureInfo name lf_info (StaticRep 0 0 (getStaticClosureType lf_info))
431 %************************************************************************
433 \subsection[SMreps]{Choosing SM reps}
435 %************************************************************************
440 -> Int -> Int -- Tot wds, ptr wds
443 chooseDynSMRep lf_info tot_wds ptr_wds
445 nonptr_wds = tot_wds - ptr_wds
446 closure_type = getClosureType tot_wds ptr_wds nonptr_wds lf_info
449 LFTuple _ True -> ConstantRep
450 LFCon _ True -> ConstantRep
451 _ -> GenericRep ptr_wds nonptr_wds closure_type
453 getStaticClosureType :: LambdaFormInfo -> ClosureType
454 getStaticClosureType lf_info =
456 LFCon con True -> CONSTR_NOCAF
457 LFCon con False -> CONSTR
458 LFReEntrant _ _ _ _ _ _ -> FUN
459 LFTuple _ _ -> CONSTR
460 LFThunk _ _ _ _ (SelectorThunk _) _ _ -> THUNK_SELECTOR
461 LFThunk _ _ _ True _ _ _ -> THUNK
462 LFThunk _ _ _ False _ _ _ -> FUN
463 _ -> panic "getClosureType"
465 -- we *do* get non-updatable top-level thunks sometimes. eg. f = g
466 -- gets compiled to a jump to g (if g has non-zero arity), instead of
467 -- messing around with update frames and PAPs. We set the closure type
468 -- to FUN_STATIC in this case.
470 getClosureType :: Int -> Int -> Int -> LambdaFormInfo -> ClosureType
471 getClosureType tot_wds ptrs nptrs lf_info =
473 LFCon con True -> CONSTR_NOCAF
476 | tot_wds > 0 && tot_wds <= mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n ptrs nptrs
477 | otherwise -> CONSTR
479 LFReEntrant _ _ _ _ _ _
480 | tot_wds > 0 && tot_wds <= mAX_SPEC_FUN_SIZE -> FUN_p_n ptrs nptrs
484 | tot_wds > 0 && tot_wds <= mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n ptrs nptrs
485 | otherwise -> CONSTR
487 LFThunk _ _ _ _ (SelectorThunk _) _ _ -> THUNK_SELECTOR
489 LFThunk _ _ _ _ _ _ _
490 | tot_wds > 0 && tot_wds <= mAX_SPEC_THUNK_SIZE -> THUNK_p_n ptrs nptrs
493 _ -> panic "getClosureType"
496 %************************************************************************
498 \subsection[mkVirtHeapOffsets]{Assigning heap offsets in a closure}
500 %************************************************************************
502 @mkVirtHeapOffsets@ (the heap version) always returns boxed things with
503 smaller offsets than the unboxed things, and furthermore, the offsets in
507 mkVirtHeapOffsets :: SMRep -- Representation to be used by storage manager
508 -> (a -> PrimRep) -- To be able to grab kinds;
509 -- w/ a kind, we can find boxedness
510 -> [a] -- Things to make offsets for
511 -> (Int, -- *Total* number of words allocated
512 Int, -- Number of words allocated for *pointers*
513 [(a, VirtualHeapOffset)])
514 -- Things with their offsets from start of
515 -- object in order of increasing offset
517 -- First in list gets lowest offset, which is initial offset + 1.
519 mkVirtHeapOffsets sm_rep kind_fun things
520 = let (ptrs, non_ptrs) = separateByPtrFollowness kind_fun things
521 (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
522 (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
524 (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
526 computeOffset wds_so_far thing
527 = (wds_so_far + (getPrimRepSize . kind_fun) thing,
528 (thing, fixedHdrSize + wds_so_far)
532 %************************************************************************
534 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
536 %************************************************************************
538 Be sure to see the stg-details notes about these...
541 nodeMustPointToIt :: LambdaFormInfo -> FCode Bool
542 nodeMustPointToIt lf_info
545 LFReEntrant ty top arity no_fvs _ _ -> returnFC (
546 not no_fvs || -- Certainly if it has fvs we need to point to it
548 -- If it is not top level we will point to it
549 -- We can have a \r closure with no_fvs which
550 -- is not top level as special case cgRhsClosure
551 -- has been dissabled in favour of let floating
553 -- For lex_profiling we also access the cost centre for a
554 -- non-inherited function i.e. not top level
555 -- the not top case above ensures this is ok.
558 LFCon _ zero_arity -> returnFC True
559 LFTuple _ zero_arity -> returnFC True
561 -- Strictly speaking, the above two don't need Node to point
562 -- to it if the arity = 0. But this is a *really* unlikely
563 -- situation. If we know it's nil (say) and we are entering
564 -- it. Eg: let x = [] in x then we will certainly have inlined
565 -- x, since nil is a simple atom. So we gain little by not
566 -- having Node point to known zero-arity things. On the other
567 -- hand, we do lose something; Patrick's code for figuring out
568 -- when something has been updated but not entered relies on
569 -- having Node point to the result of an update. SLPJ
572 LFThunk _ _ no_fvs updatable NonStandardThunk _ _
573 -> returnFC (updatable || not no_fvs || opt_SccProfilingOn)
575 -- For the non-updatable (single-entry case):
577 -- True if has fvs (in which case we need access to them, and we
578 -- should black-hole it)
579 -- or profiling (in which case we need to recover the cost centre
582 LFThunk _ _ no_fvs updatable some_standard_form_thunk _ _
584 -- Node must point to any standard-form thunk.
586 LFArgument -> returnFC True
587 LFImported -> returnFC True
588 LFBlackHole _ -> returnFC True
589 -- BH entry may require Node to point
591 LFLetNoEscape _ -> returnFC False
594 The entry conventions depend on the type of closure being entered,
595 whether or not it has free variables, and whether we're running
596 sequentially or in parallel.
598 \begin{tabular}{lllll}
599 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
600 Unknown & no & yes & stack & node \\
601 Known fun ($\ge$ 1 arg), no fvs & no & no & registers & fast entry (enough args) \\
602 \ & \ & \ & \ & slow entry (otherwise) \\
603 Known fun ($\ge$ 1 arg), fvs & no & yes & registers & fast entry (enough args) \\
604 0 arg, no fvs @\r,\s@ & no & no & n/a & direct entry \\
605 0 arg, no fvs @\u@ & no & yes & n/a & node \\
606 0 arg, fvs @\r,\s@ & no & yes & n/a & direct entry \\
607 0 arg, fvs @\u@ & no & yes & n/a & node \\
609 Unknown & yes & yes & stack & node \\
610 Known fun ($\ge$ 1 arg), no fvs & yes & no & registers & fast entry (enough args) \\
611 \ & \ & \ & \ & slow entry (otherwise) \\
612 Known fun ($\ge$ 1 arg), fvs & yes & yes & registers & node \\
613 0 arg, no fvs @\r,\s@ & yes & no & n/a & direct entry \\
614 0 arg, no fvs @\u@ & yes & yes & n/a & node \\
615 0 arg, fvs @\r,\s@ & yes & yes & n/a & node \\
616 0 arg, fvs @\u@ & yes & yes & n/a & node\\
619 When black-holing, single-entry closures could also be entered via node
620 (rather than directly) to catch double-entry.
624 = ViaNode -- The "normal" convention
626 | StdEntry CLabel -- Jump to this code, with args on stack
628 | DirectEntry -- Jump directly, with args in regs
629 CLabel -- The code label
631 [MagicId] -- Its register assignments
634 getEntryConvention :: Name -- Function being applied
635 -> LambdaFormInfo -- Its info
636 -> [PrimRep] -- Available arguments
637 -> FCode EntryConvention
639 getEntryConvention name lf_info arg_kinds
640 = nodeMustPointToIt lf_info `thenFC` \ node_points ->
643 -- if we're parallel, then we must always enter via node. The reason
644 -- is that the closure may have been fetched since we allocated it.
646 if (node_points && opt_Parallel) then ViaNode else
648 -- Commented out by SDM after futher thoughts:
649 -- - the only closure type that can be blackholed is a thunk
650 -- - we already enter thunks via node (unless the closure is
651 -- non-updatable, in which case why is it being re-entered...)
655 LFReEntrant _ _ arity _ _ _ ->
656 if arity == 0 || (length arg_kinds) < arity then
657 StdEntry (mkStdEntryLabel name)
659 DirectEntry (mkFastEntryLabel name arity) arity arg_regs
661 (arg_regs, _) = assignRegs live_regs (take arity arg_kinds)
662 live_regs = if node_points then [node] else []
664 LFCon con True{-zero_arity-}
665 -- a real constructor. Don't bother entering it, just jump
666 -- to the constructor entry code directly.
667 -> --false:ASSERT (null arg_kinds)
668 -- Should have no args (meaning what?)
669 StdEntry (mkStaticConEntryLabel (dataConName con))
671 LFCon con False{-non-zero_arity-}
672 -> --false:ASSERT (null arg_kinds)
673 -- Should have no args (meaning what?)
674 StdEntry (mkConEntryLabel (dataConName con))
676 LFTuple tup zero_arity
677 -> --false:ASSERT (null arg_kinds)
678 -- Should have no args (meaning what?)
679 StdEntry (mkConEntryLabel (dataConName tup))
681 LFThunk _ _ _ updatable std_form_info _ _
682 -> if updatable || opt_DoTickyProfiling -- to catch double entry
683 || opt_SMP -- always enter via node on SMP, since the
684 -- thunk might have been blackholed in the
687 else StdEntry (thunkEntryLabel name std_form_info updatable)
689 LFArgument -> ViaNode
690 LFImported -> ViaNode
691 LFBlackHole _ -> ViaNode -- Presumably the black hole has by now
692 -- been updated, but we don't know with
693 -- what, so we enter via Node
696 -> StdEntry (mkReturnPtLabel (nameUnique name))
699 -> ASSERT(arity == length arg_kinds)
700 DirectEntry (mkReturnPtLabel (nameUnique name)) arity arg_regs
702 (arg_regs, _) = assignRegs [] arg_kinds
703 -- node never points to a LetNoEscape, see above --SDM
704 --live_regs = if node_points then [node] else []
707 blackHoleOnEntry :: ClosureInfo -> Bool
709 -- Static closures are never themselves black-holed.
710 -- Updatable ones will be overwritten with a CAFList cell, which points to a
712 -- Single-entry ones have no fvs to plug, and we trust they don't form part
715 blackHoleOnEntry (MkClosureInfo _ _ (StaticRep _ _ _)) = False
717 blackHoleOnEntry (MkClosureInfo _ lf_info _)
719 LFReEntrant _ _ _ _ _ _ -> False
720 LFLetNoEscape _ -> False
721 LFThunk _ _ no_fvs updatable _ _ _
723 then not opt_OmitBlackHoling
724 else opt_DoTickyProfiling || not no_fvs
725 -- the former to catch double entry,
726 -- and the latter to plug space-leaks. KSW/SDM 1999-04.
728 other -> panic "blackHoleOnEntry" -- Should never happen
730 isStandardFormThunk :: LambdaFormInfo -> Bool
732 isStandardFormThunk (LFThunk _ _ _ _ (SelectorThunk _) _ _) = True
733 isStandardFormThunk (LFThunk _ _ _ _ (ApThunk _) _ _) = True
734 isStandardFormThunk other_lf_info = False
736 maybeSelectorInfo (MkClosureInfo _ (LFThunk _ _ _ _
737 (SelectorThunk offset) _ _) _) = Just offset
738 maybeSelectorInfo _ = Nothing
741 -----------------------------------------------------------------------------
746 infoTblNeedsSRT :: ClosureInfo -> Bool
747 infoTblNeedsSRT (MkClosureInfo _ info _) =
749 LFThunk _ _ _ _ _ _ NoSRT -> False
750 LFThunk _ _ _ _ _ _ _ -> True
752 LFReEntrant _ _ _ _ _ NoSRT -> False
753 LFReEntrant _ _ _ _ _ _ -> True
757 staticClosureNeedsLink :: ClosureInfo -> Bool
758 staticClosureNeedsLink (MkClosureInfo _ info _) =
760 LFThunk _ _ _ _ _ _ NoSRT -> False
761 LFReEntrant _ _ _ _ _ NoSRT -> False
762 LFCon _ True -> False -- zero arity constructors
765 getSRTInfo :: ClosureInfo -> (CLabel, SRT)
766 getSRTInfo (MkClosureInfo _ info _) =
768 LFThunk _ _ _ _ _ lbl srt -> (lbl,srt)
769 LFReEntrant _ _ _ _ lbl srt -> (lbl,srt)
770 _ -> panic "getSRTInfo"
773 Avoiding generating entries and info tables
774 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
775 At present, for every function we generate all of the following,
776 just in case. But they aren't always all needed, as noted below:
778 [NB1: all of this applies only to *functions*. Thunks always
779 have closure, info table, and entry code.]
781 [NB2: All are needed if the function is *exported*, just to play safe.]
784 * Fast-entry code ALWAYS NEEDED
787 Needed iff (a) we have any un-saturated calls to the function
788 OR (b) the function is passed as an arg
789 OR (c) we're in the parallel world and the function has free vars
790 [Reason: in parallel world, we always enter functions
791 with free vars via the closure.]
793 * The function closure
794 Needed iff (a) we have any un-saturated calls to the function
795 OR (b) the function is passed as an arg
796 OR (c) if the function has free vars (ie not top level)
798 Why case (a) here? Because if the arg-satis check fails,
799 UpdatePAP stuffs a pointer to the function closure in the PAP.
800 [Could be changed; UpdatePAP could stuff in a code ptr instead,
801 but doesn't seem worth it.]
803 [NB: these conditions imply that we might need the closure
804 without the slow-entry code. Here's how.
806 f x y = let g w = ...x..y..w...
810 Here we need a closure for g which contains x and y,
811 but since the calls are all saturated we just jump to the
812 fast entry point for g, with R1 pointing to the closure for g.]
815 * Standard info table
816 Needed iff (a) we have any un-saturated calls to the function
817 OR (b) the function is passed as an arg
818 OR (c) the function has free vars (ie not top level)
820 NB. In the sequential world, (c) is only required so that the function closure has
821 an info table to point to, to keep the storage manager happy.
822 If (c) alone is true we could fake up an info table by choosing
823 one of a standard family of info tables, whose entry code just
826 [NB In the parallel world (c) is needed regardless because
827 we enter functions with free vars via the closure.]
829 If (c) is retained, then we'll sometimes generate an info table
830 (for storage mgr purposes) without slow-entry code. Then we need
831 to use an error label in the info table to substitute for the absent
835 staticClosureRequired
840 staticClosureRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _)
841 (LFReEntrant _ top_level _ _ _ _) -- It's a function
842 = ASSERT( isTopLevel top_level )
843 -- Assumption: it's a top-level, no-free-var binding
844 arg_occ -- There's an argument occurrence
845 || unsat_occ -- There's an unsaturated call
846 || isExternallyVisibleName binder
848 staticClosureRequired binder other_binder_info other_lf_info = True
850 slowFunEntryCodeRequired -- Assumption: it's a function, not a thunk.
855 slowFunEntryCodeRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _) entry_conv
856 = arg_occ -- There's an argument occurrence
857 || unsat_occ -- There's an unsaturated call
858 || isExternallyVisibleName binder
859 || (case entry_conv of { DirectEntry _ _ _ -> False; other -> True })
860 {- The last case deals with the parallel world; a function usually
861 as a DirectEntry convention, but if it doesn't we must generate slow-entry code -}
863 slowFunEntryCodeRequired binder NoStgBinderInfo _ = True
870 funInfoTableRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _)
871 (LFReEntrant _ top_level _ _ _ _)
872 = isNotTopLevel top_level
873 || arg_occ -- There's an argument occurrence
874 || unsat_occ -- There's an unsaturated call
875 || isExternallyVisibleName binder
877 funInfoTableRequired other_binder_info binder other_lf_info = True
880 %************************************************************************
882 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
884 %************************************************************************
888 isStaticClosure :: ClosureInfo -> Bool
889 isStaticClosure (MkClosureInfo _ _ rep) = isStaticRep rep
891 closureName :: ClosureInfo -> Name
892 closureName (MkClosureInfo name _ _) = name
894 closureSMRep :: ClosureInfo -> SMRep
895 closureSMRep (MkClosureInfo _ _ sm_rep) = sm_rep
897 closureLFInfo :: ClosureInfo -> LambdaFormInfo
898 closureLFInfo (MkClosureInfo _ lf_info _) = lf_info
900 closureUpdReqd :: ClosureInfo -> Bool
901 closureUpdReqd (MkClosureInfo _ (LFThunk _ _ _ upd _ _ _) _) = upd
902 closureUpdReqd (MkClosureInfo _ (LFBlackHole _) _) = True
903 -- Black-hole closures are allocated to receive the results of an
904 -- alg case with a named default... so they need to be updated.
905 closureUpdReqd other_closure = False
907 closureSingleEntry :: ClosureInfo -> Bool
908 closureSingleEntry (MkClosureInfo _ (LFThunk _ _ _ upd _ _ _) _) = not upd
909 closureSingleEntry other_closure = False
911 closureReEntrant :: ClosureInfo -> Bool
912 closureReEntrant (MkClosureInfo _ (LFReEntrant _ _ _ _ _ _) _) = True
913 closureReEntrant other_closure = False
917 closureSemiTag :: ClosureInfo -> Maybe Int
918 closureSemiTag (MkClosureInfo _ lf_info _)
920 LFCon data_con _ -> Just (dataConTag data_con - fIRST_TAG)
921 LFTuple _ _ -> Just 0
926 isToplevClosure :: ClosureInfo -> Bool
928 isToplevClosure (MkClosureInfo _ lf_info _)
930 LFReEntrant _ TopLevel _ _ _ _ -> True
931 LFThunk _ TopLevel _ _ _ _ _ -> True
936 isLetNoEscape :: ClosureInfo -> Bool
938 isLetNoEscape (MkClosureInfo _ (LFLetNoEscape _) _) = True
939 isLetNoEscape _ = False
945 fastLabelFromCI :: ClosureInfo -> CLabel
946 fastLabelFromCI (MkClosureInfo name (LFReEntrant _ _ arity _ _ _) _)
947 = mkFastEntryLabel name arity
949 fastLabelFromCI (MkClosureInfo name _ _)
950 = pprPanic "fastLabelFromCI" (ppr name)
952 infoTableLabelFromCI :: ClosureInfo -> CLabel
953 infoTableLabelFromCI (MkClosureInfo id lf_info rep)
955 LFCon con _ -> mkConInfoPtr con rep
956 LFTuple tup _ -> mkConInfoPtr tup rep
958 LFBlackHole info -> info
960 LFThunk _ _ _ upd_flag (SelectorThunk offset) _ _ ->
961 mkSelectorInfoLabel upd_flag offset
963 LFThunk _ _ _ upd_flag (ApThunk arity) _ _ ->
964 mkApInfoTableLabel upd_flag arity
966 other -> {-NO: if isStaticRep rep
967 then mkStaticInfoTableLabel id
968 else -} mkInfoTableLabel id
970 mkConInfoPtr :: DataCon -> SMRep -> CLabel
973 StaticRep _ _ _ -> mkStaticInfoTableLabel name
974 _ -> mkConInfoTableLabel name
976 name = dataConName con
978 mkConEntryPtr :: DataCon -> SMRep -> CLabel
979 mkConEntryPtr con rep
981 StaticRep _ _ _ -> mkStaticConEntryLabel (dataConName con)
982 _ -> mkConEntryLabel (dataConName con)
984 name = dataConName con
986 closureLabelFromCI (MkClosureInfo name _ rep)
988 = mkStaticClosureLabel name
989 -- This case catches those pesky static closures for nullary constructors
991 closureLabelFromCI (MkClosureInfo id _ other_rep) = mkClosureLabel id
993 entryLabelFromCI :: ClosureInfo -> CLabel
994 entryLabelFromCI (MkClosureInfo id lf_info rep)
996 LFThunk _ _ _ upd_flag std_form_info _ _ -> thunkEntryLabel id std_form_info upd_flag
997 LFCon con _ -> mkConEntryPtr con rep
998 LFTuple tup _ -> mkConEntryPtr tup rep
999 other -> mkStdEntryLabel id
1001 -- thunkEntryLabel is a local help function, not exported. It's used from both
1002 -- entryLabelFromCI and getEntryConvention.
1004 thunkEntryLabel thunk_id (ApThunk arity) is_updatable
1005 = mkApEntryLabel is_updatable arity
1006 thunkEntryLabel thunk_id (SelectorThunk offset) upd_flag
1007 = mkSelectorEntryLabel upd_flag offset
1008 thunkEntryLabel thunk_id _ is_updatable
1009 = mkStdEntryLabel thunk_id
1013 allocProfilingMsg :: ClosureInfo -> FAST_STRING
1015 allocProfilingMsg (MkClosureInfo _ lf_info _)
1017 LFReEntrant _ _ _ _ _ _ -> SLIT("TICK_ALLOC_FUN")
1018 LFCon _ _ -> SLIT("TICK_ALLOC_CON")
1019 LFTuple _ _ -> SLIT("TICK_ALLOC_CON")
1020 LFThunk _ _ _ True _ _ _ -> SLIT("TICK_ALLOC_UP_THK") -- updatable
1021 LFThunk _ _ _ False _ _ _ -> SLIT("TICK_ALLOC_SE_THK") -- nonupdatable
1022 LFBlackHole _ -> SLIT("TICK_ALLOC_BH")
1023 LFImported -> panic "TICK_ALLOC_IMP"
1026 We need a black-hole closure info to pass to @allocDynClosure@ when we
1027 want to allocate the black hole on entry to a CAF. These are the only
1028 ways to build an LFBlackHole, maintaining the invariant that it really
1029 is a black hole and not something else.
1032 cafBlackHoleClosureInfo (MkClosureInfo name _ _)
1033 = MkClosureInfo name (LFBlackHole mkCAFBlackHoleInfoTableLabel) BlackHoleRep
1035 seCafBlackHoleClosureInfo (MkClosureInfo name _ _)
1036 = MkClosureInfo name (LFBlackHole mkSECAFBlackHoleInfoTableLabel) BlackHoleRep
1039 %************************************************************************
1041 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
1043 %************************************************************************
1045 Profiling requires two pieces of information to be determined for
1046 each closure's info table --- description and type.
1048 The description is stored directly in the @CClosureInfoTable@ when the
1049 info table is built.
1051 The type is determined from the type information stored with the @Id@
1052 in the closure info using @closureTypeDescr@.
1055 closureTypeDescr :: ClosureInfo -> String
1056 closureTypeDescr (MkClosureInfo name (LFThunk ty _ _ _ _ _ _) _)
1057 = getTyDescription ty
1058 closureTypeDescr (MkClosureInfo name (LFReEntrant ty _ _ _ _ _) _)
1059 = getTyDescription ty
1060 closureTypeDescr (MkClosureInfo name lf _)
1061 = showSDoc (ppr name)