2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: ClosureInfo.lhs,v 1.46 2001/03/13 12:50:30 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,
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, idCgArity )
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 idCgArity id of
265 n | n > 0 -> LFReEntrant (idType id) TopLevel n True -- n > 0
266 (error "mkLFImported: no srt label")
267 (error "mkLFImported: no srt")
268 other -> LFImported -- Not sure of exact arity
271 %************************************************************************
273 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
275 %************************************************************************
278 closureSize :: ClosureInfo -> HeapOffset
279 closureSize cl_info@(MkClosureInfo _ _ sm_rep)
280 = fixedHdrSize + closureNonHdrSize cl_info
282 closureNonHdrSize :: ClosureInfo -> Int
283 closureNonHdrSize cl_info@(MkClosureInfo _ lf_info sm_rep)
284 = tot_wds + computeSlopSize tot_wds sm_rep (closureUpdReqd cl_info)
285 --ToDo: pass lf_info?
287 tot_wds = closureGoodStuffSize cl_info
289 closureGoodStuffSize :: ClosureInfo -> Int
290 closureGoodStuffSize (MkClosureInfo _ _ sm_rep)
291 = let (ptrs, nonptrs) = sizes_from_SMRep sm_rep
294 closurePtrsSize :: ClosureInfo -> Int
295 closurePtrsSize (MkClosureInfo _ _ sm_rep)
296 = let (ptrs, _) = sizes_from_SMRep sm_rep
300 sizes_from_SMRep :: SMRep -> (Int,Int)
301 sizes_from_SMRep (GenericRep _ ptrs nonptrs _) = (ptrs, nonptrs)
302 sizes_from_SMRep BlackHoleRep = (0, 0)
305 Computing slop size. WARNING: this looks dodgy --- it has deep
306 knowledge of what the storage manager does with the various
312 Updateable closures must be @mIN_UPD_SIZE@.
315 Indirections require 1 word
317 Appels collector indirections 2 words
319 THEREFORE: @mIN_UPD_SIZE = 2@.
322 Collectable closures which are allocated in the heap
323 must be @mIN_SIZE_NonUpdHeapObject@.
325 Copying collector forward pointer requires 1 word
327 THEREFORE: @mIN_SIZE_NonUpdHeapObject = 1@
330 Static closures have an extra ``static link field'' at the end, but we
331 don't bother taking that into account here.
334 slopSize cl_info@(MkClosureInfo _ lf_info sm_rep)
335 = computeSlopSize (closureGoodStuffSize cl_info) sm_rep
336 (closureUpdReqd cl_info)
338 computeSlopSize :: Int -> SMRep -> Bool -> Int
340 computeSlopSize tot_wds (GenericRep _ _ _ _) True -- Updatable
341 = max 0 (mIN_UPD_SIZE - tot_wds)
343 computeSlopSize tot_wds (GenericRep True _ _ _) False -- Non updatable
346 computeSlopSize tot_wds (GenericRep False _ _ _) False -- Non updatable
347 = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds) -- Dynamic
349 computeSlopSize tot_wds BlackHoleRep _ -- Updatable
350 = max 0 (mIN_UPD_SIZE - tot_wds)
353 %************************************************************************
355 \subsection[layOutDynClosure]{Lay out a dynamic closure}
357 %************************************************************************
360 layOutDynClosure, layOutStaticClosure
361 :: Name -- STG identifier of this closure
362 -> (a -> PrimRep) -- how to get a PrimRep for the fields
363 -> [a] -- the "things" being layed out
364 -> LambdaFormInfo -- what sort of closure it is
365 -> (ClosureInfo, -- info about the closure
366 [(a, VirtualHeapOffset)]) -- things w/ offsets pinned on them
368 layOutDynClosure name kind_fn things lf_info
369 = (MkClosureInfo name lf_info sm_rep,
372 (tot_wds, -- #ptr_wds + #nonptr_wds
374 things_w_offsets) = mkVirtHeapOffsets kind_fn things
375 sm_rep = chooseDynSMRep lf_info tot_wds ptr_wds
378 A wrapper for when used with data constructors:
381 layOutDynCon :: DataCon
384 -> (ClosureInfo, [(a,VirtualHeapOffset)])
386 layOutDynCon con kind_fn args
387 = layOutDynClosure (dataConName con) kind_fn args (mkConLFInfo con)
390 %************************************************************************
392 \subsection[layOutStaticClosure]{Lay out a static closure}
394 %************************************************************************
396 layOutStaticClosure is only used for laying out static constructors at
399 Static closures for functions are laid out using
400 layOutStaticNoFVClosure.
403 layOutStaticClosure name kind_fn things lf_info
404 = (MkClosureInfo name lf_info
405 (GenericRep is_static ptr_wds (tot_wds - ptr_wds) closure_type),
408 (tot_wds, -- #ptr_wds + #nonptr_wds
410 things_w_offsets) = mkVirtHeapOffsets kind_fn things
412 -- constructors with no pointer fields will definitely be NOCAF things.
413 -- this is a compromise until we can generate both kinds of constructor
414 -- (a normal static kind and the NOCAF_STATIC kind).
415 closure_type = getClosureType is_static tot_wds ptr_wds lf_info
418 layOutStaticNoFVClosure :: Name -> LambdaFormInfo -> ClosureInfo
419 layOutStaticNoFVClosure name lf_info
420 = MkClosureInfo name lf_info (GenericRep is_static 0 0 (getClosureType is_static 0 0 lf_info))
425 %************************************************************************
427 \subsection[SMreps]{Choosing SM reps}
429 %************************************************************************
434 -> Int -> Int -- Tot wds, ptr wds
437 chooseDynSMRep lf_info tot_wds ptr_wds
440 nonptr_wds = tot_wds - ptr_wds
441 closure_type = getClosureType is_static tot_wds ptr_wds lf_info
443 GenericRep is_static ptr_wds nonptr_wds closure_type
445 -- we *do* get non-updatable top-level thunks sometimes. eg. f = g
446 -- gets compiled to a jump to g (if g has non-zero arity), instead of
447 -- messing around with update frames and PAPs. We set the closure type
448 -- to FUN_STATIC in this case.
450 getClosureType :: Bool -> Int -> Int -> LambdaFormInfo -> ClosureType
451 getClosureType is_static tot_wds ptr_wds lf_info
454 | is_static && ptr_wds == 0 -> CONSTR_NOCAF
455 | specialised_rep mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n
456 | otherwise -> CONSTR
459 | is_static && ptr_wds == 0 -> CONSTR_NOCAF
460 | specialised_rep mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n
461 | otherwise -> CONSTR
463 LFReEntrant _ _ _ _ _ _
464 | specialised_rep mAX_SPEC_FUN_SIZE -> FUN_p_n
467 LFThunk _ _ _ _ (SelectorThunk _) _ _ -> THUNK_SELECTOR
469 LFThunk _ _ _ _ _ _ _
470 | specialised_rep mAX_SPEC_THUNK_SIZE -> THUNK_p_n
473 _ -> panic "getClosureType"
475 specialised_rep max_size = not is_static
477 && tot_wds <= max_size
480 %************************************************************************
482 \subsection[mkVirtHeapOffsets]{Assigning heap offsets in a closure}
484 %************************************************************************
486 @mkVirtHeapOffsets@ (the heap version) always returns boxed things with
487 smaller offsets than the unboxed things, and furthermore, the offsets in
492 (a -> PrimRep) -- To be able to grab kinds;
493 -- w/ a kind, we can find boxedness
494 -> [a] -- Things to make offsets for
495 -> (Int, -- *Total* number of words allocated
496 Int, -- Number of words allocated for *pointers*
497 [(a, VirtualHeapOffset)])
498 -- Things with their offsets from start of
499 -- object in order of increasing offset
501 -- First in list gets lowest offset, which is initial offset + 1.
503 mkVirtHeapOffsets kind_fun things
504 = let (ptrs, non_ptrs) = separateByPtrFollowness kind_fun things
505 (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
506 (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
508 (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
510 computeOffset wds_so_far thing
511 = (wds_so_far + (getPrimRepSize . kind_fun) thing,
512 (thing, fixedHdrSize + wds_so_far)
516 %************************************************************************
518 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
520 %************************************************************************
522 Be sure to see the stg-details notes about these...
525 nodeMustPointToIt :: LambdaFormInfo -> FCode Bool
526 nodeMustPointToIt lf_info
529 LFReEntrant ty top arity no_fvs _ _ -> returnFC (
530 not no_fvs || -- Certainly if it has fvs we need to point to it
532 -- If it is not top level we will point to it
533 -- We can have a \r closure with no_fvs which
534 -- is not top level as special case cgRhsClosure
535 -- has been dissabled in favour of let floating
537 -- For lex_profiling we also access the cost centre for a
538 -- non-inherited function i.e. not top level
539 -- the not top case above ensures this is ok.
542 LFCon _ zero_arity -> returnFC True
543 LFTuple _ zero_arity -> returnFC True
545 -- Strictly speaking, the above two don't need Node to point
546 -- to it if the arity = 0. But this is a *really* unlikely
547 -- situation. If we know it's nil (say) and we are entering
548 -- it. Eg: let x = [] in x then we will certainly have inlined
549 -- x, since nil is a simple atom. So we gain little by not
550 -- having Node point to known zero-arity things. On the other
551 -- hand, we do lose something; Patrick's code for figuring out
552 -- when something has been updated but not entered relies on
553 -- having Node point to the result of an update. SLPJ
556 LFThunk _ _ no_fvs updatable NonStandardThunk _ _
557 -> returnFC (updatable || not no_fvs || opt_SccProfilingOn)
559 -- For the non-updatable (single-entry case):
561 -- True if has fvs (in which case we need access to them, and we
562 -- should black-hole it)
563 -- or profiling (in which case we need to recover the cost centre
566 LFThunk _ _ no_fvs updatable some_standard_form_thunk _ _
568 -- Node must point to any standard-form thunk.
570 LFArgument -> returnFC True
571 LFImported -> returnFC True
572 LFBlackHole _ -> returnFC True
573 -- BH entry may require Node to point
575 LFLetNoEscape _ -> returnFC False
578 The entry conventions depend on the type of closure being entered,
579 whether or not it has free variables, and whether we're running
580 sequentially or in parallel.
582 \begin{tabular}{lllll}
583 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
584 Unknown & no & yes & stack & node \\
585 Known fun ($\ge$ 1 arg), no fvs & no & no & registers & fast entry (enough args) \\
586 \ & \ & \ & \ & slow entry (otherwise) \\
587 Known fun ($\ge$ 1 arg), fvs & no & yes & registers & fast entry (enough args) \\
588 0 arg, no fvs @\r,\s@ & no & no & n/a & direct entry \\
589 0 arg, no fvs @\u@ & no & yes & n/a & node \\
590 0 arg, fvs @\r,\s@ & no & yes & n/a & direct entry \\
591 0 arg, fvs @\u@ & no & yes & n/a & node \\
593 Unknown & yes & yes & stack & node \\
594 Known fun ($\ge$ 1 arg), no fvs & yes & no & registers & fast entry (enough args) \\
595 \ & \ & \ & \ & slow entry (otherwise) \\
596 Known fun ($\ge$ 1 arg), fvs & yes & yes & registers & node \\
597 0 arg, no fvs @\r,\s@ & yes & no & n/a & direct entry \\
598 0 arg, no fvs @\u@ & yes & yes & n/a & node \\
599 0 arg, fvs @\r,\s@ & yes & yes & n/a & node \\
600 0 arg, fvs @\u@ & yes & yes & n/a & node\\
603 When black-holing, single-entry closures could also be entered via node
604 (rather than directly) to catch double-entry.
608 = ViaNode -- The "normal" convention
610 | StdEntry CLabel -- Jump to this code, with args on stack
612 | DirectEntry -- Jump directly, with args in regs
613 CLabel -- The code label
615 [MagicId] -- Its register assignments
618 getEntryConvention :: Name -- Function being applied
619 -> LambdaFormInfo -- Its info
620 -> [PrimRep] -- Available arguments
621 -> FCode EntryConvention
623 getEntryConvention name lf_info arg_kinds
624 = nodeMustPointToIt lf_info `thenFC` \ node_points ->
627 -- if we're parallel, then we must always enter via node. The reason
628 -- is that the closure may have been fetched since we allocated it.
630 if (node_points && opt_Parallel) then ViaNode else
632 -- Commented out by SDM after futher thoughts:
633 -- - the only closure type that can be blackholed is a thunk
634 -- - we already enter thunks via node (unless the closure is
635 -- non-updatable, in which case why is it being re-entered...)
639 LFReEntrant _ _ arity _ _ _ ->
640 if arity == 0 || (length arg_kinds) < arity then
641 StdEntry (mkStdEntryLabel name)
643 DirectEntry (mkFastEntryLabel name arity) arity arg_regs
645 (arg_regs, _) = assignRegs live_regs (take arity arg_kinds)
646 live_regs = if node_points then [node] else []
648 LFCon con True{-zero_arity-}
649 -- a real constructor. Don't bother entering it, just jump
650 -- to the constructor entry code directly.
651 -> --false:ASSERT (null arg_kinds)
652 -- Should have no args (meaning what?)
653 StdEntry (mkStaticConEntryLabel (dataConName con))
655 LFCon con False{-non-zero_arity-}
656 -> --false:ASSERT (null arg_kinds)
657 -- Should have no args (meaning what?)
658 StdEntry (mkConEntryLabel (dataConName con))
660 LFTuple tup zero_arity
661 -> --false:ASSERT (null arg_kinds)
662 -- Should have no args (meaning what?)
663 StdEntry (mkConEntryLabel (dataConName tup))
665 LFThunk _ _ _ updatable std_form_info _ _
666 -> if updatable || opt_DoTickyProfiling -- to catch double entry
667 || opt_SMP -- always enter via node on SMP, since the
668 -- thunk might have been blackholed in the
671 else StdEntry (thunkEntryLabel name std_form_info updatable)
673 LFArgument -> ViaNode
674 LFImported -> ViaNode
675 LFBlackHole _ -> ViaNode -- Presumably the black hole has by now
676 -- been updated, but we don't know with
677 -- what, so we enter via Node
680 -> StdEntry (mkReturnPtLabel (nameUnique name))
683 -> if (arity /= length arg_kinds) then pprPanic "let-no-escape: " (ppr name <+> ppr arity) else
684 DirectEntry (mkReturnPtLabel (nameUnique name)) arity arg_regs
686 (arg_regs, _) = assignRegs [] arg_kinds
687 -- node never points to a LetNoEscape, see above --SDM
688 --live_regs = if node_points then [node] else []
691 blackHoleOnEntry :: ClosureInfo -> Bool
693 -- Static closures are never themselves black-holed.
694 -- Updatable ones will be overwritten with a CAFList cell, which points to a
696 -- Single-entry ones have no fvs to plug, and we trust they don't form part
699 blackHoleOnEntry (MkClosureInfo _ _ rep)
702 -- Never black-hole a static closure
704 blackHoleOnEntry (MkClosureInfo _ lf_info _)
706 LFReEntrant _ _ _ _ _ _ -> False
707 LFLetNoEscape _ -> False
708 LFThunk _ _ no_fvs updatable _ _ _
710 then not opt_OmitBlackHoling
711 else opt_DoTickyProfiling || not no_fvs
712 -- the former to catch double entry,
713 -- and the latter to plug space-leaks. KSW/SDM 1999-04.
715 other -> panic "blackHoleOnEntry" -- Should never happen
717 isStandardFormThunk :: LambdaFormInfo -> Bool
719 isStandardFormThunk (LFThunk _ _ _ _ (SelectorThunk _) _ _) = True
720 isStandardFormThunk (LFThunk _ _ _ _ (ApThunk _) _ _) = True
721 isStandardFormThunk other_lf_info = False
723 maybeSelectorInfo (MkClosureInfo _ (LFThunk _ _ _ _
724 (SelectorThunk offset) _ _) _) = Just offset
725 maybeSelectorInfo _ = Nothing
728 -----------------------------------------------------------------------------
733 infoTblNeedsSRT :: ClosureInfo -> Bool
734 infoTblNeedsSRT (MkClosureInfo _ info _) =
736 LFThunk _ _ _ _ _ _ NoSRT -> False
737 LFThunk _ _ _ _ _ _ _ -> True
739 LFReEntrant _ _ _ _ _ NoSRT -> False
740 LFReEntrant _ _ _ _ _ _ -> True
744 staticClosureNeedsLink :: ClosureInfo -> Bool
745 staticClosureNeedsLink (MkClosureInfo _ info _) =
747 LFThunk _ _ _ _ _ _ NoSRT -> False
748 LFReEntrant _ _ _ _ _ NoSRT -> False
749 LFCon _ True -> False -- zero arity constructors
752 getSRTInfo :: ClosureInfo -> (CLabel, SRT)
753 getSRTInfo (MkClosureInfo _ info _) =
755 LFThunk _ _ _ _ _ lbl srt -> (lbl,srt)
756 LFReEntrant _ _ _ _ lbl srt -> (lbl,srt)
757 _ -> panic "getSRTInfo"
760 Avoiding generating entries and info tables
761 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
762 At present, for every function we generate all of the following,
763 just in case. But they aren't always all needed, as noted below:
765 [NB1: all of this applies only to *functions*. Thunks always
766 have closure, info table, and entry code.]
768 [NB2: All are needed if the function is *exported*, just to play safe.]
771 * Fast-entry code ALWAYS NEEDED
774 Needed iff (a) we have any un-saturated calls to the function
775 OR (b) the function is passed as an arg
776 OR (c) we're in the parallel world and the function has free vars
777 [Reason: in parallel world, we always enter functions
778 with free vars via the closure.]
780 * The function closure
781 Needed iff (a) we have any un-saturated calls to the function
782 OR (b) the function is passed as an arg
783 OR (c) if the function has free vars (ie not top level)
785 Why case (a) here? Because if the arg-satis check fails,
786 UpdatePAP stuffs a pointer to the function closure in the PAP.
787 [Could be changed; UpdatePAP could stuff in a code ptr instead,
788 but doesn't seem worth it.]
790 [NB: these conditions imply that we might need the closure
791 without the slow-entry code. Here's how.
793 f x y = let g w = ...x..y..w...
797 Here we need a closure for g which contains x and y,
798 but since the calls are all saturated we just jump to the
799 fast entry point for g, with R1 pointing to the closure for g.]
802 * Standard info table
803 Needed iff (a) we have any un-saturated calls to the function
804 OR (b) the function is passed as an arg
805 OR (c) the function has free vars (ie not top level)
807 NB. In the sequential world, (c) is only required so that the function closure has
808 an info table to point to, to keep the storage manager happy.
809 If (c) alone is true we could fake up an info table by choosing
810 one of a standard family of info tables, whose entry code just
813 [NB In the parallel world (c) is needed regardless because
814 we enter functions with free vars via the closure.]
816 If (c) is retained, then we'll sometimes generate an info table
817 (for storage mgr purposes) without slow-entry code. Then we need
818 to use an error label in the info table to substitute for the absent
822 staticClosureRequired
827 staticClosureRequired binder bndr_info
828 (LFReEntrant _ top_level _ _ _ _) -- It's a function
829 = ASSERT( isTopLevel top_level )
830 -- Assumption: it's a top-level, no-free-var binding
831 not (satCallsOnly bndr_info)
833 staticClosureRequired binder other_binder_info other_lf_info = True
835 slowFunEntryCodeRequired -- Assumption: it's a function, not a thunk.
840 slowFunEntryCodeRequired binder bndr_info entry_conv
841 = not (satCallsOnly bndr_info)
842 || (case entry_conv of { DirectEntry _ _ _ -> False; other -> True })
843 {- The last case deals with the parallel world; a function usually
844 as a DirectEntry convention, but if it doesn't we must generate slow-entry code -}
851 funInfoTableRequired binder bndr_info (LFReEntrant _ top_level _ _ _ _)
852 = isNotTopLevel top_level
853 || not (satCallsOnly bndr_info)
855 funInfoTableRequired other_binder_info binder other_lf_info = True
858 %************************************************************************
860 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
862 %************************************************************************
866 isStaticClosure :: ClosureInfo -> Bool
867 isStaticClosure (MkClosureInfo _ _ rep) = isStaticRep rep
869 closureName :: ClosureInfo -> Name
870 closureName (MkClosureInfo name _ _) = name
872 closureSMRep :: ClosureInfo -> SMRep
873 closureSMRep (MkClosureInfo _ _ sm_rep) = sm_rep
875 closureLFInfo :: ClosureInfo -> LambdaFormInfo
876 closureLFInfo (MkClosureInfo _ lf_info _) = lf_info
878 closureUpdReqd :: ClosureInfo -> Bool
879 closureUpdReqd (MkClosureInfo _ (LFThunk _ _ _ upd _ _ _) _) = upd
880 closureUpdReqd (MkClosureInfo _ (LFBlackHole _) _) = True
881 -- Black-hole closures are allocated to receive the results of an
882 -- alg case with a named default... so they need to be updated.
883 closureUpdReqd other_closure = False
885 closureSingleEntry :: ClosureInfo -> Bool
886 closureSingleEntry (MkClosureInfo _ (LFThunk _ _ _ upd _ _ _) _) = not upd
887 closureSingleEntry other_closure = False
889 closureReEntrant :: ClosureInfo -> Bool
890 closureReEntrant (MkClosureInfo _ (LFReEntrant _ _ _ _ _ _) _) = True
891 closureReEntrant other_closure = False
895 closureSemiTag :: ClosureInfo -> Maybe Int
896 closureSemiTag (MkClosureInfo _ lf_info _)
898 LFCon data_con _ -> Just (dataConTag data_con - fIRST_TAG)
899 LFTuple _ _ -> Just 0
904 isToplevClosure :: ClosureInfo -> Bool
906 isToplevClosure (MkClosureInfo _ lf_info _)
908 LFReEntrant _ TopLevel _ _ _ _ -> True
909 LFThunk _ TopLevel _ _ _ _ _ -> True
914 isLetNoEscape :: ClosureInfo -> Bool
916 isLetNoEscape (MkClosureInfo _ (LFLetNoEscape _) _) = True
917 isLetNoEscape _ = False
923 fastLabelFromCI :: ClosureInfo -> CLabel
924 fastLabelFromCI (MkClosureInfo name (LFReEntrant _ _ arity _ _ _) _)
925 = mkFastEntryLabel name arity
927 fastLabelFromCI (MkClosureInfo name _ _)
928 = pprPanic "fastLabelFromCI" (ppr name)
930 infoTableLabelFromCI :: ClosureInfo -> CLabel
931 infoTableLabelFromCI (MkClosureInfo id lf_info rep)
933 LFCon con _ -> mkConInfoPtr con rep
934 LFTuple tup _ -> mkConInfoPtr tup rep
936 LFBlackHole info -> info
938 LFThunk _ _ _ upd_flag (SelectorThunk offset) _ _ ->
939 mkSelectorInfoLabel upd_flag offset
941 LFThunk _ _ _ upd_flag (ApThunk arity) _ _ ->
942 mkApInfoTableLabel upd_flag arity
944 other -> {-NO: if isStaticRep rep
945 then mkStaticInfoTableLabel id
946 else -} mkInfoTableLabel id
948 mkConInfoPtr :: DataCon -> SMRep -> CLabel
950 | isStaticRep rep = mkStaticInfoTableLabel name
951 | otherwise = mkConInfoTableLabel name
953 name = dataConName con
955 mkConEntryPtr :: DataCon -> SMRep -> CLabel
956 mkConEntryPtr con rep
957 | isStaticRep rep = mkStaticConEntryLabel (dataConName con)
958 | otherwise = mkConEntryLabel (dataConName con)
960 closureLabelFromCI (MkClosureInfo id _ other_rep) = mkClosureLabel id
962 entryLabelFromCI :: ClosureInfo -> CLabel
963 entryLabelFromCI (MkClosureInfo id lf_info rep)
965 LFThunk _ _ _ upd_flag std_form_info _ _ -> thunkEntryLabel id std_form_info upd_flag
966 LFCon con _ -> mkConEntryPtr con rep
967 LFTuple tup _ -> mkConEntryPtr tup rep
968 other -> mkStdEntryLabel id
970 -- thunkEntryLabel is a local help function, not exported. It's used from both
971 -- entryLabelFromCI and getEntryConvention.
973 thunkEntryLabel thunk_id (ApThunk arity) is_updatable
974 = mkApEntryLabel is_updatable arity
975 thunkEntryLabel thunk_id (SelectorThunk offset) upd_flag
976 = mkSelectorEntryLabel upd_flag offset
977 thunkEntryLabel thunk_id _ is_updatable
978 = mkStdEntryLabel thunk_id
982 allocProfilingMsg :: ClosureInfo -> FAST_STRING
984 allocProfilingMsg (MkClosureInfo _ lf_info _)
986 LFReEntrant _ _ _ _ _ _ -> SLIT("TICK_ALLOC_FUN")
987 LFCon _ _ -> SLIT("TICK_ALLOC_CON")
988 LFTuple _ _ -> SLIT("TICK_ALLOC_CON")
989 LFThunk _ _ _ True _ _ _ -> SLIT("TICK_ALLOC_UP_THK") -- updatable
990 LFThunk _ _ _ False _ _ _ -> SLIT("TICK_ALLOC_SE_THK") -- nonupdatable
991 LFBlackHole _ -> SLIT("TICK_ALLOC_BH")
992 LFImported -> panic "TICK_ALLOC_IMP"
995 We need a black-hole closure info to pass to @allocDynClosure@ when we
996 want to allocate the black hole on entry to a CAF. These are the only
997 ways to build an LFBlackHole, maintaining the invariant that it really
998 is a black hole and not something else.
1001 cafBlackHoleClosureInfo (MkClosureInfo name _ _)
1002 = MkClosureInfo name (LFBlackHole mkCAFBlackHoleInfoTableLabel) BlackHoleRep
1004 seCafBlackHoleClosureInfo (MkClosureInfo name _ _)
1005 = MkClosureInfo name (LFBlackHole mkSECAFBlackHoleInfoTableLabel) BlackHoleRep
1008 %************************************************************************
1010 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
1012 %************************************************************************
1014 Profiling requires two pieces of information to be determined for
1015 each closure's info table --- description and type.
1017 The description is stored directly in the @CClosureInfoTable@ when the
1018 info table is built.
1020 The type is determined from the type information stored with the @Id@
1021 in the closure info using @closureTypeDescr@.
1024 closureTypeDescr :: ClosureInfo -> String
1025 closureTypeDescr (MkClosureInfo name (LFThunk ty _ _ _ _ _ _) _)
1026 = getTyDescription ty
1027 closureTypeDescr (MkClosureInfo name (LFReEntrant ty _ _ _ _ _) _)
1028 = getTyDescription ty
1029 closureTypeDescr (MkClosureInfo name (LFCon data_con _) _)
1030 = occNameUserString (getOccName (dataConTyCon data_con))
1031 closureTypeDescr (MkClosureInfo name lf _)
1032 = showSDoc (ppr name)