2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: ClosureInfo.lhs,v 1.53 2002/09/13 15:02:29 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, layOutDynConstr, layOutStaticClosure,
27 layOutStaticNoFVClosure, layOutStaticConstr,
28 mkVirtHeapOffsets, mkStaticClosure,
30 nodeMustPointToIt, getEntryConvention,
31 FCode, CgInfoDownwards, CgState,
35 staticClosureRequired,
36 slowFunEntryCodeRequired, funInfoTableRequired,
38 closureName, infoTableLabelFromCI, fastLabelFromCI,
39 closureLabelFromCI, closureSRT,
41 closureLFInfo, closureSMRep, closureUpdReqd,
42 closureSingleEntry, closureReEntrant, closureSemiTag,
47 closureTypeDescr, -- profiling
51 cafBlackHoleClosureInfo, seCafBlackHoleClosureInfo,
54 staticClosureNeedsLink,
57 #include "HsVersions.h"
63 import Constants ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject,
64 mAX_SPEC_FUN_SIZE, mAX_SPEC_THUNK_SIZE, mAX_SPEC_CONSTR_SIZE )
65 import CgRetConv ( assignRegs )
66 import CLabel ( CLabel, mkStdEntryLabel, mkFastEntryLabel,
69 mkCAFBlackHoleInfoTableLabel,
70 mkSECAFBlackHoleInfoTableLabel,
71 mkStaticInfoTableLabel, mkStaticConEntryLabel,
72 mkConEntryLabel, mkClosureLabel,
73 mkSelectorInfoLabel, mkSelectorEntryLabel,
74 mkApInfoTableLabel, mkApEntryLabel,
77 import CmdLineOpts ( opt_SccProfilingOn, opt_OmitBlackHoling,
78 opt_Parallel, opt_DoTickyProfiling,
80 import Id ( Id, idType, idArity )
81 import DataCon ( DataCon, dataConTag, fIRST_TAG, dataConTyCon,
82 isNullaryDataCon, dataConName
84 import TyCon ( isBoxedTupleTyCon )
85 import Name ( Name, nameUnique, getOccName )
86 import OccName ( occNameUserString )
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, listLengthCmp, lengthIs )
97 %************************************************************************
99 \subsection[ClosureInfo-datatypes]{Data types for closure information}
101 %************************************************************************
103 The ``wrapper'' data type for closure information:
108 closureName :: Name, -- The thing bound to this closure
109 closureLFInfo :: LambdaFormInfo, -- Info derivable from the *source*
110 closureSMRep :: SMRep, -- representation used by storage manager
111 closureSRT :: C_SRT -- What SRT applies to this closure
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
129 | LFCon -- Constructor
130 DataCon -- The constructor
131 Bool -- True <=> zero arity
134 DataCon -- The tuple constructor
135 Bool -- True <=> zero arity
137 | LFThunk -- Thunk (zero arity)
138 Type -- Type of the thunk (ToDo: remove)
140 !Bool -- True <=> no free vars
141 Bool -- True <=> updatable (i.e., *not* single-entry)
144 | LFArgument -- Used for function arguments. We know nothing about
145 -- this closure. Treat like updatable "LFThunk"...
147 | LFImported -- Used for imported things. We know nothing about this
148 -- closure. Treat like updatable "LFThunk"...
149 -- Imported things which we do know something about use
150 -- one of the other LF constructors (eg LFReEntrant for
153 | LFLetNoEscape -- See LetNoEscape module for precise description of
157 | LFBlackHole -- Used for the closures allocated to hold the result
158 -- of a CAF. We want the target of the update frame to
159 -- be in the heap, so we make a black hole to hold it.
160 CLabel -- Flavour (info label, eg CAF_BLACKHOLE_info).
163 data StandardFormInfo -- Tells whether this thunk has one of a small number
166 = NonStandardThunk -- No, it isn't
169 Int -- 0-origin offset of ak within the "goods" of
170 -- constructor (Recall that the a1,...,an may be laid
171 -- out in the heap in a non-obvious order.)
173 {- A SelectorThunk is of form
178 and the constructor is from a single-constr type.
184 {- An ApThunk is of form
188 The code for the thunk just pushes x2..xn on the stack and enters x1.
189 There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
190 in the RTS to save space.
195 %************************************************************************
197 \subsection[ClosureInfo-construction]{Functions which build LFInfos}
199 %************************************************************************
201 @mkClosureLFInfo@ figures out the appropriate LFInfo for the closure.
204 mkClosureLFInfo :: Id -- The binder
205 -> TopLevelFlag -- True of top level
207 -> UpdateFlag -- Update flag
211 mkClosureLFInfo bndr top fvs upd_flag args@(_:_) -- Non-empty args
212 = LFReEntrant (idType bndr) top (length args) (null fvs)
214 mkClosureLFInfo bndr top fvs ReEntrant []
215 = LFReEntrant (idType bndr) top 0 (null fvs)
217 mkClosureLFInfo bndr top fvs upd_flag []
219 | isUnLiftedType ty = pprPanic "mkClosureLFInfo" (ppr bndr <+> ppr ty)
222 = LFThunk ty top (null fvs) (isUpdatable upd_flag) NonStandardThunk
227 @mkConLFInfo@ is similar, for constructors.
230 mkConLFInfo :: DataCon -> LambdaFormInfo
233 = -- the isNullaryDataCon will do this: ASSERT(isDataCon con)
234 (if isBoxedTupleTyCon (dataConTyCon con) then LFTuple else LFCon)
235 con (isNullaryDataCon con)
237 mkSelectorLFInfo rhs_ty offset updatable
238 = LFThunk rhs_ty NotTopLevel False updatable (SelectorThunk offset)
240 mkApLFInfo rhs_ty upd_flag arity
241 = LFThunk rhs_ty NotTopLevel (arity == 0)
242 (isUpdatable upd_flag) (ApThunk arity)
245 Miscellaneous LF-infos.
248 mkLFArgument = LFArgument
249 mkLFLetNoEscape = LFLetNoEscape
251 mkLFImported :: Id -> LambdaFormInfo
254 n | n > 0 -> LFReEntrant (idType id) TopLevel n True -- n > 0
255 other -> LFImported -- Not sure of exact arity
258 %************************************************************************
260 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
262 %************************************************************************
265 closureSize :: ClosureInfo -> HeapOffset
266 closureSize cl_info = fixedHdrSize + closureNonHdrSize cl_info
268 closureNonHdrSize :: ClosureInfo -> Int
269 closureNonHdrSize cl_info
270 = tot_wds + computeSlopSize tot_wds
271 (closureSMRep cl_info)
272 (closureUpdReqd cl_info)
274 tot_wds = closureGoodStuffSize cl_info
276 slopSize :: ClosureInfo -> Int
278 = computeSlopSize (closureGoodStuffSize cl_info)
279 (closureSMRep cl_info)
280 (closureUpdReqd cl_info)
282 closureGoodStuffSize :: ClosureInfo -> Int
283 closureGoodStuffSize cl_info
284 = let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info)
287 closurePtrsSize :: ClosureInfo -> Int
288 closurePtrsSize cl_info
289 = let (ptrs, _) = sizes_from_SMRep (closureSMRep cl_info)
293 sizes_from_SMRep :: SMRep -> (Int,Int)
294 sizes_from_SMRep (GenericRep _ ptrs nonptrs _) = (ptrs, nonptrs)
295 sizes_from_SMRep BlackHoleRep = (0, 0)
298 Computing slop size. WARNING: this looks dodgy --- it has deep
299 knowledge of what the storage manager does with the various
305 Updateable closures must be @mIN_UPD_SIZE@.
308 Indirections require 1 word
310 Appels collector indirections 2 words
312 THEREFORE: @mIN_UPD_SIZE = 2@.
315 Collectable closures which are allocated in the heap
316 must be @mIN_SIZE_NonUpdHeapObject@.
318 Copying collector forward pointer requires 1 word
320 THEREFORE: @mIN_SIZE_NonUpdHeapObject = 1@
323 Static closures have an extra ``static link field'' at the end, but we
324 don't bother taking that into account here.
327 computeSlopSize :: Int -> SMRep -> Bool -> Int
329 computeSlopSize tot_wds (GenericRep _ _ _ _) True -- Updatable
330 = max 0 (mIN_UPD_SIZE - tot_wds)
332 computeSlopSize tot_wds (GenericRep True _ _ _) False -- Non updatable
335 computeSlopSize tot_wds (GenericRep False _ _ _) False -- Non updatable
336 = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds) -- Dynamic
338 computeSlopSize tot_wds BlackHoleRep _ -- Updatable
339 = max 0 (mIN_UPD_SIZE - tot_wds)
342 %************************************************************************
344 \subsection[layOutDynClosure]{Lay out a dynamic closure}
346 %************************************************************************
349 layOutDynClosure, layOutStaticClosure
350 :: Name -- STG identifier of this closure
351 -> (a -> PrimRep) -- how to get a PrimRep for the fields
352 -> [a] -- the "things" being layed out
353 -> LambdaFormInfo -- what sort of closure it is
355 -> (ClosureInfo, -- info about the closure
356 [(a, VirtualHeapOffset)]) -- things w/ offsets pinned on them
358 layOutDynClosure name kind_fn things lf_info srt_info
359 = (MkClosureInfo { closureName = name, closureLFInfo = lf_info,
360 closureSMRep = sm_rep, closureSRT = srt_info },
363 (tot_wds, -- #ptr_wds + #nonptr_wds
365 things_w_offsets) = mkVirtHeapOffsets kind_fn things
366 sm_rep = chooseDynSMRep lf_info tot_wds ptr_wds
369 Wrappers for when used with data constructors:
372 layOutDynConstr, layOutStaticConstr
373 :: Name -- Of the closure
375 -> (a -> PrimRep) -> [a]
376 -> (ClosureInfo, [(a,VirtualHeapOffset)])
378 layOutDynConstr name data_con kind_fn args
379 = layOutDynClosure name kind_fn args (mkConLFInfo data_con) NoC_SRT
381 layOutStaticConstr name data_con kind_fn things
382 = layOutStaticClosure name kind_fn things (mkConLFInfo data_con) NoC_SRT
385 %************************************************************************
387 \subsection[layOutStaticClosure]{Lay out a static closure}
389 %************************************************************************
391 layOutStaticClosure is only used for laying out static constructors at
394 Static closures for functions are laid out using
395 layOutStaticNoFVClosure.
398 layOutStaticClosure name kind_fn things lf_info srt_info
399 = (MkClosureInfo { closureName = name, closureLFInfo = lf_info,
400 closureSMRep = rep, closureSRT = srt_info },
403 rep = GenericRep is_static ptr_wds (tot_wds - ptr_wds) closure_type
405 (tot_wds, -- #ptr_wds + #nonptr_wds
407 things_w_offsets) = mkVirtHeapOffsets kind_fn things
409 -- constructors with no pointer fields will definitely be NOCAF things.
410 -- this is a compromise until we can generate both kinds of constructor
411 -- (a normal static kind and the NOCAF_STATIC kind).
412 closure_type = getClosureType is_static tot_wds ptr_wds lf_info
415 layOutStaticNoFVClosure :: Name -> LambdaFormInfo -> C_SRT -> ClosureInfo
416 layOutStaticNoFVClosure name lf_info srt_info
417 = MkClosureInfo { closureName = name, closureLFInfo = lf_info,
418 closureSMRep = rep, closureSRT = srt_info }
420 rep = GenericRep is_static 0 0 (getClosureType is_static 0 0 lf_info)
424 -- make a static closure, adding on any extra padding needed for CAFs,
425 -- and adding a static link field if necessary.
427 mkStaticClosure closure_info ccs fields cafrefs
428 | opt_SccProfilingOn =
431 (mkCCostCentreStack ccs)
440 all_fields = fields ++ padding_wds ++ static_link_field
442 upd_reqd = closureUpdReqd closure_info
446 | otherwise = replicate n (mkIntCLit 0) -- a bunch of 0s
447 where n = max 0 (mIN_UPD_SIZE - length fields)
449 -- We always have a static link field for a thunk, it's used to
450 -- save the closure's info pointer when we're reverting CAFs
451 -- (see comment in Storage.c)
453 | upd_reqd || staticClosureNeedsLink closure_info = [static_link_value]
456 -- for a static constructor which has NoCafRefs, we set the
457 -- static link field to a non-zero value so the garbage
458 -- collector will ignore it.
460 | cafrefs = mkIntCLit 0
461 | otherwise = mkIntCLit 1
464 %************************************************************************
466 \subsection[SMreps]{Choosing SM reps}
468 %************************************************************************
473 -> Int -> Int -- Tot wds, ptr wds
476 chooseDynSMRep lf_info tot_wds ptr_wds
479 nonptr_wds = tot_wds - ptr_wds
480 closure_type = getClosureType is_static tot_wds ptr_wds lf_info
482 GenericRep is_static ptr_wds nonptr_wds closure_type
484 -- we *do* get non-updatable top-level thunks sometimes. eg. f = g
485 -- gets compiled to a jump to g (if g has non-zero arity), instead of
486 -- messing around with update frames and PAPs. We set the closure type
487 -- to FUN_STATIC in this case.
489 getClosureType :: Bool -> Int -> Int -> LambdaFormInfo -> ClosureType
490 getClosureType is_static tot_wds ptr_wds lf_info
493 | is_static && ptr_wds == 0 -> CONSTR_NOCAF
494 | specialised_rep mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n
495 | otherwise -> CONSTR
498 | is_static && ptr_wds == 0 -> CONSTR_NOCAF
499 | specialised_rep mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n
500 | otherwise -> CONSTR
503 | specialised_rep mAX_SPEC_FUN_SIZE -> FUN_p_n
506 LFThunk _ _ _ _ (SelectorThunk _) -> THUNK_SELECTOR
509 | specialised_rep mAX_SPEC_THUNK_SIZE -> THUNK_p_n
512 _ -> panic "getClosureType"
514 specialised_rep max_size = not is_static
516 && tot_wds <= max_size
519 %************************************************************************
521 \subsection[mkVirtHeapOffsets]{Assigning heap offsets in a closure}
523 %************************************************************************
525 @mkVirtHeapOffsets@ (the heap version) always returns boxed things with
526 smaller offsets than the unboxed things, and furthermore, the offsets in
531 (a -> PrimRep) -- To be able to grab kinds;
532 -- w/ a kind, we can find boxedness
533 -> [a] -- Things to make offsets for
534 -> (Int, -- *Total* number of words allocated
535 Int, -- Number of words allocated for *pointers*
536 [(a, VirtualHeapOffset)])
537 -- Things with their offsets from start of
538 -- object in order of increasing offset
540 -- First in list gets lowest offset, which is initial offset + 1.
542 mkVirtHeapOffsets kind_fun things
543 = let (ptrs, non_ptrs) = separateByPtrFollowness kind_fun things
544 (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
545 (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
547 (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
549 computeOffset wds_so_far thing
550 = (wds_so_far + (getPrimRepSize . kind_fun) thing,
551 (thing, fixedHdrSize + wds_so_far)
555 %************************************************************************
557 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
559 %************************************************************************
561 Be sure to see the stg-details notes about these...
564 nodeMustPointToIt :: LambdaFormInfo -> FCode Bool
565 nodeMustPointToIt lf_info
568 LFReEntrant ty top arity no_fvs -> returnFC (
569 not no_fvs || -- Certainly if it has fvs we need to point to it
571 -- If it is not top level we will point to it
572 -- We can have a \r closure with no_fvs which
573 -- is not top level as special case cgRhsClosure
574 -- has been dissabled in favour of let floating
576 -- For lex_profiling we also access the cost centre for a
577 -- non-inherited function i.e. not top level
578 -- the not top case above ensures this is ok.
581 LFCon _ zero_arity -> returnFC True
582 LFTuple _ zero_arity -> returnFC True
584 -- Strictly speaking, the above two don't need Node to point
585 -- to it if the arity = 0. But this is a *really* unlikely
586 -- situation. If we know it's nil (say) and we are entering
587 -- it. Eg: let x = [] in x then we will certainly have inlined
588 -- x, since nil is a simple atom. So we gain little by not
589 -- having Node point to known zero-arity things. On the other
590 -- hand, we do lose something; Patrick's code for figuring out
591 -- when something has been updated but not entered relies on
592 -- having Node point to the result of an update. SLPJ
595 LFThunk _ _ no_fvs updatable NonStandardThunk
596 -> returnFC (updatable || not no_fvs || opt_SccProfilingOn)
598 -- For the non-updatable (single-entry case):
600 -- True if has fvs (in which case we need access to them, and we
601 -- should black-hole it)
602 -- or profiling (in which case we need to recover the cost centre
605 LFThunk _ _ no_fvs updatable some_standard_form_thunk
607 -- Node must point to any standard-form thunk.
609 LFArgument -> returnFC True
610 LFImported -> returnFC True
611 LFBlackHole _ -> returnFC True
612 -- BH entry may require Node to point
614 LFLetNoEscape _ -> returnFC False
617 The entry conventions depend on the type of closure being entered,
618 whether or not it has free variables, and whether we're running
619 sequentially or in parallel.
621 \begin{tabular}{lllll}
622 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
623 Unknown & no & yes & stack & node \\
624 Known fun ($\ge$ 1 arg), no fvs & no & no & registers & fast entry (enough args) \\
625 \ & \ & \ & \ & slow entry (otherwise) \\
626 Known fun ($\ge$ 1 arg), fvs & no & yes & registers & fast entry (enough args) \\
627 0 arg, no fvs @\r,\s@ & no & no & n/a & direct entry \\
628 0 arg, no fvs @\u@ & no & yes & n/a & node \\
629 0 arg, fvs @\r,\s@ & no & yes & n/a & direct entry \\
630 0 arg, fvs @\u@ & no & yes & n/a & node \\
632 Unknown & yes & yes & stack & node \\
633 Known fun ($\ge$ 1 arg), no fvs & yes & no & registers & fast entry (enough args) \\
634 \ & \ & \ & \ & slow entry (otherwise) \\
635 Known fun ($\ge$ 1 arg), fvs & yes & yes & registers & node \\
636 0 arg, no fvs @\r,\s@ & yes & no & n/a & direct entry \\
637 0 arg, no fvs @\u@ & yes & yes & n/a & node \\
638 0 arg, fvs @\r,\s@ & yes & yes & n/a & node \\
639 0 arg, fvs @\u@ & yes & yes & n/a & node\\
642 When black-holing, single-entry closures could also be entered via node
643 (rather than directly) to catch double-entry.
647 = ViaNode -- The "normal" convention
649 | StdEntry CLabel -- Jump to this code, with args on stack
651 | DirectEntry -- Jump directly, with args in regs
652 CLabel -- The code label
654 [MagicId] -- Its register assignments
657 getEntryConvention :: Name -- Function being applied
658 -> LambdaFormInfo -- Its info
659 -> [PrimRep] -- Available arguments
660 -> FCode EntryConvention
662 getEntryConvention name lf_info arg_kinds
663 = nodeMustPointToIt lf_info `thenFC` \ node_points ->
666 -- if we're parallel, then we must always enter via node. The reason
667 -- is that the closure may have been fetched since we allocated it.
669 if (node_points && opt_Parallel) then ViaNode else
671 -- Commented out by SDM after futher thoughts:
672 -- - the only closure type that can be blackholed is a thunk
673 -- - we already enter thunks via node (unless the closure is
674 -- non-updatable, in which case why is it being re-entered...)
678 LFReEntrant _ _ arity _ ->
679 if arity == 0 || (listLengthCmp arg_kinds arity == LT) then
680 StdEntry (mkStdEntryLabel name)
682 DirectEntry (mkFastEntryLabel name arity) arity arg_regs
684 (arg_regs, _) = assignRegs live_regs (take arity arg_kinds)
685 live_regs = if node_points then [node] else []
687 LFCon con True{-zero_arity-}
688 -- a real constructor. Don't bother entering it, just jump
689 -- to the constructor entry code directly.
690 -> --false:ASSERT (null arg_kinds)
691 -- Should have no args (meaning what?)
692 StdEntry (mkStaticConEntryLabel (dataConName con))
694 LFCon con False{-non-zero_arity-}
695 -> --false:ASSERT (null arg_kinds)
696 -- Should have no args (meaning what?)
697 StdEntry (mkConEntryLabel (dataConName con))
699 LFTuple tup zero_arity
700 -> --false:ASSERT (null arg_kinds)
701 -- Should have no args (meaning what?)
702 StdEntry (mkConEntryLabel (dataConName tup))
704 LFThunk _ _ _ updatable std_form_info
705 -> if updatable || opt_DoTickyProfiling -- to catch double entry
706 || opt_SMP -- always enter via node on SMP, since the
707 -- thunk might have been blackholed in the
710 else StdEntry (thunkEntryLabel name std_form_info updatable)
712 LFArgument -> ViaNode
713 LFImported -> ViaNode
714 LFBlackHole _ -> ViaNode -- Presumably the black hole has by now
715 -- been updated, but we don't know with
716 -- what, so we enter via Node
719 -> StdEntry (mkReturnPtLabel (nameUnique name))
722 -> if (not (arg_kinds `lengthIs` arity)) then pprPanic "let-no-escape: " (ppr name <+> ppr arity) else
723 DirectEntry (mkReturnPtLabel (nameUnique name)) arity arg_regs
725 (arg_regs, _) = assignRegs [] arg_kinds
726 -- node never points to a LetNoEscape, see above --SDM
727 --live_regs = if node_points then [node] else []
730 blackHoleOnEntry :: ClosureInfo -> Bool
732 -- Static closures are never themselves black-holed.
733 -- Updatable ones will be overwritten with a CAFList cell, which points to a
735 -- Single-entry ones have no fvs to plug, and we trust they don't form part
738 blackHoleOnEntry cl_info
739 | isStaticRep (closureSMRep cl_info)
740 = False -- Never black-hole a static closure
743 = case closureLFInfo cl_info of
744 LFReEntrant _ _ _ _ -> False
745 LFLetNoEscape _ -> False
746 LFThunk _ _ no_fvs updatable _
748 then not opt_OmitBlackHoling
749 else opt_DoTickyProfiling || not no_fvs
750 -- the former to catch double entry,
751 -- and the latter to plug space-leaks. KSW/SDM 1999-04.
753 other -> panic "blackHoleOnEntry" -- Should never happen
755 isStandardFormThunk :: LambdaFormInfo -> Bool
757 isStandardFormThunk (LFThunk _ _ _ _ (SelectorThunk _)) = True
758 isStandardFormThunk (LFThunk _ _ _ _ (ApThunk _)) = True
759 isStandardFormThunk other_lf_info = False
761 maybeSelectorInfo (MkClosureInfo { closureLFInfo = LFThunk _ _ _ _ (SelectorThunk offset) })
763 maybeSelectorInfo _ = Nothing
766 -----------------------------------------------------------------------------
770 staticClosureNeedsLink :: ClosureInfo -> Bool
771 -- A static closure needs a link field to aid the GC when traversing
772 -- the static closure graph. But it only needs such a field if either
774 -- b) it's a constructor with one or more pointer fields
775 -- In case (b), the constructor's fields themselves play the role
777 staticClosureNeedsLink (MkClosureInfo { closureName = name,
779 closureLFInfo = lf_info,
780 closureSMRep = sm_rep })
781 = needsSRT srt || (constr_with_fields && not_nocaf_constr)
785 GenericRep _ _ _ CONSTR_NOCAF -> False
790 LFThunk _ _ _ _ _ -> False
791 LFReEntrant _ _ _ _ -> False
792 LFCon _ is_nullary -> not is_nullary
793 LFTuple _ is_nullary -> not is_nullary
794 _other -> pprPanic "staticClosureNeedsLink" (ppr name)
797 Avoiding generating entries and info tables
798 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
799 At present, for every function we generate all of the following,
800 just in case. But they aren't always all needed, as noted below:
802 [NB1: all of this applies only to *functions*. Thunks always
803 have closure, info table, and entry code.]
805 [NB2: All are needed if the function is *exported*, just to play safe.]
808 * Fast-entry code ALWAYS NEEDED
811 Needed iff (a) we have any un-saturated calls to the function
812 OR (b) the function is passed as an arg
813 OR (c) we're in the parallel world and the function has free vars
814 [Reason: in parallel world, we always enter functions
815 with free vars via the closure.]
817 * The function closure
818 Needed iff (a) we have any un-saturated calls to the function
819 OR (b) the function is passed as an arg
820 OR (c) if the function has free vars (ie not top level)
822 Why case (a) here? Because if the arg-satis check fails,
823 UpdatePAP stuffs a pointer to the function closure in the PAP.
824 [Could be changed; UpdatePAP could stuff in a code ptr instead,
825 but doesn't seem worth it.]
827 [NB: these conditions imply that we might need the closure
828 without the slow-entry code. Here's how.
830 f x y = let g w = ...x..y..w...
834 Here we need a closure for g which contains x and y,
835 but since the calls are all saturated we just jump to the
836 fast entry point for g, with R1 pointing to the closure for g.]
839 * Standard info table
840 Needed iff (a) we have any un-saturated calls to the function
841 OR (b) the function is passed as an arg
842 OR (c) the function has free vars (ie not top level)
844 NB. In the sequential world, (c) is only required so that the function closure has
845 an info table to point to, to keep the storage manager happy.
846 If (c) alone is true we could fake up an info table by choosing
847 one of a standard family of info tables, whose entry code just
850 [NB In the parallel world (c) is needed regardless because
851 we enter functions with free vars via the closure.]
853 If (c) is retained, then we'll sometimes generate an info table
854 (for storage mgr purposes) without slow-entry code. Then we need
855 to use an error label in the info table to substitute for the absent
859 staticClosureRequired
864 staticClosureRequired binder bndr_info
865 (LFReEntrant _ top_level _ _) -- It's a function
866 = ASSERT( isTopLevel top_level )
867 -- Assumption: it's a top-level, no-free-var binding
868 not (satCallsOnly bndr_info)
870 staticClosureRequired binder other_binder_info other_lf_info = True
872 slowFunEntryCodeRequired -- Assumption: it's a function, not a thunk.
877 slowFunEntryCodeRequired binder bndr_info entry_conv
878 = not (satCallsOnly bndr_info)
879 || (case entry_conv of { DirectEntry _ _ _ -> False; other -> True })
880 {- The last case deals with the parallel world; a function usually
881 as a DirectEntry convention, but if it doesn't we must generate slow-entry code -}
888 funInfoTableRequired binder bndr_info (LFReEntrant _ top_level _ _)
889 = isNotTopLevel top_level
890 || not (satCallsOnly bndr_info)
892 funInfoTableRequired other_binder_info binder other_lf_info = True
895 %************************************************************************
897 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
899 %************************************************************************
903 isStaticClosure :: ClosureInfo -> Bool
904 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
906 closureUpdReqd :: ClosureInfo -> Bool
907 closureUpdReqd (MkClosureInfo { closureLFInfo = LFThunk _ _ _ upd _ }) = upd
908 closureUpdReqd (MkClosureInfo { closureLFInfo = LFBlackHole _ }) = True
909 -- Black-hole closures are allocated to receive the results of an
910 -- alg case with a named default... so they need to be updated.
911 closureUpdReqd other_closure = False
913 closureSingleEntry :: ClosureInfo -> Bool
914 closureSingleEntry (MkClosureInfo { closureLFInfo = LFThunk _ _ _ upd _ }) = not upd
915 closureSingleEntry other_closure = False
917 closureReEntrant :: ClosureInfo -> Bool
918 closureReEntrant (MkClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
919 closureReEntrant other_closure = False
923 closureSemiTag :: ClosureInfo -> Maybe Int
924 closureSemiTag (MkClosureInfo { closureLFInfo = lf_info })
926 LFCon data_con _ -> Just (dataConTag data_con - fIRST_TAG)
927 LFTuple _ _ -> Just 0
932 isToplevClosure :: ClosureInfo -> Bool
934 isToplevClosure (MkClosureInfo { closureLFInfo = lf_info })
936 LFReEntrant _ TopLevel _ _ -> True
937 LFThunk _ TopLevel _ _ _ -> True
944 fastLabelFromCI :: ClosureInfo -> CLabel
945 fastLabelFromCI (MkClosureInfo { closureName = name, closureLFInfo = LFReEntrant _ _ arity _ })
946 = mkFastEntryLabel name arity
948 fastLabelFromCI cl_info
949 = pprPanic "fastLabelFromCI" (ppr (closureName cl_info))
951 infoTableLabelFromCI :: ClosureInfo -> CLabel
952 infoTableLabelFromCI (MkClosureInfo { closureName = id, closureLFInfo = lf_info, closureSMRep = rep })
954 LFCon con _ -> mkConInfoPtr con rep
955 LFTuple tup _ -> mkConInfoPtr tup rep
957 LFBlackHole info -> info
959 LFThunk _ _ _ upd_flag (SelectorThunk offset) ->
960 mkSelectorInfoLabel upd_flag offset
962 LFThunk _ _ _ upd_flag (ApThunk arity) ->
963 mkApInfoTableLabel upd_flag arity
965 other -> {-NO: if isStaticRep rep
966 then mkStaticInfoTableLabel id
967 else -} mkInfoTableLabel id
969 mkConInfoPtr :: DataCon -> SMRep -> CLabel
971 | isStaticRep rep = mkStaticInfoTableLabel name
972 | otherwise = mkConInfoTableLabel name
974 name = dataConName con
976 mkConEntryPtr :: DataCon -> SMRep -> CLabel
977 mkConEntryPtr con rep
978 | isStaticRep rep = mkStaticConEntryLabel (dataConName con)
979 | otherwise = mkConEntryLabel (dataConName con)
981 closureLabelFromCI cl_info = mkClosureLabel (closureName cl_info)
983 entryLabelFromCI :: ClosureInfo -> CLabel
984 entryLabelFromCI (MkClosureInfo { closureName = id, closureLFInfo = lf_info, closureSMRep = rep })
986 LFThunk _ _ _ upd_flag std_form_info -> thunkEntryLabel id std_form_info upd_flag
987 LFCon con _ -> mkConEntryPtr con rep
988 LFTuple tup _ -> mkConEntryPtr tup rep
989 other -> mkStdEntryLabel id
991 -- thunkEntryLabel is a local help function, not exported. It's used from both
992 -- entryLabelFromCI and getEntryConvention.
994 thunkEntryLabel thunk_id (ApThunk arity) is_updatable
995 = mkApEntryLabel is_updatable arity
996 thunkEntryLabel thunk_id (SelectorThunk offset) upd_flag
997 = mkSelectorEntryLabel upd_flag offset
998 thunkEntryLabel thunk_id _ is_updatable
999 = mkStdEntryLabel thunk_id
1003 allocProfilingMsg :: ClosureInfo -> FastString
1005 allocProfilingMsg cl_info
1006 = case closureLFInfo cl_info of
1007 LFReEntrant _ _ _ _ -> FSLIT("TICK_ALLOC_FUN")
1008 LFCon _ _ -> FSLIT("TICK_ALLOC_CON")
1009 LFTuple _ _ -> FSLIT("TICK_ALLOC_CON")
1010 LFThunk _ _ _ True _ -> FSLIT("TICK_ALLOC_UP_THK") -- updatable
1011 LFThunk _ _ _ False _ -> FSLIT("TICK_ALLOC_SE_THK") -- nonupdatable
1012 LFBlackHole _ -> FSLIT("TICK_ALLOC_BH")
1013 LFImported -> panic "TICK_ALLOC_IMP"
1016 We need a black-hole closure info to pass to @allocDynClosure@ when we
1017 want to allocate the black hole on entry to a CAF. These are the only
1018 ways to build an LFBlackHole, maintaining the invariant that it really
1019 is a black hole and not something else.
1022 cafBlackHoleClosureInfo cl_info
1023 = MkClosureInfo { closureName = closureName cl_info,
1024 closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel,
1025 closureSMRep = BlackHoleRep,
1026 closureSRT = NoC_SRT }
1028 seCafBlackHoleClosureInfo cl_info
1029 = MkClosureInfo { closureName = closureName cl_info,
1030 closureLFInfo = LFBlackHole mkSECAFBlackHoleInfoTableLabel,
1031 closureSMRep = BlackHoleRep,
1032 closureSRT = NoC_SRT }
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 cl_info
1053 = case closureLFInfo cl_info of
1054 LFThunk ty _ _ _ _ -> getTyDescription ty
1055 LFReEntrant ty _ _ _ -> getTyDescription ty
1056 LFCon data_con _ -> occNameUserString (getOccName (dataConTyCon data_con))
1057 other -> showSDoc (ppr (closureName cl_info))