2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: ClosureInfo.lhs,v 1.38 1999/05/18 15:03:50 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,
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 )
81 import Id ( Id, idType, getIdArity )
82 import DataCon ( DataCon, dataConTag, fIRST_TAG,
83 isNullaryDataCon, isTupleCon, dataConName
85 import IdInfo ( ArityInfo(..) )
86 import Name ( Name, isExternallyVisibleName, nameUnique )
87 import PprType ( getTyDescription )
88 import PrimRep ( getPrimRepSize, separateByPtrFollowness, PrimRep )
89 import SMRep -- all of it
90 import Type ( isUnLiftedType, Type )
91 import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel )
92 import Util ( mapAccumL )
96 The ``wrapper'' data type for closure information:
101 Name -- The thing bound to this closure
102 LambdaFormInfo -- info derivable from the *source*
103 SMRep -- representation used by storage manager
106 %************************************************************************
108 \subsection[ClosureInfo-datatypes]{Data types for closure information}
110 %************************************************************************
112 %************************************************************************
114 \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
116 %************************************************************************
120 = LFReEntrant -- Reentrant closure; used for PAPs too
121 Type -- Type of closure (ToDo: remove)
122 TopLevelFlag -- True if top level
124 !Bool -- True <=> no fvs
128 | LFCon -- Constructor
129 DataCon -- The constructor
130 Bool -- True <=> zero arity
133 DataCon -- The tuple constructor
134 Bool -- True <=> zero arity
136 | LFThunk -- Thunk (zero arity)
137 Type -- Type of the thunk (ToDo: remove)
139 !Bool -- True <=> no free vars
140 Bool -- True <=> updatable (i.e., *not* single-entry)
145 | LFArgument -- Used for function arguments. We know nothing about
146 -- this closure. Treat like updatable "LFThunk"...
148 | LFImported -- Used for imported things. We know nothing about this
149 -- closure. Treat like updatable "LFThunk"...
150 -- Imported things which we do know something about use
151 -- one of the other LF constructors (eg LFReEntrant for
154 | LFLetNoEscape -- See LetNoEscape module for precise description of
158 | LFBlackHole -- Used for the closures allocated to hold the result
159 -- of a CAF. We want the target of the update frame to
160 -- be in the heap, so we make a black hole to hold it.
161 CLabel -- Flavour (info label, eg CAF_BLACKHOLE_info).
164 data StandardFormInfo -- Tells whether this thunk has one of a small number
167 = NonStandardThunk -- No, it isn't
170 Int -- 0-origin offset of ak within the "goods" of
171 -- constructor (Recall that the a1,...,an may be laid
172 -- out in the heap in a non-obvious order.)
174 {- A SelectorThunk is of form
179 and the constructor is from a single-constr type.
185 {- An ApThunk is of form
189 The code for the thunk just pushes x2..xn on the stack and enters x1.
190 There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
191 in the RTS to save space.
196 %************************************************************************
198 \subsection[ClosureInfo-construction]{Functions which build LFInfos}
200 %************************************************************************
202 @mkClosureLFInfo@ figures out the appropriate LFInfo for the closure.
205 mkClosureLFInfo :: Id -- The binder
206 -> TopLevelFlag -- True of top level
208 -> UpdateFlag -- Update flag
210 -> CLabel -- SRT label
214 mkClosureLFInfo bndr top fvs upd_flag args@(_:_) srt_label srt -- Non-empty args
215 = LFReEntrant (idType bndr) top (length args) (null fvs) srt_label srt
217 mkClosureLFInfo bndr top fvs ReEntrant [] srt_label srt
218 = LFReEntrant (idType bndr) top 0 (null fvs) srt_label srt
220 mkClosureLFInfo bndr top fvs upd_flag [] srt_label srt
222 | isUnLiftedType ty = pprPanic "mkClosureLFInfo" (ppr bndr <+> ppr ty)
225 = LFThunk ty top (null fvs) (isUpdatable upd_flag) NonStandardThunk
231 @mkConLFInfo@ is similar, for constructors.
234 mkConLFInfo :: DataCon -> LambdaFormInfo
237 = -- the isNullaryDataCon will do this: ASSERT(isDataCon con)
238 (if isTupleCon con then LFTuple else LFCon) con (isNullaryDataCon con)
240 mkSelectorLFInfo rhs_ty offset updatable
241 = LFThunk rhs_ty NotTopLevel False updatable (SelectorThunk offset)
242 (error "mkSelectorLFInfo: no srt label")
243 (error "mkSelectorLFInfo: no srt")
245 mkApLFInfo rhs_ty upd_flag arity
246 = LFThunk rhs_ty NotTopLevel (arity == 0) (isUpdatable upd_flag)
248 (error "mkApLFInfo: no srt label")
249 (error "mkApLFInfo: no srt")
252 Miscellaneous LF-infos.
255 mkLFArgument = LFArgument
256 mkLFLetNoEscape = LFLetNoEscape
258 mkLFImported :: Id -> LambdaFormInfo
260 = case getIdArity id of
261 ArityExactly 0 -> LFThunk (idType id)
262 TopLevel True{-no fvs-}
263 True{-updatable-} NonStandardThunk
264 (error "mkLFImported: no srt label")
265 (error "mkLFImported: no srt")
266 ArityExactly n -> LFReEntrant (idType id) TopLevel n True -- n > 0
267 (error "mkLFImported: no srt label")
268 (error "mkLFImported: no srt")
269 other -> LFImported -- Not sure of exact arity
272 %************************************************************************
274 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
276 %************************************************************************
279 closureSize :: ClosureInfo -> HeapOffset
280 closureSize cl_info@(MkClosureInfo _ _ sm_rep)
281 = fixedHdrSize + closureNonHdrSize cl_info
283 closureNonHdrSize :: ClosureInfo -> Int
284 closureNonHdrSize cl_info@(MkClosureInfo _ lf_info sm_rep)
285 = tot_wds + computeSlopSize tot_wds sm_rep (closureUpdReqd cl_info)
286 --ToDo: pass lf_info?
288 tot_wds = closureGoodStuffSize cl_info
290 closureGoodStuffSize :: ClosureInfo -> Int
291 closureGoodStuffSize (MkClosureInfo _ _ sm_rep)
292 = let (ptrs, nonptrs) = sizes_from_SMRep sm_rep
295 closurePtrsSize :: ClosureInfo -> Int
296 closurePtrsSize (MkClosureInfo _ _ sm_rep)
297 = let (ptrs, _) = sizes_from_SMRep sm_rep
301 sizes_from_SMRep :: SMRep -> (Int,Int)
302 sizes_from_SMRep (GenericRep ptrs nonptrs _) = (ptrs, nonptrs)
303 sizes_from_SMRep (StaticRep ptrs nonptrs _) = (ptrs, nonptrs)
304 sizes_from_SMRep ConstantRep = (0, 0)
305 sizes_from_SMRep BlackHoleRep = (0, 0)
308 Computing slop size. WARNING: this looks dodgy --- it has deep
309 knowledge of what the storage manager does with the various
315 Updateable closures must be @mIN_UPD_SIZE@.
318 Indirections require 1 word
320 Appels collector indirections 2 words
322 THEREFORE: @mIN_UPD_SIZE = 2@.
325 Collectable closures which are allocated in the heap
326 must be @mIN_SIZE_NonUpdHeapObject@.
328 Copying collector forward pointer requires 1 word
330 THEREFORE: @mIN_SIZE_NonUpdHeapObject = 1@
333 Static closures have an extra ``static link field'' at the end, but we
334 don't bother taking that into account here.
337 slopSize cl_info@(MkClosureInfo _ lf_info sm_rep)
338 = computeSlopSize (closureGoodStuffSize cl_info) sm_rep
339 (closureUpdReqd cl_info)
341 computeSlopSize :: Int -> SMRep -> Bool -> Int
343 computeSlopSize tot_wds (StaticRep _ _ _) True -- Updatable
344 = max 0 (mIN_UPD_SIZE - tot_wds)
345 computeSlopSize tot_wds (StaticRep _ _ _) False
346 = 0 -- non updatable, non-heap object
347 computeSlopSize tot_wds (GenericRep _ _ _) True -- Updatable
348 = max 0 (mIN_UPD_SIZE - tot_wds)
349 computeSlopSize tot_wds (GenericRep _ _ _) False
350 = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds)
351 computeSlopSize tot_wds ConstantRep _
353 computeSlopSize tot_wds BlackHoleRep _ -- Updatable
354 = max 0 (mIN_UPD_SIZE - tot_wds)
357 %************************************************************************
359 \subsection[layOutDynClosure]{Lay out a dynamic closure}
361 %************************************************************************
364 layOutDynClosure, layOutStaticClosure
365 :: Name -- STG identifier of this closure
366 -> (a -> PrimRep) -- how to get a PrimRep for the fields
367 -> [a] -- the "things" being layed out
368 -> LambdaFormInfo -- what sort of closure it is
369 -> (ClosureInfo, -- info about the closure
370 [(a, VirtualHeapOffset)]) -- things w/ offsets pinned on them
372 layOutDynClosure name kind_fn things lf_info
373 = (MkClosureInfo name lf_info sm_rep,
376 (tot_wds, -- #ptr_wds + #nonptr_wds
378 things_w_offsets) = mkVirtHeapOffsets sm_rep kind_fn things
379 sm_rep = chooseDynSMRep lf_info tot_wds ptr_wds
382 A wrapper for when used with data constructors:
385 layOutDynCon :: DataCon
388 -> (ClosureInfo, [(a,VirtualHeapOffset)])
390 layOutDynCon con kind_fn args
391 = layOutDynClosure (dataConName con) kind_fn args (mkConLFInfo con)
394 %************************************************************************
396 \subsection[layOutStaticClosure]{Lay out a static closure}
398 %************************************************************************
400 layOutStaticClosure is only used for laying out static constructors at
403 Static closures for functions are laid out using
404 layOutStaticNoFVClosure.
407 layOutStaticClosure name kind_fn things lf_info
408 = (MkClosureInfo name lf_info
409 (StaticRep ptr_wds (tot_wds - ptr_wds) closure_type),
412 (tot_wds, -- #ptr_wds + #nonptr_wds
414 things_w_offsets) = mkVirtHeapOffsets (StaticRep bot bot bot) kind_fn things
416 -- constructors with no pointer fields will definitely be NOCAF things.
417 -- this is a compromise until we can generate both kinds of constructor
418 -- (a normal static kind and the NOCAF_STATIC kind).
419 closure_type = case lf_info of
420 LFCon _ _ | ptr_wds == 0 -> CONSTR_NOCAF
421 _ -> getStaticClosureType lf_info
423 bot = panic "layoutStaticClosure"
425 layOutStaticNoFVClosure :: Name -> LambdaFormInfo -> ClosureInfo
426 layOutStaticNoFVClosure name lf_info
427 = MkClosureInfo name lf_info (StaticRep 0 0 (getStaticClosureType 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
444 nonptr_wds = tot_wds - ptr_wds
445 closure_type = getClosureType tot_wds ptr_wds nonptr_wds lf_info
448 LFTuple _ True -> ConstantRep
449 LFCon _ True -> ConstantRep
450 _ -> GenericRep ptr_wds nonptr_wds closure_type
452 getStaticClosureType :: LambdaFormInfo -> ClosureType
453 getStaticClosureType lf_info =
455 LFCon con True -> CONSTR_NOCAF
456 LFCon con False -> CONSTR
457 LFReEntrant _ _ _ _ _ _ -> FUN
458 LFTuple _ _ -> CONSTR
459 LFThunk _ _ _ _ (SelectorThunk _) _ _ -> THUNK_SELECTOR
460 LFThunk _ _ _ True _ _ _ -> THUNK
461 LFThunk _ _ _ False _ _ _ -> FUN
462 _ -> panic "getClosureType"
464 -- we *do* get non-updatable top-level thunks sometimes. eg. f = g
465 -- gets compiled to a jump to g (if g has non-zero arity), instead of
466 -- messing around with update frames and PAPs. We set the closure type
467 -- to FUN_STATIC in this case.
469 getClosureType :: Int -> Int -> Int -> LambdaFormInfo -> ClosureType
470 getClosureType tot_wds ptrs nptrs lf_info =
472 LFCon con True -> CONSTR_NOCAF
475 | tot_wds > 0 && tot_wds <= mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n ptrs nptrs
476 | otherwise -> CONSTR
478 LFReEntrant _ _ _ _ _ _
479 | tot_wds > 0 && tot_wds <= mAX_SPEC_FUN_SIZE -> FUN_p_n ptrs nptrs
483 | tot_wds > 0 && tot_wds <= mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n ptrs nptrs
484 | otherwise -> CONSTR
486 LFThunk _ _ _ _ (SelectorThunk _) _ _ -> THUNK_SELECTOR
488 LFThunk _ _ _ _ _ _ _
489 | tot_wds > 0 && tot_wds <= mAX_SPEC_THUNK_SIZE -> THUNK_p_n ptrs nptrs
492 _ -> panic "getClosureType"
495 %************************************************************************
497 \subsection[mkVirtHeapOffsets]{Assigning heap offsets in a closure}
499 %************************************************************************
501 @mkVirtHeapOffsets@ (the heap version) always returns boxed things with
502 smaller offsets than the unboxed things, and furthermore, the offsets in
506 mkVirtHeapOffsets :: SMRep -- Representation to be used by storage manager
507 -> (a -> PrimRep) -- To be able to grab kinds;
508 -- w/ a kind, we can find boxedness
509 -> [a] -- Things to make offsets for
510 -> (Int, -- *Total* number of words allocated
511 Int, -- Number of words allocated for *pointers*
512 [(a, VirtualHeapOffset)])
513 -- Things with their offsets from start of
514 -- object in order of increasing offset
516 -- First in list gets lowest offset, which is initial offset + 1.
518 mkVirtHeapOffsets sm_rep kind_fun things
519 = let (ptrs, non_ptrs) = separateByPtrFollowness kind_fun things
520 (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
521 (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
523 (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
525 computeOffset wds_so_far thing
526 = (wds_so_far + (getPrimRepSize . kind_fun) thing,
527 (thing, fixedHdrSize + wds_so_far)
531 %************************************************************************
533 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
535 %************************************************************************
537 Be sure to see the stg-details notes about these...
540 nodeMustPointToIt :: LambdaFormInfo -> FCode Bool
541 nodeMustPointToIt lf_info
544 LFReEntrant ty top arity no_fvs _ _ -> returnFC (
545 not no_fvs || -- Certainly if it has fvs we need to point to it
547 -- If it is not top level we will point to it
548 -- We can have a \r closure with no_fvs which
549 -- is not top level as special case cgRhsClosure
550 -- has been dissabled in favour of let floating
552 -- For lex_profiling we also access the cost centre for a
553 -- non-inherited function i.e. not top level
554 -- the not top case above ensures this is ok.
557 LFCon _ zero_arity -> returnFC True
558 LFTuple _ zero_arity -> returnFC True
560 -- Strictly speaking, the above two don't need Node to point
561 -- to it if the arity = 0. But this is a *really* unlikely
562 -- situation. If we know it's nil (say) and we are entering
563 -- it. Eg: let x = [] in x then we will certainly have inlined
564 -- x, since nil is a simple atom. So we gain little by not
565 -- having Node point to known zero-arity things. On the other
566 -- hand, we do lose something; Patrick's code for figuring out
567 -- when something has been updated but not entered relies on
568 -- having Node point to the result of an update. SLPJ
571 LFThunk _ _ no_fvs updatable NonStandardThunk _ _
572 -> returnFC (updatable || not no_fvs || opt_SccProfilingOn)
574 -- For the non-updatable (single-entry case):
576 -- True if has fvs (in which case we need access to them, and we
577 -- should black-hole it)
578 -- or profiling (in which case we need to recover the cost centre
581 LFThunk _ _ no_fvs updatable some_standard_form_thunk _ _
583 -- Node must point to any standard-form thunk.
585 LFArgument -> returnFC True
586 LFImported -> returnFC True
587 LFBlackHole _ -> returnFC True
588 -- BH entry may require Node to point
590 LFLetNoEscape _ -> returnFC False
593 The entry conventions depend on the type of closure being entered,
594 whether or not it has free variables, and whether we're running
595 sequentially or in parallel.
597 \begin{tabular}{lllll}
598 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
599 Unknown & no & yes & stack & node \\
600 Known fun ($\ge$ 1 arg), no fvs & no & no & registers & fast entry (enough args) \\
601 \ & \ & \ & \ & slow entry (otherwise) \\
602 Known fun ($\ge$ 1 arg), fvs & no & yes & registers & fast entry (enough args) \\
603 0 arg, no fvs @\r,\s@ & no & no & n/a & direct entry \\
604 0 arg, no fvs @\u@ & no & yes & n/a & node \\
605 0 arg, fvs @\r,\s@ & no & yes & n/a & direct entry \\
606 0 arg, fvs @\u@ & no & yes & n/a & node \\
608 Unknown & yes & yes & stack & node \\
609 Known fun ($\ge$ 1 arg), no fvs & yes & no & registers & fast entry (enough args) \\
610 \ & \ & \ & \ & slow entry (otherwise) \\
611 Known fun ($\ge$ 1 arg), fvs & yes & yes & registers & node \\
612 0 arg, no fvs @\r,\s@ & yes & no & n/a & direct entry \\
613 0 arg, no fvs @\u@ & yes & yes & n/a & node \\
614 0 arg, fvs @\r,\s@ & yes & yes & n/a & node \\
615 0 arg, fvs @\u@ & yes & yes & n/a & node\\
618 When black-holing, single-entry closures could also be entered via node
619 (rather than directly) to catch double-entry.
623 = ViaNode -- The "normal" convention
625 | StdEntry CLabel -- Jump to this code, with args on stack
627 | DirectEntry -- Jump directly, with args in regs
628 CLabel -- The code label
630 [MagicId] -- Its register assignments
633 getEntryConvention :: Name -- Function being applied
634 -> LambdaFormInfo -- Its info
635 -> [PrimRep] -- Available arguments
636 -> FCode EntryConvention
638 getEntryConvention name lf_info arg_kinds
639 = nodeMustPointToIt lf_info `thenFC` \ node_points ->
642 -- if we're parallel, then we must always enter via node. The reason
643 -- is that the closure may have been fetched since we allocated it.
645 if (node_points && opt_Parallel) then ViaNode else
647 -- Commented out by SDM after futher thoughts:
648 -- - the only closure type that can be blackholed is a thunk
649 -- - we already enter thunks via node (unless the closure is
650 -- non-updatable, in which case why is it being re-entered...)
654 LFReEntrant _ _ arity _ _ _ ->
655 if arity == 0 || (length arg_kinds) < arity then
656 StdEntry (mkStdEntryLabel name)
658 DirectEntry (mkFastEntryLabel name arity) arity arg_regs
660 (arg_regs, _) = assignRegs live_regs (take arity arg_kinds)
661 live_regs = if node_points then [node] else []
663 LFCon con True{-zero_arity-}
664 -- a real constructor. Don't bother entering it, just jump
665 -- to the constructor entry code directly.
666 -> --false:ASSERT (null arg_kinds)
667 -- Should have no args (meaning what?)
668 StdEntry (mkStaticConEntryLabel (dataConName con))
670 LFCon con False{-non-zero_arity-}
671 -> --false:ASSERT (null arg_kinds)
672 -- Should have no args (meaning what?)
673 StdEntry (mkConEntryLabel (dataConName con))
675 LFTuple tup zero_arity
676 -> --false:ASSERT (null arg_kinds)
677 -- Should have no args (meaning what?)
678 StdEntry (mkConEntryLabel (dataConName tup))
680 LFThunk _ _ _ updatable std_form_info _ _
681 -> if updatable || opt_DoTickyProfiling -- to catch double entry
683 else StdEntry (thunkEntryLabel name std_form_info updatable)
685 LFArgument -> ViaNode
686 LFImported -> ViaNode
687 LFBlackHole _ -> ViaNode -- Presumably the black hole has by now
688 -- been updated, but we don't know with
689 -- what, so we enter via Node
692 -> StdEntry (mkReturnPtLabel (nameUnique name))
695 -> ASSERT(arity == length arg_kinds)
696 DirectEntry (mkReturnPtLabel (nameUnique name)) arity arg_regs
698 (arg_regs, _) = assignRegs [] arg_kinds
699 -- node never points to a LetNoEscape, see above --SDM
700 --live_regs = if node_points then [node] else []
703 blackHoleOnEntry :: ClosureInfo -> Bool
705 -- Static closures are never themselves black-holed.
706 -- Updatable ones will be overwritten with a CAFList cell, which points to a
708 -- Single-entry ones have no fvs to plug, and we trust they don't form part
711 blackHoleOnEntry (MkClosureInfo _ _ (StaticRep _ _ _)) = False
713 blackHoleOnEntry (MkClosureInfo _ lf_info _)
715 LFReEntrant _ _ _ _ _ _ -> False
716 LFLetNoEscape _ -> False
717 LFThunk _ _ no_fvs updatable _ _ _
719 then not opt_OmitBlackHoling
720 else opt_DoTickyProfiling || not no_fvs
721 -- the former to catch double entry,
722 -- and the latter to plug space-leaks. KSW/SDM 1999-04.
724 other -> panic "blackHoleOnEntry" -- Should never happen
726 isStandardFormThunk :: LambdaFormInfo -> Bool
728 isStandardFormThunk (LFThunk _ _ _ _ (SelectorThunk _) _ _) = True
729 isStandardFormThunk (LFThunk _ _ _ _ (ApThunk _) _ _) = True
730 isStandardFormThunk other_lf_info = False
732 maybeSelectorInfo (MkClosureInfo _ (LFThunk _ _ _ _
733 (SelectorThunk offset) _ _) _) = Just offset
734 maybeSelectorInfo _ = Nothing
737 -----------------------------------------------------------------------------
742 infoTblNeedsSRT :: ClosureInfo -> Bool
743 infoTblNeedsSRT (MkClosureInfo _ info _) =
745 LFThunk _ _ _ _ _ _ NoSRT -> False
746 LFThunk _ _ _ _ _ _ _ -> True
748 LFReEntrant _ _ _ _ _ NoSRT -> False
749 LFReEntrant _ _ _ _ _ _ -> True
753 staticClosureNeedsLink :: ClosureInfo -> Bool
754 staticClosureNeedsLink (MkClosureInfo _ info _) =
756 LFThunk _ _ _ _ _ _ NoSRT -> False
757 LFReEntrant _ _ _ _ _ NoSRT -> False
758 LFCon _ True -> False -- zero arity constructors
761 getSRTInfo :: ClosureInfo -> (CLabel, SRT)
762 getSRTInfo (MkClosureInfo _ info _) =
764 LFThunk _ _ _ _ _ lbl srt -> (lbl,srt)
765 LFReEntrant _ _ _ _ lbl srt -> (lbl,srt)
766 _ -> panic "getSRTInfo"
769 Avoiding generating entries and info tables
770 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
771 At present, for every function we generate all of the following,
772 just in case. But they aren't always all needed, as noted below:
774 [NB1: all of this applies only to *functions*. Thunks always
775 have closure, info table, and entry code.]
777 [NB2: All are needed if the function is *exported*, just to play safe.]
780 * Fast-entry code ALWAYS NEEDED
783 Needed iff (a) we have any un-saturated calls to the function
784 OR (b) the function is passed as an arg
785 OR (c) we're in the parallel world and the function has free vars
786 [Reason: in parallel world, we always enter functions
787 with free vars via the closure.]
789 * The function closure
790 Needed iff (a) we have any un-saturated calls to the function
791 OR (b) the function is passed as an arg
792 OR (c) if the function has free vars (ie not top level)
794 Why case (a) here? Because if the arg-satis check fails,
795 UpdatePAP stuffs a pointer to the function closure in the PAP.
796 [Could be changed; UpdatePAP could stuff in a code ptr instead,
797 but doesn't seem worth it.]
799 [NB: these conditions imply that we might need the closure
800 without the slow-entry code. Here's how.
802 f x y = let g w = ...x..y..w...
806 Here we need a closure for g which contains x and y,
807 but since the calls are all saturated we just jump to the
808 fast entry point for g, with R1 pointing to the closure for g.]
811 * Standard info table
812 Needed iff (a) we have any un-saturated calls to the function
813 OR (b) the function is passed as an arg
814 OR (c) the function has free vars (ie not top level)
816 NB. In the sequential world, (c) is only required so that the function closure has
817 an info table to point to, to keep the storage manager happy.
818 If (c) alone is true we could fake up an info table by choosing
819 one of a standard family of info tables, whose entry code just
822 [NB In the parallel world (c) is needed regardless because
823 we enter functions with free vars via the closure.]
825 If (c) is retained, then we'll sometimes generate an info table
826 (for storage mgr purposes) without slow-entry code. Then we need
827 to use an error label in the info table to substitute for the absent
831 staticClosureRequired
836 staticClosureRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _)
837 (LFReEntrant _ top_level _ _ _ _) -- It's a function
838 = ASSERT( isTopLevel top_level )
839 -- Assumption: it's a top-level, no-free-var binding
840 arg_occ -- There's an argument occurrence
841 || unsat_occ -- There's an unsaturated call
842 || isExternallyVisibleName binder
844 staticClosureRequired binder other_binder_info other_lf_info = True
846 slowFunEntryCodeRequired -- Assumption: it's a function, not a thunk.
851 slowFunEntryCodeRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _) entry_conv
852 = arg_occ -- There's an argument occurrence
853 || unsat_occ -- There's an unsaturated call
854 || isExternallyVisibleName binder
855 || (case entry_conv of { DirectEntry _ _ _ -> False; other -> True })
856 {- The last case deals with the parallel world; a function usually
857 as a DirectEntry convention, but if it doesn't we must generate slow-entry code -}
859 slowFunEntryCodeRequired binder NoStgBinderInfo _ = True
866 funInfoTableRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _)
867 (LFReEntrant _ top_level _ _ _ _)
868 = isNotTopLevel top_level
869 || arg_occ -- There's an argument occurrence
870 || unsat_occ -- There's an unsaturated call
871 || isExternallyVisibleName binder
873 funInfoTableRequired other_binder_info binder other_lf_info = True
876 %************************************************************************
878 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
880 %************************************************************************
884 isStaticClosure :: ClosureInfo -> Bool
885 isStaticClosure (MkClosureInfo _ _ rep) = isStaticRep rep
887 closureName :: ClosureInfo -> Name
888 closureName (MkClosureInfo name _ _) = name
890 closureSMRep :: ClosureInfo -> SMRep
891 closureSMRep (MkClosureInfo _ _ sm_rep) = sm_rep
893 closureLFInfo :: ClosureInfo -> LambdaFormInfo
894 closureLFInfo (MkClosureInfo _ lf_info _) = lf_info
896 closureUpdReqd :: ClosureInfo -> Bool
897 closureUpdReqd (MkClosureInfo _ (LFThunk _ _ _ upd _ _ _) _) = upd
898 closureUpdReqd (MkClosureInfo _ (LFBlackHole _) _) = True
899 -- Black-hole closures are allocated to receive the results of an
900 -- alg case with a named default... so they need to be updated.
901 closureUpdReqd other_closure = False
903 closureSingleEntry :: ClosureInfo -> Bool
904 closureSingleEntry (MkClosureInfo _ (LFThunk _ _ _ upd _ _ _) _) = not upd
905 closureSingleEntry other_closure = False
907 closureReEntrant :: ClosureInfo -> Bool
908 closureReEntrant (MkClosureInfo _ (LFReEntrant _ _ _ _ _ _) _) = True
909 closureReEntrant other_closure = False
913 closureSemiTag :: ClosureInfo -> Maybe Int
914 closureSemiTag (MkClosureInfo _ lf_info _)
916 LFCon data_con _ -> Just (dataConTag data_con - fIRST_TAG)
917 LFTuple _ _ -> Just 0
922 isToplevClosure :: ClosureInfo -> Bool
924 isToplevClosure (MkClosureInfo _ lf_info _)
926 LFReEntrant _ TopLevel _ _ _ _ -> True
927 LFThunk _ TopLevel _ _ _ _ _ -> True
932 isLetNoEscape :: ClosureInfo -> Bool
934 isLetNoEscape (MkClosureInfo _ (LFLetNoEscape _) _) = True
935 isLetNoEscape _ = False
941 fastLabelFromCI :: ClosureInfo -> CLabel
942 fastLabelFromCI (MkClosureInfo name (LFReEntrant _ _ arity _ _ _) _)
943 = mkFastEntryLabel name arity
945 fastLabelFromCI (MkClosureInfo name _ _)
946 = pprPanic "fastLabelFromCI" (ppr name)
948 infoTableLabelFromCI :: ClosureInfo -> CLabel
949 infoTableLabelFromCI (MkClosureInfo id lf_info rep)
951 LFCon con _ -> mkConInfoPtr con rep
952 LFTuple tup _ -> mkConInfoPtr tup rep
954 LFBlackHole info -> info
956 LFThunk _ _ _ upd_flag (SelectorThunk offset) _ _ ->
957 mkSelectorInfoLabel upd_flag offset
959 LFThunk _ _ _ upd_flag (ApThunk arity) _ _ ->
960 mkApInfoTableLabel upd_flag arity
962 other -> {-NO: if isStaticRep rep
963 then mkStaticInfoTableLabel id
964 else -} mkInfoTableLabel id
966 mkConInfoPtr :: DataCon -> SMRep -> CLabel
969 StaticRep _ _ _ -> mkStaticInfoTableLabel name
970 _ -> mkConInfoTableLabel name
972 name = dataConName con
974 mkConEntryPtr :: DataCon -> SMRep -> CLabel
975 mkConEntryPtr con rep
977 StaticRep _ _ _ -> mkStaticConEntryLabel (dataConName con)
978 _ -> mkConEntryLabel (dataConName con)
980 name = dataConName con
982 closureLabelFromCI (MkClosureInfo name _ rep)
984 = mkStaticClosureLabel name
985 -- This case catches those pesky static closures for nullary constructors
987 closureLabelFromCI (MkClosureInfo id _ other_rep) = mkClosureLabel id
989 entryLabelFromCI :: ClosureInfo -> CLabel
990 entryLabelFromCI (MkClosureInfo id lf_info rep)
992 LFThunk _ _ _ upd_flag std_form_info _ _ -> thunkEntryLabel id std_form_info upd_flag
993 LFCon con _ -> mkConEntryPtr con rep
994 LFTuple tup _ -> mkConEntryPtr tup rep
995 other -> mkStdEntryLabel id
997 -- thunkEntryLabel is a local help function, not exported. It's used from both
998 -- entryLabelFromCI and getEntryConvention.
1000 thunkEntryLabel thunk_id (ApThunk arity) is_updatable
1001 = mkApEntryLabel is_updatable arity
1002 thunkEntryLabel thunk_id (SelectorThunk offset) upd_flag
1003 = mkSelectorEntryLabel upd_flag offset
1004 thunkEntryLabel thunk_id _ is_updatable
1005 = mkStdEntryLabel thunk_id
1009 allocProfilingMsg :: ClosureInfo -> FAST_STRING
1011 allocProfilingMsg (MkClosureInfo _ lf_info _)
1013 LFReEntrant _ _ _ _ _ _ -> SLIT("TICK_ALLOC_FUN")
1014 LFCon _ _ -> SLIT("TICK_ALLOC_CON")
1015 LFTuple _ _ -> SLIT("TICK_ALLOC_CON")
1016 LFThunk _ _ _ True _ _ _ -> SLIT("TICK_ALLOC_UP_THK") -- updatable
1017 LFThunk _ _ _ False _ _ _ -> SLIT("TICK_ALLOC_SE_THK") -- nonupdatable
1018 LFBlackHole _ -> SLIT("TICK_ALLOC_BH")
1019 LFImported -> panic "TICK_ALLOC_IMP"
1022 We need a black-hole closure info to pass to @allocDynClosure@ when we
1023 want to allocate the black hole on entry to a CAF. These are the only
1024 ways to build an LFBlackHole, maintaining the invariant that it really
1025 is a black hole and not something else.
1028 cafBlackHoleClosureInfo (MkClosureInfo name _ _)
1029 = MkClosureInfo name (LFBlackHole mkCAFBlackHoleInfoTableLabel) BlackHoleRep
1031 seCafBlackHoleClosureInfo (MkClosureInfo name _ _)
1032 = MkClosureInfo name (LFBlackHole mkSECAFBlackHoleInfoTableLabel) BlackHoleRep
1035 %************************************************************************
1037 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
1039 %************************************************************************
1041 Profiling requires two pieces of information to be determined for
1042 each closure's info table --- description and type.
1044 The description is stored directly in the @CClosureInfoTable@ when the
1045 info table is built.
1047 The type is determined from the type information stored with the @Id@
1048 in the closure info using @closureTypeDescr@.
1051 closureTypeDescr :: ClosureInfo -> String
1052 closureTypeDescr (MkClosureInfo name (LFThunk ty _ _ _ _ _ _) _)
1053 = getTyDescription ty
1054 closureTypeDescr (MkClosureInfo name (LFReEntrant ty _ _ _ _ _) _)
1055 = getTyDescription ty
1056 closureTypeDescr (MkClosureInfo name lf _)
1057 = showSDoc (ppr name)