2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: ClosureInfo.lhs,v 1.45 2001/02/20 09:38:59 simonpj 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,
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, idArityInfo )
83 import DataCon ( DataCon, dataConTag, fIRST_TAG, dataConTyCon,
84 isNullaryDataCon, dataConName
86 import TyCon ( isBoxedTupleTyCon )
87 import IdInfo ( ArityInfo(..) )
88 import Name ( Name, nameUnique, getOccName )
89 import OccName ( occNameUserString )
90 import PprType ( getTyDescription )
91 import PrimRep ( getPrimRepSize, separateByPtrFollowness, PrimRep )
92 import SMRep -- all of it
93 import Type ( isUnLiftedType, Type )
94 import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel )
95 import Util ( mapAccumL )
99 The ``wrapper'' data type for closure information:
104 Name -- The thing bound to this closure
105 LambdaFormInfo -- info derivable from the *source*
106 SMRep -- representation used by storage manager
109 %************************************************************************
111 \subsection[ClosureInfo-datatypes]{Data types for closure information}
113 %************************************************************************
115 %************************************************************************
117 \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
119 %************************************************************************
123 = LFReEntrant -- Reentrant closure; used for PAPs too
124 Type -- Type of closure (ToDo: remove)
125 TopLevelFlag -- True if top level
127 !Bool -- True <=> no fvs
131 | LFCon -- Constructor
132 DataCon -- The constructor
133 Bool -- True <=> zero arity
136 DataCon -- The tuple constructor
137 Bool -- True <=> zero arity
139 | LFThunk -- Thunk (zero arity)
140 Type -- Type of the thunk (ToDo: remove)
142 !Bool -- True <=> no free vars
143 Bool -- True <=> updatable (i.e., *not* single-entry)
148 | LFArgument -- Used for function arguments. We know nothing about
149 -- this closure. Treat like updatable "LFThunk"...
151 | LFImported -- Used for imported things. We know nothing about this
152 -- closure. Treat like updatable "LFThunk"...
153 -- Imported things which we do know something about use
154 -- one of the other LF constructors (eg LFReEntrant for
157 | LFLetNoEscape -- See LetNoEscape module for precise description of
161 | LFBlackHole -- Used for the closures allocated to hold the result
162 -- of a CAF. We want the target of the update frame to
163 -- be in the heap, so we make a black hole to hold it.
164 CLabel -- Flavour (info label, eg CAF_BLACKHOLE_info).
167 data StandardFormInfo -- Tells whether this thunk has one of a small number
170 = NonStandardThunk -- No, it isn't
173 Int -- 0-origin offset of ak within the "goods" of
174 -- constructor (Recall that the a1,...,an may be laid
175 -- out in the heap in a non-obvious order.)
177 {- A SelectorThunk is of form
182 and the constructor is from a single-constr type.
188 {- An ApThunk is of form
192 The code for the thunk just pushes x2..xn on the stack and enters x1.
193 There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
194 in the RTS to save space.
199 %************************************************************************
201 \subsection[ClosureInfo-construction]{Functions which build LFInfos}
203 %************************************************************************
205 @mkClosureLFInfo@ figures out the appropriate LFInfo for the closure.
208 mkClosureLFInfo :: Id -- The binder
209 -> TopLevelFlag -- True of top level
211 -> UpdateFlag -- Update flag
213 -> CLabel -- SRT label
217 mkClosureLFInfo bndr top fvs upd_flag args@(_:_) srt_label srt -- Non-empty args
218 = LFReEntrant (idType bndr) top (length args) (null fvs) srt_label srt
220 mkClosureLFInfo bndr top fvs ReEntrant [] srt_label srt
221 = LFReEntrant (idType bndr) top 0 (null fvs) srt_label srt
223 mkClosureLFInfo bndr top fvs upd_flag [] srt_label srt
225 | isUnLiftedType ty = pprPanic "mkClosureLFInfo" (ppr bndr <+> ppr ty)
228 = LFThunk ty top (null fvs) (isUpdatable upd_flag) NonStandardThunk
234 @mkConLFInfo@ is similar, for constructors.
237 mkConLFInfo :: DataCon -> LambdaFormInfo
240 = -- the isNullaryDataCon will do this: ASSERT(isDataCon con)
241 (if isBoxedTupleTyCon (dataConTyCon con) then LFTuple else LFCon)
242 con (isNullaryDataCon con)
244 mkSelectorLFInfo rhs_ty offset updatable
245 = LFThunk rhs_ty NotTopLevel False updatable (SelectorThunk offset)
246 (error "mkSelectorLFInfo: no srt label")
247 (error "mkSelectorLFInfo: no srt")
249 mkApLFInfo rhs_ty upd_flag arity
250 = LFThunk rhs_ty NotTopLevel (arity == 0) (isUpdatable upd_flag)
252 (error "mkApLFInfo: no srt label")
253 (error "mkApLFInfo: no srt")
256 Miscellaneous LF-infos.
259 mkLFArgument = LFArgument
260 mkLFLetNoEscape = LFLetNoEscape
262 mkLFImported :: Id -> LambdaFormInfo
264 = case idArityInfo id of
265 ArityExactly 0 -> LFThunk (idType id)
266 TopLevel True{-no fvs-}
267 True{-updatable-} NonStandardThunk
268 (error "mkLFImported: no srt label")
269 (error "mkLFImported: no srt")
270 ArityExactly n -> LFReEntrant (idType id) TopLevel n True -- n > 0
271 (error "mkLFImported: no srt label")
272 (error "mkLFImported: no srt")
273 other -> LFImported -- Not sure of exact arity
276 %************************************************************************
278 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
280 %************************************************************************
283 closureSize :: ClosureInfo -> HeapOffset
284 closureSize cl_info@(MkClosureInfo _ _ sm_rep)
285 = fixedHdrSize + closureNonHdrSize cl_info
287 closureNonHdrSize :: ClosureInfo -> Int
288 closureNonHdrSize cl_info@(MkClosureInfo _ lf_info sm_rep)
289 = tot_wds + computeSlopSize tot_wds sm_rep (closureUpdReqd cl_info)
290 --ToDo: pass lf_info?
292 tot_wds = closureGoodStuffSize cl_info
294 closureGoodStuffSize :: ClosureInfo -> Int
295 closureGoodStuffSize (MkClosureInfo _ _ sm_rep)
296 = let (ptrs, nonptrs) = sizes_from_SMRep sm_rep
299 closurePtrsSize :: ClosureInfo -> Int
300 closurePtrsSize (MkClosureInfo _ _ sm_rep)
301 = let (ptrs, _) = sizes_from_SMRep sm_rep
305 sizes_from_SMRep :: SMRep -> (Int,Int)
306 sizes_from_SMRep (GenericRep _ ptrs nonptrs _) = (ptrs, nonptrs)
307 sizes_from_SMRep BlackHoleRep = (0, 0)
310 Computing slop size. WARNING: this looks dodgy --- it has deep
311 knowledge of what the storage manager does with the various
317 Updateable closures must be @mIN_UPD_SIZE@.
320 Indirections require 1 word
322 Appels collector indirections 2 words
324 THEREFORE: @mIN_UPD_SIZE = 2@.
327 Collectable closures which are allocated in the heap
328 must be @mIN_SIZE_NonUpdHeapObject@.
330 Copying collector forward pointer requires 1 word
332 THEREFORE: @mIN_SIZE_NonUpdHeapObject = 1@
335 Static closures have an extra ``static link field'' at the end, but we
336 don't bother taking that into account here.
339 slopSize cl_info@(MkClosureInfo _ lf_info sm_rep)
340 = computeSlopSize (closureGoodStuffSize cl_info) sm_rep
341 (closureUpdReqd cl_info)
343 computeSlopSize :: Int -> SMRep -> Bool -> Int
345 computeSlopSize tot_wds (GenericRep _ _ _ _) True -- Updatable
346 = max 0 (mIN_UPD_SIZE - tot_wds)
348 computeSlopSize tot_wds (GenericRep True _ _ _) False -- Non updatable
351 computeSlopSize tot_wds (GenericRep False _ _ _) False -- Non updatable
352 = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds) -- Dynamic
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 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 (GenericRep is_static ptr_wds (tot_wds - ptr_wds) closure_type),
413 (tot_wds, -- #ptr_wds + #nonptr_wds
415 things_w_offsets) = mkVirtHeapOffsets 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 = getClosureType is_static tot_wds ptr_wds lf_info
423 layOutStaticNoFVClosure :: Name -> LambdaFormInfo -> ClosureInfo
424 layOutStaticNoFVClosure name lf_info
425 = MkClosureInfo name lf_info (GenericRep is_static 0 0 (getClosureType is_static 0 0 lf_info))
430 %************************************************************************
432 \subsection[SMreps]{Choosing SM reps}
434 %************************************************************************
439 -> Int -> Int -- Tot wds, ptr wds
442 chooseDynSMRep lf_info tot_wds ptr_wds
445 nonptr_wds = tot_wds - ptr_wds
446 closure_type = getClosureType is_static tot_wds ptr_wds lf_info
448 GenericRep is_static ptr_wds nonptr_wds closure_type
450 -- we *do* get non-updatable top-level thunks sometimes. eg. f = g
451 -- gets compiled to a jump to g (if g has non-zero arity), instead of
452 -- messing around with update frames and PAPs. We set the closure type
453 -- to FUN_STATIC in this case.
455 getClosureType :: Bool -> Int -> Int -> LambdaFormInfo -> ClosureType
456 getClosureType is_static tot_wds ptr_wds lf_info
459 | is_static && ptr_wds == 0 -> CONSTR_NOCAF
460 | specialised_rep mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n
461 | otherwise -> CONSTR
464 | is_static && ptr_wds == 0 -> CONSTR_NOCAF
465 | specialised_rep mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n
466 | otherwise -> CONSTR
468 LFReEntrant _ _ _ _ _ _
469 | specialised_rep mAX_SPEC_FUN_SIZE -> FUN_p_n
472 LFThunk _ _ _ _ (SelectorThunk _) _ _ -> THUNK_SELECTOR
474 LFThunk _ _ _ _ _ _ _
475 | specialised_rep mAX_SPEC_THUNK_SIZE -> THUNK_p_n
478 _ -> panic "getClosureType"
480 specialised_rep max_size = not is_static
482 && tot_wds <= max_size
485 %************************************************************************
487 \subsection[mkVirtHeapOffsets]{Assigning heap offsets in a closure}
489 %************************************************************************
491 @mkVirtHeapOffsets@ (the heap version) always returns boxed things with
492 smaller offsets than the unboxed things, and furthermore, the offsets in
497 (a -> PrimRep) -- To be able to grab kinds;
498 -- w/ a kind, we can find boxedness
499 -> [a] -- Things to make offsets for
500 -> (Int, -- *Total* number of words allocated
501 Int, -- Number of words allocated for *pointers*
502 [(a, VirtualHeapOffset)])
503 -- Things with their offsets from start of
504 -- object in order of increasing offset
506 -- First in list gets lowest offset, which is initial offset + 1.
508 mkVirtHeapOffsets kind_fun things
509 = let (ptrs, non_ptrs) = separateByPtrFollowness kind_fun things
510 (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
511 (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
513 (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
515 computeOffset wds_so_far thing
516 = (wds_so_far + (getPrimRepSize . kind_fun) thing,
517 (thing, fixedHdrSize + wds_so_far)
521 %************************************************************************
523 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
525 %************************************************************************
527 Be sure to see the stg-details notes about these...
530 nodeMustPointToIt :: LambdaFormInfo -> FCode Bool
531 nodeMustPointToIt lf_info
534 LFReEntrant ty top arity no_fvs _ _ -> returnFC (
535 not no_fvs || -- Certainly if it has fvs we need to point to it
537 -- If it is not top level we will point to it
538 -- We can have a \r closure with no_fvs which
539 -- is not top level as special case cgRhsClosure
540 -- has been dissabled in favour of let floating
542 -- For lex_profiling we also access the cost centre for a
543 -- non-inherited function i.e. not top level
544 -- the not top case above ensures this is ok.
547 LFCon _ zero_arity -> returnFC True
548 LFTuple _ zero_arity -> returnFC True
550 -- Strictly speaking, the above two don't need Node to point
551 -- to it if the arity = 0. But this is a *really* unlikely
552 -- situation. If we know it's nil (say) and we are entering
553 -- it. Eg: let x = [] in x then we will certainly have inlined
554 -- x, since nil is a simple atom. So we gain little by not
555 -- having Node point to known zero-arity things. On the other
556 -- hand, we do lose something; Patrick's code for figuring out
557 -- when something has been updated but not entered relies on
558 -- having Node point to the result of an update. SLPJ
561 LFThunk _ _ no_fvs updatable NonStandardThunk _ _
562 -> returnFC (updatable || not no_fvs || opt_SccProfilingOn)
564 -- For the non-updatable (single-entry case):
566 -- True if has fvs (in which case we need access to them, and we
567 -- should black-hole it)
568 -- or profiling (in which case we need to recover the cost centre
571 LFThunk _ _ no_fvs updatable some_standard_form_thunk _ _
573 -- Node must point to any standard-form thunk.
575 LFArgument -> returnFC True
576 LFImported -> returnFC True
577 LFBlackHole _ -> returnFC True
578 -- BH entry may require Node to point
580 LFLetNoEscape _ -> returnFC False
583 The entry conventions depend on the type of closure being entered,
584 whether or not it has free variables, and whether we're running
585 sequentially or in parallel.
587 \begin{tabular}{lllll}
588 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
589 Unknown & no & yes & stack & node \\
590 Known fun ($\ge$ 1 arg), no fvs & no & no & registers & fast entry (enough args) \\
591 \ & \ & \ & \ & slow entry (otherwise) \\
592 Known fun ($\ge$ 1 arg), fvs & no & yes & registers & fast entry (enough args) \\
593 0 arg, no fvs @\r,\s@ & no & no & n/a & direct entry \\
594 0 arg, no fvs @\u@ & no & yes & n/a & node \\
595 0 arg, fvs @\r,\s@ & no & yes & n/a & direct entry \\
596 0 arg, fvs @\u@ & no & yes & n/a & node \\
598 Unknown & yes & yes & stack & node \\
599 Known fun ($\ge$ 1 arg), no fvs & yes & no & registers & fast entry (enough args) \\
600 \ & \ & \ & \ & slow entry (otherwise) \\
601 Known fun ($\ge$ 1 arg), fvs & yes & yes & registers & node \\
602 0 arg, no fvs @\r,\s@ & yes & no & n/a & direct entry \\
603 0 arg, no fvs @\u@ & yes & yes & n/a & node \\
604 0 arg, fvs @\r,\s@ & yes & yes & n/a & node \\
605 0 arg, fvs @\u@ & yes & yes & n/a & node\\
608 When black-holing, single-entry closures could also be entered via node
609 (rather than directly) to catch double-entry.
613 = ViaNode -- The "normal" convention
615 | StdEntry CLabel -- Jump to this code, with args on stack
617 | DirectEntry -- Jump directly, with args in regs
618 CLabel -- The code label
620 [MagicId] -- Its register assignments
623 getEntryConvention :: Name -- Function being applied
624 -> LambdaFormInfo -- Its info
625 -> [PrimRep] -- Available arguments
626 -> FCode EntryConvention
628 getEntryConvention name lf_info arg_kinds
629 = nodeMustPointToIt lf_info `thenFC` \ node_points ->
632 -- if we're parallel, then we must always enter via node. The reason
633 -- is that the closure may have been fetched since we allocated it.
635 if (node_points && opt_Parallel) then ViaNode else
637 -- Commented out by SDM after futher thoughts:
638 -- - the only closure type that can be blackholed is a thunk
639 -- - we already enter thunks via node (unless the closure is
640 -- non-updatable, in which case why is it being re-entered...)
644 LFReEntrant _ _ arity _ _ _ ->
645 if arity == 0 || (length arg_kinds) < arity then
646 StdEntry (mkStdEntryLabel name)
648 DirectEntry (mkFastEntryLabel name arity) arity arg_regs
650 (arg_regs, _) = assignRegs live_regs (take arity arg_kinds)
651 live_regs = if node_points then [node] else []
653 LFCon con True{-zero_arity-}
654 -- a real constructor. Don't bother entering it, just jump
655 -- to the constructor entry code directly.
656 -> --false:ASSERT (null arg_kinds)
657 -- Should have no args (meaning what?)
658 StdEntry (mkStaticConEntryLabel (dataConName con))
660 LFCon con False{-non-zero_arity-}
661 -> --false:ASSERT (null arg_kinds)
662 -- Should have no args (meaning what?)
663 StdEntry (mkConEntryLabel (dataConName con))
665 LFTuple tup zero_arity
666 -> --false:ASSERT (null arg_kinds)
667 -- Should have no args (meaning what?)
668 StdEntry (mkConEntryLabel (dataConName tup))
670 LFThunk _ _ _ updatable std_form_info _ _
671 -> if updatable || opt_DoTickyProfiling -- to catch double entry
672 || opt_SMP -- always enter via node on SMP, since the
673 -- thunk might have been blackholed in the
676 else StdEntry (thunkEntryLabel name std_form_info updatable)
678 LFArgument -> ViaNode
679 LFImported -> ViaNode
680 LFBlackHole _ -> ViaNode -- Presumably the black hole has by now
681 -- been updated, but we don't know with
682 -- what, so we enter via Node
685 -> StdEntry (mkReturnPtLabel (nameUnique name))
688 -> if (arity /= length arg_kinds) then pprPanic "let-no-escape: " (ppr name <+> ppr arity) else
689 DirectEntry (mkReturnPtLabel (nameUnique name)) arity arg_regs
691 (arg_regs, _) = assignRegs [] arg_kinds
692 -- node never points to a LetNoEscape, see above --SDM
693 --live_regs = if node_points then [node] else []
696 blackHoleOnEntry :: ClosureInfo -> Bool
698 -- Static closures are never themselves black-holed.
699 -- Updatable ones will be overwritten with a CAFList cell, which points to a
701 -- Single-entry ones have no fvs to plug, and we trust they don't form part
704 blackHoleOnEntry (MkClosureInfo _ _ rep)
707 -- Never black-hole a static closure
709 blackHoleOnEntry (MkClosureInfo _ lf_info _)
711 LFReEntrant _ _ _ _ _ _ -> False
712 LFLetNoEscape _ -> False
713 LFThunk _ _ no_fvs updatable _ _ _
715 then not opt_OmitBlackHoling
716 else opt_DoTickyProfiling || not no_fvs
717 -- the former to catch double entry,
718 -- and the latter to plug space-leaks. KSW/SDM 1999-04.
720 other -> panic "blackHoleOnEntry" -- Should never happen
722 isStandardFormThunk :: LambdaFormInfo -> Bool
724 isStandardFormThunk (LFThunk _ _ _ _ (SelectorThunk _) _ _) = True
725 isStandardFormThunk (LFThunk _ _ _ _ (ApThunk _) _ _) = True
726 isStandardFormThunk other_lf_info = False
728 maybeSelectorInfo (MkClosureInfo _ (LFThunk _ _ _ _
729 (SelectorThunk offset) _ _) _) = Just offset
730 maybeSelectorInfo _ = Nothing
733 -----------------------------------------------------------------------------
738 infoTblNeedsSRT :: ClosureInfo -> Bool
739 infoTblNeedsSRT (MkClosureInfo _ info _) =
741 LFThunk _ _ _ _ _ _ NoSRT -> False
742 LFThunk _ _ _ _ _ _ _ -> True
744 LFReEntrant _ _ _ _ _ NoSRT -> False
745 LFReEntrant _ _ _ _ _ _ -> True
749 staticClosureNeedsLink :: ClosureInfo -> Bool
750 staticClosureNeedsLink (MkClosureInfo _ info _) =
752 LFThunk _ _ _ _ _ _ NoSRT -> False
753 LFReEntrant _ _ _ _ _ NoSRT -> False
754 LFCon _ True -> False -- zero arity constructors
757 getSRTInfo :: ClosureInfo -> (CLabel, SRT)
758 getSRTInfo (MkClosureInfo _ info _) =
760 LFThunk _ _ _ _ _ lbl srt -> (lbl,srt)
761 LFReEntrant _ _ _ _ lbl srt -> (lbl,srt)
762 _ -> panic "getSRTInfo"
765 Avoiding generating entries and info tables
766 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
767 At present, for every function we generate all of the following,
768 just in case. But they aren't always all needed, as noted below:
770 [NB1: all of this applies only to *functions*. Thunks always
771 have closure, info table, and entry code.]
773 [NB2: All are needed if the function is *exported*, just to play safe.]
776 * Fast-entry code ALWAYS NEEDED
779 Needed iff (a) we have any un-saturated calls to the function
780 OR (b) the function is passed as an arg
781 OR (c) we're in the parallel world and the function has free vars
782 [Reason: in parallel world, we always enter functions
783 with free vars via the closure.]
785 * The function closure
786 Needed iff (a) we have any un-saturated calls to the function
787 OR (b) the function is passed as an arg
788 OR (c) if the function has free vars (ie not top level)
790 Why case (a) here? Because if the arg-satis check fails,
791 UpdatePAP stuffs a pointer to the function closure in the PAP.
792 [Could be changed; UpdatePAP could stuff in a code ptr instead,
793 but doesn't seem worth it.]
795 [NB: these conditions imply that we might need the closure
796 without the slow-entry code. Here's how.
798 f x y = let g w = ...x..y..w...
802 Here we need a closure for g which contains x and y,
803 but since the calls are all saturated we just jump to the
804 fast entry point for g, with R1 pointing to the closure for g.]
807 * Standard info table
808 Needed iff (a) we have any un-saturated calls to the function
809 OR (b) the function is passed as an arg
810 OR (c) the function has free vars (ie not top level)
812 NB. In the sequential world, (c) is only required so that the function closure has
813 an info table to point to, to keep the storage manager happy.
814 If (c) alone is true we could fake up an info table by choosing
815 one of a standard family of info tables, whose entry code just
818 [NB In the parallel world (c) is needed regardless because
819 we enter functions with free vars via the closure.]
821 If (c) is retained, then we'll sometimes generate an info table
822 (for storage mgr purposes) without slow-entry code. Then we need
823 to use an error label in the info table to substitute for the absent
827 staticClosureRequired
832 staticClosureRequired binder bndr_info
833 (LFReEntrant _ top_level _ _ _ _) -- It's a function
834 = ASSERT( isTopLevel top_level )
835 -- Assumption: it's a top-level, no-free-var binding
836 not (satCallsOnly bndr_info)
838 staticClosureRequired binder other_binder_info other_lf_info = True
840 slowFunEntryCodeRequired -- Assumption: it's a function, not a thunk.
845 slowFunEntryCodeRequired binder bndr_info entry_conv
846 = not (satCallsOnly bndr_info)
847 || (case entry_conv of { DirectEntry _ _ _ -> False; other -> True })
848 {- The last case deals with the parallel world; a function usually
849 as a DirectEntry convention, but if it doesn't we must generate slow-entry code -}
856 funInfoTableRequired binder bndr_info (LFReEntrant _ top_level _ _ _ _)
857 = isNotTopLevel top_level
858 || not (satCallsOnly bndr_info)
860 funInfoTableRequired other_binder_info binder other_lf_info = True
863 %************************************************************************
865 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
867 %************************************************************************
871 isStaticClosure :: ClosureInfo -> Bool
872 isStaticClosure (MkClosureInfo _ _ rep) = isStaticRep rep
874 closureName :: ClosureInfo -> Name
875 closureName (MkClosureInfo name _ _) = name
877 closureSMRep :: ClosureInfo -> SMRep
878 closureSMRep (MkClosureInfo _ _ sm_rep) = sm_rep
880 closureLFInfo :: ClosureInfo -> LambdaFormInfo
881 closureLFInfo (MkClosureInfo _ lf_info _) = lf_info
883 closureUpdReqd :: ClosureInfo -> Bool
884 closureUpdReqd (MkClosureInfo _ (LFThunk _ _ _ upd _ _ _) _) = upd
885 closureUpdReqd (MkClosureInfo _ (LFBlackHole _) _) = True
886 -- Black-hole closures are allocated to receive the results of an
887 -- alg case with a named default... so they need to be updated.
888 closureUpdReqd other_closure = False
890 closureSingleEntry :: ClosureInfo -> Bool
891 closureSingleEntry (MkClosureInfo _ (LFThunk _ _ _ upd _ _ _) _) = not upd
892 closureSingleEntry other_closure = False
894 closureReEntrant :: ClosureInfo -> Bool
895 closureReEntrant (MkClosureInfo _ (LFReEntrant _ _ _ _ _ _) _) = True
896 closureReEntrant other_closure = False
900 closureSemiTag :: ClosureInfo -> Maybe Int
901 closureSemiTag (MkClosureInfo _ lf_info _)
903 LFCon data_con _ -> Just (dataConTag data_con - fIRST_TAG)
904 LFTuple _ _ -> Just 0
909 isToplevClosure :: ClosureInfo -> Bool
911 isToplevClosure (MkClosureInfo _ lf_info _)
913 LFReEntrant _ TopLevel _ _ _ _ -> True
914 LFThunk _ TopLevel _ _ _ _ _ -> True
919 isLetNoEscape :: ClosureInfo -> Bool
921 isLetNoEscape (MkClosureInfo _ (LFLetNoEscape _) _) = True
922 isLetNoEscape _ = False
928 fastLabelFromCI :: ClosureInfo -> CLabel
929 fastLabelFromCI (MkClosureInfo name (LFReEntrant _ _ arity _ _ _) _)
930 = mkFastEntryLabel name arity
932 fastLabelFromCI (MkClosureInfo name _ _)
933 = pprPanic "fastLabelFromCI" (ppr name)
935 infoTableLabelFromCI :: ClosureInfo -> CLabel
936 infoTableLabelFromCI (MkClosureInfo id lf_info rep)
938 LFCon con _ -> mkConInfoPtr con rep
939 LFTuple tup _ -> mkConInfoPtr tup rep
941 LFBlackHole info -> info
943 LFThunk _ _ _ upd_flag (SelectorThunk offset) _ _ ->
944 mkSelectorInfoLabel upd_flag offset
946 LFThunk _ _ _ upd_flag (ApThunk arity) _ _ ->
947 mkApInfoTableLabel upd_flag arity
949 other -> {-NO: if isStaticRep rep
950 then mkStaticInfoTableLabel id
951 else -} mkInfoTableLabel id
953 mkConInfoPtr :: DataCon -> SMRep -> CLabel
955 | isStaticRep rep = mkStaticInfoTableLabel name
956 | otherwise = mkConInfoTableLabel name
958 name = dataConName con
960 mkConEntryPtr :: DataCon -> SMRep -> CLabel
961 mkConEntryPtr con rep
962 | isStaticRep rep = mkStaticConEntryLabel (dataConName con)
963 | otherwise = mkConEntryLabel (dataConName con)
965 closureLabelFromCI (MkClosureInfo id _ other_rep) = mkClosureLabel id
967 entryLabelFromCI :: ClosureInfo -> CLabel
968 entryLabelFromCI (MkClosureInfo id lf_info rep)
970 LFThunk _ _ _ upd_flag std_form_info _ _ -> thunkEntryLabel id std_form_info upd_flag
971 LFCon con _ -> mkConEntryPtr con rep
972 LFTuple tup _ -> mkConEntryPtr tup rep
973 other -> mkStdEntryLabel id
975 -- thunkEntryLabel is a local help function, not exported. It's used from both
976 -- entryLabelFromCI and getEntryConvention.
978 thunkEntryLabel thunk_id (ApThunk arity) is_updatable
979 = mkApEntryLabel is_updatable arity
980 thunkEntryLabel thunk_id (SelectorThunk offset) upd_flag
981 = mkSelectorEntryLabel upd_flag offset
982 thunkEntryLabel thunk_id _ is_updatable
983 = mkStdEntryLabel thunk_id
987 allocProfilingMsg :: ClosureInfo -> FAST_STRING
989 allocProfilingMsg (MkClosureInfo _ lf_info _)
991 LFReEntrant _ _ _ _ _ _ -> SLIT("TICK_ALLOC_FUN")
992 LFCon _ _ -> SLIT("TICK_ALLOC_CON")
993 LFTuple _ _ -> SLIT("TICK_ALLOC_CON")
994 LFThunk _ _ _ True _ _ _ -> SLIT("TICK_ALLOC_UP_THK") -- updatable
995 LFThunk _ _ _ False _ _ _ -> SLIT("TICK_ALLOC_SE_THK") -- nonupdatable
996 LFBlackHole _ -> SLIT("TICK_ALLOC_BH")
997 LFImported -> panic "TICK_ALLOC_IMP"
1000 We need a black-hole closure info to pass to @allocDynClosure@ when we
1001 want to allocate the black hole on entry to a CAF. These are the only
1002 ways to build an LFBlackHole, maintaining the invariant that it really
1003 is a black hole and not something else.
1006 cafBlackHoleClosureInfo (MkClosureInfo name _ _)
1007 = MkClosureInfo name (LFBlackHole mkCAFBlackHoleInfoTableLabel) BlackHoleRep
1009 seCafBlackHoleClosureInfo (MkClosureInfo name _ _)
1010 = MkClosureInfo name (LFBlackHole mkSECAFBlackHoleInfoTableLabel) BlackHoleRep
1013 %************************************************************************
1015 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
1017 %************************************************************************
1019 Profiling requires two pieces of information to be determined for
1020 each closure's info table --- description and type.
1022 The description is stored directly in the @CClosureInfoTable@ when the
1023 info table is built.
1025 The type is determined from the type information stored with the @Id@
1026 in the closure info using @closureTypeDescr@.
1029 closureTypeDescr :: ClosureInfo -> String
1030 closureTypeDescr (MkClosureInfo name (LFThunk ty _ _ _ _ _ _) _)
1031 = getTyDescription ty
1032 closureTypeDescr (MkClosureInfo name (LFReEntrant ty _ _ _ _ _) _)
1033 = getTyDescription ty
1034 closureTypeDescr (MkClosureInfo name (LFCon data_con _) _)
1035 = occNameUserString (getOccName (dataConTyCon data_con))
1036 closureTypeDescr (MkClosureInfo name lf _)
1037 = showSDoc (ppr name)