2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: ClosureInfo.lhs,v 1.48 2001/09/26 15:11: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, layOutDynConstr, layOutStaticClosure,
27 layOutStaticNoFVClosure, layOutStaticConstr,
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"
59 import AbsCSyn ( MagicId, node, VirtualHeapOffset, HeapOffset, C_SRT(..), needsSRT )
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, idCgArity )
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 )
96 %************************************************************************
98 \subsection[ClosureInfo-datatypes]{Data types for closure information}
100 %************************************************************************
102 The ``wrapper'' data type for closure information:
107 closureName :: Name, -- The thing bound to this closure
108 closureLFInfo :: LambdaFormInfo, -- Info derivable from the *source*
109 closureSMRep :: SMRep, -- representation used by storage manager
110 closureSRT :: C_SRT -- What SRT applies to this closure
114 %************************************************************************
116 \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
118 %************************************************************************
122 = LFReEntrant -- Reentrant closure; used for PAPs too
123 Type -- Type of closure (ToDo: remove)
124 TopLevelFlag -- True if top level
126 !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)
143 | LFArgument -- Used for function arguments. We know nothing about
144 -- this closure. Treat like updatable "LFThunk"...
146 | LFImported -- Used for imported things. We know nothing about this
147 -- closure. Treat like updatable "LFThunk"...
148 -- Imported things which we do know something about use
149 -- one of the other LF constructors (eg LFReEntrant for
152 | LFLetNoEscape -- See LetNoEscape module for precise description of
156 | LFBlackHole -- Used for the closures allocated to hold the result
157 -- of a CAF. We want the target of the update frame to
158 -- be in the heap, so we make a black hole to hold it.
159 CLabel -- Flavour (info label, eg CAF_BLACKHOLE_info).
162 data StandardFormInfo -- Tells whether this thunk has one of a small number
165 = NonStandardThunk -- No, it isn't
168 Int -- 0-origin offset of ak within the "goods" of
169 -- constructor (Recall that the a1,...,an may be laid
170 -- out in the heap in a non-obvious order.)
172 {- A SelectorThunk is of form
177 and the constructor is from a single-constr type.
183 {- An ApThunk is of form
187 The code for the thunk just pushes x2..xn on the stack and enters x1.
188 There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
189 in the RTS to save space.
194 %************************************************************************
196 \subsection[ClosureInfo-construction]{Functions which build LFInfos}
198 %************************************************************************
200 @mkClosureLFInfo@ figures out the appropriate LFInfo for the closure.
203 mkClosureLFInfo :: Id -- The binder
204 -> TopLevelFlag -- True of top level
206 -> UpdateFlag -- Update flag
210 mkClosureLFInfo bndr top fvs upd_flag args@(_:_) -- Non-empty args
211 = LFReEntrant (idType bndr) top (length args) (null fvs)
213 mkClosureLFInfo bndr top fvs ReEntrant []
214 = LFReEntrant (idType bndr) top 0 (null fvs)
216 mkClosureLFInfo bndr top fvs upd_flag []
218 | isUnLiftedType ty = pprPanic "mkClosureLFInfo" (ppr bndr <+> ppr ty)
221 = LFThunk ty top (null fvs) (isUpdatable upd_flag) NonStandardThunk
226 @mkConLFInfo@ is similar, for constructors.
229 mkConLFInfo :: DataCon -> LambdaFormInfo
232 = -- the isNullaryDataCon will do this: ASSERT(isDataCon con)
233 (if isBoxedTupleTyCon (dataConTyCon con) then LFTuple else LFCon)
234 con (isNullaryDataCon con)
236 mkSelectorLFInfo rhs_ty offset updatable
237 = LFThunk rhs_ty NotTopLevel False updatable (SelectorThunk offset)
239 mkApLFInfo rhs_ty upd_flag arity
240 = LFThunk rhs_ty NotTopLevel (arity == 0)
241 (isUpdatable upd_flag) (ApThunk arity)
244 Miscellaneous LF-infos.
247 mkLFArgument = LFArgument
248 mkLFLetNoEscape = LFLetNoEscape
250 mkLFImported :: Id -> LambdaFormInfo
252 = case idCgArity id of
253 n | n > 0 -> LFReEntrant (idType id) TopLevel n True -- n > 0
254 other -> LFImported -- Not sure of exact arity
257 %************************************************************************
259 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
261 %************************************************************************
264 closureSize :: ClosureInfo -> HeapOffset
265 closureSize cl_info = fixedHdrSize + closureNonHdrSize cl_info
267 closureNonHdrSize :: ClosureInfo -> Int
268 closureNonHdrSize cl_info
269 = tot_wds + computeSlopSize tot_wds
270 (closureSMRep cl_info)
271 (closureUpdReqd cl_info)
273 tot_wds = closureGoodStuffSize cl_info
275 slopSize :: ClosureInfo -> Int
277 = computeSlopSize (closureGoodStuffSize cl_info)
278 (closureSMRep cl_info)
279 (closureUpdReqd cl_info)
281 closureGoodStuffSize :: ClosureInfo -> Int
282 closureGoodStuffSize cl_info
283 = let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info)
286 closurePtrsSize :: ClosureInfo -> Int
287 closurePtrsSize cl_info
288 = let (ptrs, _) = sizes_from_SMRep (closureSMRep cl_info)
292 sizes_from_SMRep :: SMRep -> (Int,Int)
293 sizes_from_SMRep (GenericRep _ ptrs nonptrs _) = (ptrs, nonptrs)
294 sizes_from_SMRep BlackHoleRep = (0, 0)
297 Computing slop size. WARNING: this looks dodgy --- it has deep
298 knowledge of what the storage manager does with the various
304 Updateable closures must be @mIN_UPD_SIZE@.
307 Indirections require 1 word
309 Appels collector indirections 2 words
311 THEREFORE: @mIN_UPD_SIZE = 2@.
314 Collectable closures which are allocated in the heap
315 must be @mIN_SIZE_NonUpdHeapObject@.
317 Copying collector forward pointer requires 1 word
319 THEREFORE: @mIN_SIZE_NonUpdHeapObject = 1@
322 Static closures have an extra ``static link field'' at the end, but we
323 don't bother taking that into account here.
326 computeSlopSize :: Int -> SMRep -> Bool -> Int
328 computeSlopSize tot_wds (GenericRep _ _ _ _) True -- Updatable
329 = max 0 (mIN_UPD_SIZE - tot_wds)
331 computeSlopSize tot_wds (GenericRep True _ _ _) False -- Non updatable
334 computeSlopSize tot_wds (GenericRep False _ _ _) False -- Non updatable
335 = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds) -- Dynamic
337 computeSlopSize tot_wds BlackHoleRep _ -- Updatable
338 = max 0 (mIN_UPD_SIZE - tot_wds)
341 %************************************************************************
343 \subsection[layOutDynClosure]{Lay out a dynamic closure}
345 %************************************************************************
348 layOutDynClosure, layOutStaticClosure
349 :: Name -- STG identifier of this closure
350 -> (a -> PrimRep) -- how to get a PrimRep for the fields
351 -> [a] -- the "things" being layed out
352 -> LambdaFormInfo -- what sort of closure it is
354 -> (ClosureInfo, -- info about the closure
355 [(a, VirtualHeapOffset)]) -- things w/ offsets pinned on them
357 layOutDynClosure name kind_fn things lf_info srt_info
358 = (MkClosureInfo { closureName = name, closureLFInfo = lf_info,
359 closureSMRep = sm_rep, closureSRT = srt_info },
362 (tot_wds, -- #ptr_wds + #nonptr_wds
364 things_w_offsets) = mkVirtHeapOffsets kind_fn things
365 sm_rep = chooseDynSMRep lf_info tot_wds ptr_wds
368 Wrappers for when used with data constructors:
371 layOutDynConstr, layOutStaticConstr
372 :: Name -- Of the closure
374 -> (a -> PrimRep) -> [a]
375 -> (ClosureInfo, [(a,VirtualHeapOffset)])
377 layOutDynConstr name data_con kind_fn args
378 = layOutDynClosure name kind_fn args (mkConLFInfo data_con) NoC_SRT
380 layOutStaticConstr name data_con kind_fn things
381 = layOutStaticClosure name kind_fn things (mkConLFInfo data_con) NoC_SRT
384 %************************************************************************
386 \subsection[layOutStaticClosure]{Lay out a static closure}
388 %************************************************************************
390 layOutStaticClosure is only used for laying out static constructors at
393 Static closures for functions are laid out using
394 layOutStaticNoFVClosure.
397 layOutStaticClosure name kind_fn things lf_info srt_info
398 = (MkClosureInfo { closureName = name, closureLFInfo = lf_info,
399 closureSMRep = rep, closureSRT = srt_info },
402 rep = GenericRep is_static ptr_wds (tot_wds - ptr_wds) closure_type
404 (tot_wds, -- #ptr_wds + #nonptr_wds
406 things_w_offsets) = mkVirtHeapOffsets kind_fn things
408 -- constructors with no pointer fields will definitely be NOCAF things.
409 -- this is a compromise until we can generate both kinds of constructor
410 -- (a normal static kind and the NOCAF_STATIC kind).
411 closure_type = getClosureType is_static tot_wds ptr_wds lf_info
414 layOutStaticNoFVClosure :: Name -> LambdaFormInfo -> C_SRT -> ClosureInfo
415 layOutStaticNoFVClosure name lf_info srt_info
416 = MkClosureInfo { closureName = name, closureLFInfo = lf_info,
417 closureSMRep = rep, closureSRT = srt_info }
419 rep = GenericRep is_static 0 0 (getClosureType is_static 0 0 lf_info)
423 %************************************************************************
425 \subsection[SMreps]{Choosing SM reps}
427 %************************************************************************
432 -> Int -> Int -- Tot wds, ptr wds
435 chooseDynSMRep lf_info tot_wds ptr_wds
438 nonptr_wds = tot_wds - ptr_wds
439 closure_type = getClosureType is_static tot_wds ptr_wds lf_info
441 GenericRep is_static ptr_wds nonptr_wds closure_type
443 -- we *do* get non-updatable top-level thunks sometimes. eg. f = g
444 -- gets compiled to a jump to g (if g has non-zero arity), instead of
445 -- messing around with update frames and PAPs. We set the closure type
446 -- to FUN_STATIC in this case.
448 getClosureType :: Bool -> Int -> Int -> LambdaFormInfo -> ClosureType
449 getClosureType is_static tot_wds ptr_wds lf_info
452 | is_static && ptr_wds == 0 -> CONSTR_NOCAF
453 | specialised_rep mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n
454 | otherwise -> CONSTR
457 | is_static && ptr_wds == 0 -> CONSTR_NOCAF
458 | specialised_rep mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n
459 | otherwise -> CONSTR
462 | specialised_rep mAX_SPEC_FUN_SIZE -> FUN_p_n
465 LFThunk _ _ _ _ (SelectorThunk _) -> THUNK_SELECTOR
468 | specialised_rep mAX_SPEC_THUNK_SIZE -> THUNK_p_n
471 _ -> panic "getClosureType"
473 specialised_rep max_size = not is_static
475 && tot_wds <= max_size
478 %************************************************************************
480 \subsection[mkVirtHeapOffsets]{Assigning heap offsets in a closure}
482 %************************************************************************
484 @mkVirtHeapOffsets@ (the heap version) always returns boxed things with
485 smaller offsets than the unboxed things, and furthermore, the offsets in
490 (a -> PrimRep) -- To be able to grab kinds;
491 -- w/ a kind, we can find boxedness
492 -> [a] -- Things to make offsets for
493 -> (Int, -- *Total* number of words allocated
494 Int, -- Number of words allocated for *pointers*
495 [(a, VirtualHeapOffset)])
496 -- Things with their offsets from start of
497 -- object in order of increasing offset
499 -- First in list gets lowest offset, which is initial offset + 1.
501 mkVirtHeapOffsets kind_fun things
502 = let (ptrs, non_ptrs) = separateByPtrFollowness kind_fun things
503 (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
504 (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
506 (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
508 computeOffset wds_so_far thing
509 = (wds_so_far + (getPrimRepSize . kind_fun) thing,
510 (thing, fixedHdrSize + wds_so_far)
514 %************************************************************************
516 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
518 %************************************************************************
520 Be sure to see the stg-details notes about these...
523 nodeMustPointToIt :: LambdaFormInfo -> FCode Bool
524 nodeMustPointToIt lf_info
527 LFReEntrant ty top arity no_fvs -> returnFC (
528 not no_fvs || -- Certainly if it has fvs we need to point to it
530 -- If it is not top level we will point to it
531 -- We can have a \r closure with no_fvs which
532 -- is not top level as special case cgRhsClosure
533 -- has been dissabled in favour of let floating
535 -- For lex_profiling we also access the cost centre for a
536 -- non-inherited function i.e. not top level
537 -- the not top case above ensures this is ok.
540 LFCon _ zero_arity -> returnFC True
541 LFTuple _ zero_arity -> returnFC True
543 -- Strictly speaking, the above two don't need Node to point
544 -- to it if the arity = 0. But this is a *really* unlikely
545 -- situation. If we know it's nil (say) and we are entering
546 -- it. Eg: let x = [] in x then we will certainly have inlined
547 -- x, since nil is a simple atom. So we gain little by not
548 -- having Node point to known zero-arity things. On the other
549 -- hand, we do lose something; Patrick's code for figuring out
550 -- when something has been updated but not entered relies on
551 -- having Node point to the result of an update. SLPJ
554 LFThunk _ _ no_fvs updatable NonStandardThunk
555 -> returnFC (updatable || not no_fvs || opt_SccProfilingOn)
557 -- For the non-updatable (single-entry case):
559 -- True if has fvs (in which case we need access to them, and we
560 -- should black-hole it)
561 -- or profiling (in which case we need to recover the cost centre
564 LFThunk _ _ no_fvs updatable some_standard_form_thunk
566 -- Node must point to any standard-form thunk.
568 LFArgument -> returnFC True
569 LFImported -> returnFC True
570 LFBlackHole _ -> returnFC True
571 -- BH entry may require Node to point
573 LFLetNoEscape _ -> returnFC False
576 The entry conventions depend on the type of closure being entered,
577 whether or not it has free variables, and whether we're running
578 sequentially or in parallel.
580 \begin{tabular}{lllll}
581 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
582 Unknown & no & yes & stack & node \\
583 Known fun ($\ge$ 1 arg), no fvs & no & no & registers & fast entry (enough args) \\
584 \ & \ & \ & \ & slow entry (otherwise) \\
585 Known fun ($\ge$ 1 arg), fvs & no & yes & registers & fast entry (enough args) \\
586 0 arg, no fvs @\r,\s@ & no & no & n/a & direct entry \\
587 0 arg, no fvs @\u@ & no & yes & n/a & node \\
588 0 arg, fvs @\r,\s@ & no & yes & n/a & direct entry \\
589 0 arg, fvs @\u@ & no & yes & n/a & node \\
591 Unknown & yes & yes & stack & node \\
592 Known fun ($\ge$ 1 arg), no fvs & yes & no & registers & fast entry (enough args) \\
593 \ & \ & \ & \ & slow entry (otherwise) \\
594 Known fun ($\ge$ 1 arg), fvs & yes & yes & registers & node \\
595 0 arg, no fvs @\r,\s@ & yes & no & n/a & direct entry \\
596 0 arg, no fvs @\u@ & yes & yes & n/a & node \\
597 0 arg, fvs @\r,\s@ & yes & yes & n/a & node \\
598 0 arg, fvs @\u@ & yes & yes & n/a & node\\
601 When black-holing, single-entry closures could also be entered via node
602 (rather than directly) to catch double-entry.
606 = ViaNode -- The "normal" convention
608 | StdEntry CLabel -- Jump to this code, with args on stack
610 | DirectEntry -- Jump directly, with args in regs
611 CLabel -- The code label
613 [MagicId] -- Its register assignments
616 getEntryConvention :: Name -- Function being applied
617 -> LambdaFormInfo -- Its info
618 -> [PrimRep] -- Available arguments
619 -> FCode EntryConvention
621 getEntryConvention name lf_info arg_kinds
622 = nodeMustPointToIt lf_info `thenFC` \ node_points ->
625 -- if we're parallel, then we must always enter via node. The reason
626 -- is that the closure may have been fetched since we allocated it.
628 if (node_points && opt_Parallel) then ViaNode else
630 -- Commented out by SDM after futher thoughts:
631 -- - the only closure type that can be blackholed is a thunk
632 -- - we already enter thunks via node (unless the closure is
633 -- non-updatable, in which case why is it being re-entered...)
637 LFReEntrant _ _ arity _ ->
638 if arity == 0 || (length arg_kinds) < arity then
639 StdEntry (mkStdEntryLabel name)
641 DirectEntry (mkFastEntryLabel name arity) arity arg_regs
643 (arg_regs, _) = assignRegs live_regs (take arity arg_kinds)
644 live_regs = if node_points then [node] else []
646 LFCon con True{-zero_arity-}
647 -- a real constructor. Don't bother entering it, just jump
648 -- to the constructor entry code directly.
649 -> --false:ASSERT (null arg_kinds)
650 -- Should have no args (meaning what?)
651 StdEntry (mkStaticConEntryLabel (dataConName con))
653 LFCon con False{-non-zero_arity-}
654 -> --false:ASSERT (null arg_kinds)
655 -- Should have no args (meaning what?)
656 StdEntry (mkConEntryLabel (dataConName con))
658 LFTuple tup zero_arity
659 -> --false:ASSERT (null arg_kinds)
660 -- Should have no args (meaning what?)
661 StdEntry (mkConEntryLabel (dataConName tup))
663 LFThunk _ _ _ updatable std_form_info
664 -> if updatable || opt_DoTickyProfiling -- to catch double entry
665 || opt_SMP -- always enter via node on SMP, since the
666 -- thunk might have been blackholed in the
669 else StdEntry (thunkEntryLabel name std_form_info updatable)
671 LFArgument -> ViaNode
672 LFImported -> ViaNode
673 LFBlackHole _ -> ViaNode -- Presumably the black hole has by now
674 -- been updated, but we don't know with
675 -- what, so we enter via Node
678 -> StdEntry (mkReturnPtLabel (nameUnique name))
681 -> if (arity /= length arg_kinds) then pprPanic "let-no-escape: " (ppr name <+> ppr arity) else
682 DirectEntry (mkReturnPtLabel (nameUnique name)) arity arg_regs
684 (arg_regs, _) = assignRegs [] arg_kinds
685 -- node never points to a LetNoEscape, see above --SDM
686 --live_regs = if node_points then [node] else []
689 blackHoleOnEntry :: ClosureInfo -> Bool
691 -- Static closures are never themselves black-holed.
692 -- Updatable ones will be overwritten with a CAFList cell, which points to a
694 -- Single-entry ones have no fvs to plug, and we trust they don't form part
697 blackHoleOnEntry cl_info
698 | isStaticRep (closureSMRep cl_info)
699 = False -- Never black-hole a static closure
702 = case closureLFInfo cl_info of
703 LFReEntrant _ _ _ _ -> False
704 LFLetNoEscape _ -> False
705 LFThunk _ _ no_fvs updatable _
707 then not opt_OmitBlackHoling
708 else opt_DoTickyProfiling || not no_fvs
709 -- the former to catch double entry,
710 -- and the latter to plug space-leaks. KSW/SDM 1999-04.
712 other -> panic "blackHoleOnEntry" -- Should never happen
714 isStandardFormThunk :: LambdaFormInfo -> Bool
716 isStandardFormThunk (LFThunk _ _ _ _ (SelectorThunk _)) = True
717 isStandardFormThunk (LFThunk _ _ _ _ (ApThunk _)) = True
718 isStandardFormThunk other_lf_info = False
720 maybeSelectorInfo (MkClosureInfo { closureLFInfo = LFThunk _ _ _ _ (SelectorThunk offset) })
722 maybeSelectorInfo _ = Nothing
725 -----------------------------------------------------------------------------
729 staticClosureNeedsLink :: ClosureInfo -> Bool
730 -- A static closure needs a link field to aid the GC when traversing
731 -- the static closure graph. But it only needs such a field if either
733 -- b) it's a non-nullary constructor
734 -- In case (b), the constructor's fields themselves play the role
736 staticClosureNeedsLink (MkClosureInfo { closureName = name, closureSRT = srt, closureLFInfo = info })
737 = needsSRT srt || constructor_srt
741 LFThunk _ _ _ _ _ -> False
742 LFReEntrant _ _ _ _ -> False
743 LFCon _ is_nullary -> not is_nullary
744 LFTuple _ is_nullary -> not is_nullary
745 other -> pprPanic "staticClosureNeedsLink" (ppr name)
748 Avoiding generating entries and info tables
749 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
750 At present, for every function we generate all of the following,
751 just in case. But they aren't always all needed, as noted below:
753 [NB1: all of this applies only to *functions*. Thunks always
754 have closure, info table, and entry code.]
756 [NB2: All are needed if the function is *exported*, just to play safe.]
759 * Fast-entry code ALWAYS NEEDED
762 Needed iff (a) we have any un-saturated calls to the function
763 OR (b) the function is passed as an arg
764 OR (c) we're in the parallel world and the function has free vars
765 [Reason: in parallel world, we always enter functions
766 with free vars via the closure.]
768 * The function closure
769 Needed iff (a) we have any un-saturated calls to the function
770 OR (b) the function is passed as an arg
771 OR (c) if the function has free vars (ie not top level)
773 Why case (a) here? Because if the arg-satis check fails,
774 UpdatePAP stuffs a pointer to the function closure in the PAP.
775 [Could be changed; UpdatePAP could stuff in a code ptr instead,
776 but doesn't seem worth it.]
778 [NB: these conditions imply that we might need the closure
779 without the slow-entry code. Here's how.
781 f x y = let g w = ...x..y..w...
785 Here we need a closure for g which contains x and y,
786 but since the calls are all saturated we just jump to the
787 fast entry point for g, with R1 pointing to the closure for g.]
790 * Standard info table
791 Needed iff (a) we have any un-saturated calls to the function
792 OR (b) the function is passed as an arg
793 OR (c) the function has free vars (ie not top level)
795 NB. In the sequential world, (c) is only required so that the function closure has
796 an info table to point to, to keep the storage manager happy.
797 If (c) alone is true we could fake up an info table by choosing
798 one of a standard family of info tables, whose entry code just
801 [NB In the parallel world (c) is needed regardless because
802 we enter functions with free vars via the closure.]
804 If (c) is retained, then we'll sometimes generate an info table
805 (for storage mgr purposes) without slow-entry code. Then we need
806 to use an error label in the info table to substitute for the absent
810 staticClosureRequired
815 staticClosureRequired binder bndr_info
816 (LFReEntrant _ top_level _ _) -- It's a function
817 = ASSERT( isTopLevel top_level )
818 -- Assumption: it's a top-level, no-free-var binding
819 not (satCallsOnly bndr_info)
821 staticClosureRequired binder other_binder_info other_lf_info = True
823 slowFunEntryCodeRequired -- Assumption: it's a function, not a thunk.
828 slowFunEntryCodeRequired binder bndr_info entry_conv
829 = not (satCallsOnly bndr_info)
830 || (case entry_conv of { DirectEntry _ _ _ -> False; other -> True })
831 {- The last case deals with the parallel world; a function usually
832 as a DirectEntry convention, but if it doesn't we must generate slow-entry code -}
839 funInfoTableRequired binder bndr_info (LFReEntrant _ top_level _ _)
840 = isNotTopLevel top_level
841 || not (satCallsOnly bndr_info)
843 funInfoTableRequired other_binder_info binder other_lf_info = True
846 %************************************************************************
848 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
850 %************************************************************************
854 isStaticClosure :: ClosureInfo -> Bool
855 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
857 closureUpdReqd :: ClosureInfo -> Bool
858 closureUpdReqd (MkClosureInfo { closureLFInfo = LFThunk _ _ _ upd _ }) = upd
859 closureUpdReqd (MkClosureInfo { closureLFInfo = LFBlackHole _ }) = True
860 -- Black-hole closures are allocated to receive the results of an
861 -- alg case with a named default... so they need to be updated.
862 closureUpdReqd other_closure = False
864 closureSingleEntry :: ClosureInfo -> Bool
865 closureSingleEntry (MkClosureInfo { closureLFInfo = LFThunk _ _ _ upd _ }) = not upd
866 closureSingleEntry other_closure = False
868 closureReEntrant :: ClosureInfo -> Bool
869 closureReEntrant (MkClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
870 closureReEntrant other_closure = False
874 closureSemiTag :: ClosureInfo -> Maybe Int
875 closureSemiTag (MkClosureInfo { closureLFInfo = lf_info })
877 LFCon data_con _ -> Just (dataConTag data_con - fIRST_TAG)
878 LFTuple _ _ -> Just 0
883 isToplevClosure :: ClosureInfo -> Bool
885 isToplevClosure (MkClosureInfo { closureLFInfo = lf_info })
887 LFReEntrant _ TopLevel _ _ -> True
888 LFThunk _ TopLevel _ _ _ -> True
895 fastLabelFromCI :: ClosureInfo -> CLabel
896 fastLabelFromCI (MkClosureInfo { closureName = name, closureLFInfo = LFReEntrant _ _ arity _ })
897 = mkFastEntryLabel name arity
899 fastLabelFromCI cl_info
900 = pprPanic "fastLabelFromCI" (ppr (closureName cl_info))
902 infoTableLabelFromCI :: ClosureInfo -> CLabel
903 infoTableLabelFromCI (MkClosureInfo { closureName = id, closureLFInfo = lf_info, closureSMRep = rep })
905 LFCon con _ -> mkConInfoPtr con rep
906 LFTuple tup _ -> mkConInfoPtr tup rep
908 LFBlackHole info -> info
910 LFThunk _ _ _ upd_flag (SelectorThunk offset) ->
911 mkSelectorInfoLabel upd_flag offset
913 LFThunk _ _ _ upd_flag (ApThunk arity) ->
914 mkApInfoTableLabel upd_flag arity
916 other -> {-NO: if isStaticRep rep
917 then mkStaticInfoTableLabel id
918 else -} mkInfoTableLabel id
920 mkConInfoPtr :: DataCon -> SMRep -> CLabel
922 | isStaticRep rep = mkStaticInfoTableLabel name
923 | otherwise = mkConInfoTableLabel name
925 name = dataConName con
927 mkConEntryPtr :: DataCon -> SMRep -> CLabel
928 mkConEntryPtr con rep
929 | isStaticRep rep = mkStaticConEntryLabel (dataConName con)
930 | otherwise = mkConEntryLabel (dataConName con)
932 closureLabelFromCI cl_info = mkClosureLabel (closureName cl_info)
934 entryLabelFromCI :: ClosureInfo -> CLabel
935 entryLabelFromCI (MkClosureInfo { closureName = id, closureLFInfo = lf_info, closureSMRep = rep })
937 LFThunk _ _ _ upd_flag std_form_info -> thunkEntryLabel id std_form_info upd_flag
938 LFCon con _ -> mkConEntryPtr con rep
939 LFTuple tup _ -> mkConEntryPtr tup rep
940 other -> mkStdEntryLabel id
942 -- thunkEntryLabel is a local help function, not exported. It's used from both
943 -- entryLabelFromCI and getEntryConvention.
945 thunkEntryLabel thunk_id (ApThunk arity) is_updatable
946 = mkApEntryLabel is_updatable arity
947 thunkEntryLabel thunk_id (SelectorThunk offset) upd_flag
948 = mkSelectorEntryLabel upd_flag offset
949 thunkEntryLabel thunk_id _ is_updatable
950 = mkStdEntryLabel thunk_id
954 allocProfilingMsg :: ClosureInfo -> FAST_STRING
956 allocProfilingMsg cl_info
957 = case closureLFInfo cl_info of
958 LFReEntrant _ _ _ _ -> SLIT("TICK_ALLOC_FUN")
959 LFCon _ _ -> SLIT("TICK_ALLOC_CON")
960 LFTuple _ _ -> SLIT("TICK_ALLOC_CON")
961 LFThunk _ _ _ True _ -> SLIT("TICK_ALLOC_UP_THK") -- updatable
962 LFThunk _ _ _ False _ -> SLIT("TICK_ALLOC_SE_THK") -- nonupdatable
963 LFBlackHole _ -> SLIT("TICK_ALLOC_BH")
964 LFImported -> panic "TICK_ALLOC_IMP"
967 We need a black-hole closure info to pass to @allocDynClosure@ when we
968 want to allocate the black hole on entry to a CAF. These are the only
969 ways to build an LFBlackHole, maintaining the invariant that it really
970 is a black hole and not something else.
973 cafBlackHoleClosureInfo cl_info
974 = MkClosureInfo { closureName = closureName cl_info,
975 closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel,
976 closureSMRep = BlackHoleRep,
977 closureSRT = NoC_SRT }
979 seCafBlackHoleClosureInfo cl_info
980 = MkClosureInfo { closureName = closureName cl_info,
981 closureLFInfo = LFBlackHole mkSECAFBlackHoleInfoTableLabel,
982 closureSMRep = BlackHoleRep,
983 closureSRT = NoC_SRT }
986 %************************************************************************
988 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
990 %************************************************************************
992 Profiling requires two pieces of information to be determined for
993 each closure's info table --- description and type.
995 The description is stored directly in the @CClosureInfoTable@ when the
998 The type is determined from the type information stored with the @Id@
999 in the closure info using @closureTypeDescr@.
1002 closureTypeDescr :: ClosureInfo -> String
1003 closureTypeDescr cl_info
1004 = case closureLFInfo cl_info of
1005 LFThunk ty _ _ _ _ -> getTyDescription ty
1006 LFReEntrant ty _ _ _ -> getTyDescription ty
1007 LFCon data_con _ -> occNameUserString (getOccName (dataConTyCon data_con))
1008 other -> showSDoc (ppr (closureName cl_info))