2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: ClosureInfo.lhs,v 1.57 2003/05/14 09:13:56 simonmar Exp $
6 \section[ClosureInfo]{Data structures which describe closures}
8 Much of the rationale for these things is in the ``details'' part of
13 ClosureInfo, LambdaFormInfo, SMRep, -- all abstract
14 StandardFormInfo, ArgDescr(..),
16 CallingConvention(..),
18 mkClosureLFInfo, mkConLFInfo, mkSelectorLFInfo,
19 mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
22 closureSize, closureNonHdrSize,
23 closureGoodStuffSize, closurePtrsSize,
26 layOutDynClosure, layOutStaticClosure, layOutStaticNoFVClosure,
27 layOutDynConstr, layOutStaticConstr,
28 mkVirtHeapOffsets, mkStaticClosure,
30 nodeMustPointToIt, getEntryConvention,
31 FCode, CgInfoDownwards, CgState,
35 staticClosureRequired,
37 closureName, infoTableLabelFromCI,
38 closureLabelFromCI, closureSRT,
40 closureLFInfo, closureSMRep, closureUpdReqd,
41 closureSingleEntry, closureReEntrant, closureSemiTag,
42 closureFunInfo, isStandardFormThunk,
46 closureTypeDescr, -- profiling
50 cafBlackHoleClosureInfo, seCafBlackHoleClosureInfo,
52 staticClosureNeedsLink,
54 mkInfoTable, mkRetInfoTable, mkVecInfoTable,
57 #include "../includes/config.h"
58 #include "../includes/MachDeps.h"
59 #include "HsVersions.h"
65 import Constants ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject )
66 import CgRetConv ( assignRegs )
68 import CmdLineOpts ( opt_SccProfilingOn, opt_OmitBlackHoling,
69 opt_Parallel, opt_DoTickyProfiling,
70 opt_SMP, opt_Unregisterised )
71 import Id ( Id, idType, idArity, idName, idPrimRep )
72 import DataCon ( DataCon, dataConTag, fIRST_TAG, dataConTyCon,
73 isNullaryDataCon, dataConName
75 import Name ( Name, nameUnique, getOccName, getName )
76 import OccName ( occNameUserString )
77 import PprType ( getTyDescription )
79 import SMRep -- all of it
80 import Type ( isUnLiftedType, Type, repType, splitTyConApp_maybe )
81 import TyCon ( isFunTyCon )
82 import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel )
83 import Util ( mapAccumL, listLengthCmp, lengthIs )
90 import Maybe ( isJust )
94 %************************************************************************
96 \subsection[ClosureInfo-datatypes]{Data types for closure information}
98 %************************************************************************
100 Information about a closure, from the code generator's point of view.
102 A ClosureInfo decribes the info pointer of a closure. It has
104 a) to construct the info table itself
105 b) to allocate a closure containing that info pointer (i.e.
106 it knows the info table label)
108 We make a ClosureInfo for
109 - each let binding (both top level and not)
110 - each data constructor (for its shared static and
116 closureName :: !Name, -- The thing bound to this closure
117 closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon (see below)
118 closureSMRep :: !SMRep, -- representation used by storage mgr
119 closureSRT :: !C_SRT, -- What SRT applies to this closure
120 closureType :: !Type, -- Type of closure (ToDo: remove)
121 closureDescr :: !String -- closure description (for profiling)
124 -- constructor closures don't have a unique info table label (they use
125 -- the constructor's info table), and they don't have an SRT.
127 closureCon :: !DataCon,
128 closureSMRep :: !SMRep
132 %************************************************************************
134 \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
136 %************************************************************************
138 Information about an identifier, from the code generator's point of
139 view. Every identifier is bound to a LambdaFormInfo in the
140 environment, which gives the code generator enough info to be able to
141 tail call or return that identifier.
143 Note that a closure is usually bound to an identifier, so a
144 ClosureInfo contains a LambdaFormInfo.
148 = LFReEntrant -- Reentrant closure (a function)
149 TopLevelFlag -- True if top level
151 !Bool -- True <=> no fvs
152 ArgDescr -- Argument descriptor (should reall be in ClosureInfo)
154 | LFCon -- Constructor
155 DataCon -- The constructor
157 | LFThunk -- Thunk (zero arity)
159 !Bool -- True <=> no free vars
160 !Bool -- True <=> updatable (i.e., *not* single-entry)
162 !Bool -- True <=> *might* be a function type
164 | LFUnknown -- Used for function arguments and imported things.
165 -- We know nothing about this closure. Treat like
166 -- updatable "LFThunk"...
167 -- Imported things which we do know something about use
168 -- one of the other LF constructors (eg LFReEntrant for
170 !Bool -- True <=> *might* be a function type
172 | LFLetNoEscape -- See LetNoEscape module for precise description of
176 | LFBlackHole -- Used for the closures allocated to hold the result
177 -- of a CAF. We want the target of the update frame to
178 -- be in the heap, so we make a black hole to hold it.
179 CLabel -- Flavour (info label, eg CAF_BLACKHOLE_info).
182 data StandardFormInfo -- Tells whether this thunk has one of a small number
185 = NonStandardThunk -- No, it isn't
188 Int -- 0-origin offset of ak within the "goods" of
189 -- constructor (Recall that the a1,...,an may be laid
190 -- out in the heap in a non-obvious order.)
192 {- A SelectorThunk is of form
197 and the constructor is from a single-constr type.
203 {- An ApThunk is of form
207 The code for the thunk just pushes x2..xn on the stack and enters x1.
208 There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
209 in the RTS to save space.
214 %************************************************************************
216 \subsection[ClosureInfo-construction]{Functions which build LFInfos}
218 %************************************************************************
220 @mkClosureLFInfo@ figures out the appropriate LFInfo for the closure.
223 mkClosureLFInfo :: Id -- The binder
224 -> TopLevelFlag -- True of top level
226 -> UpdateFlag -- Update flag
230 mkClosureLFInfo bndr top fvs upd_flag args@(_:_) -- Non-empty args
231 = LFReEntrant top (length args) (null fvs) (mkArgDescr (getName bndr) args)
233 mkClosureLFInfo bndr top fvs upd_flag []
234 = ASSERT( not updatable || not (isUnLiftedType id_ty) )
235 LFThunk top (null fvs) updatable NonStandardThunk
236 (might_be_a_function id_ty)
238 updatable = isUpdatable upd_flag
241 might_be_a_function :: Type -> Bool
242 might_be_a_function ty
243 | Just (tc,_) <- splitTyConApp_maybe (repType ty),
244 not (isFunTyCon tc) = False
248 @mkConLFInfo@ is similar, for constructors.
251 mkConLFInfo :: DataCon -> LambdaFormInfo
252 mkConLFInfo con = LFCon con
254 mkSelectorLFInfo id offset updatable
255 = LFThunk NotTopLevel False updatable (SelectorThunk offset)
256 (might_be_a_function (idType id))
258 mkApLFInfo id upd_flag arity
259 = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)
260 (might_be_a_function (idType id))
263 Miscellaneous LF-infos.
266 mkLFArgument id = LFUnknown (might_be_a_function (idType id))
268 mkLFLetNoEscape = LFLetNoEscape
270 mkLFImported :: Id -> LambdaFormInfo
273 n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr") -- n > 0
274 other -> mkLFArgument id -- Not sure of exact arity
277 %************************************************************************
279 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
281 %************************************************************************
284 closureSize :: ClosureInfo -> HeapOffset
285 closureSize cl_info = fixedHdrSize + closureNonHdrSize cl_info
287 closureNonHdrSize :: ClosureInfo -> Int
288 closureNonHdrSize cl_info
289 = tot_wds + computeSlopSize tot_wds
290 (closureSMRep cl_info)
291 (closureNeedsUpdSpace cl_info)
293 tot_wds = closureGoodStuffSize cl_info
295 -- we leave space for an update if either (a) the closure is updatable
296 -- or (b) it is a static thunk. This is because a static thunk needs
297 -- a static link field in a predictable place (after the slop), regardless
298 -- of whether it is updatable or not.
299 closureNeedsUpdSpace (ClosureInfo { closureLFInfo =
300 LFThunk TopLevel _ _ _ _ }) = True
301 closureNeedsUpdSpace cl_info = closureUpdReqd cl_info
303 slopSize :: ClosureInfo -> Int
305 = computeSlopSize (closureGoodStuffSize cl_info)
306 (closureSMRep cl_info)
307 (closureNeedsUpdSpace cl_info)
309 closureGoodStuffSize :: ClosureInfo -> Int
310 closureGoodStuffSize cl_info
311 = let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info)
314 closurePtrsSize :: ClosureInfo -> Int
315 closurePtrsSize cl_info
316 = let (ptrs, _) = sizes_from_SMRep (closureSMRep cl_info)
320 sizes_from_SMRep :: SMRep -> (Int,Int)
321 sizes_from_SMRep (GenericRep _ ptrs nonptrs _) = (ptrs, nonptrs)
322 sizes_from_SMRep BlackHoleRep = (0, 0)
325 Computing slop size. WARNING: this looks dodgy --- it has deep
326 knowledge of what the storage manager does with the various
332 Updateable closures must be @mIN_UPD_SIZE@.
335 Indirections require 1 word
337 Appels collector indirections 2 words
339 THEREFORE: @mIN_UPD_SIZE = 2@.
342 Collectable closures which are allocated in the heap
343 must be @mIN_SIZE_NonUpdHeapObject@.
345 Copying collector forward pointer requires 1 word
347 THEREFORE: @mIN_SIZE_NonUpdHeapObject = 1@
350 Static closures have an extra ``static link field'' at the end, but we
351 don't bother taking that into account here.
354 computeSlopSize :: Int -> SMRep -> Bool -> Int
356 computeSlopSize tot_wds (GenericRep _ _ _ _) True -- Updatable
357 = max 0 (mIN_UPD_SIZE - tot_wds)
359 computeSlopSize tot_wds (GenericRep True _ _ _) False -- Non updatable
362 computeSlopSize tot_wds (GenericRep False _ _ _) False -- Non updatable
363 = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds) -- Dynamic
365 computeSlopSize tot_wds BlackHoleRep _ -- Updatable
366 = max 0 (mIN_UPD_SIZE - tot_wds)
369 %************************************************************************
371 \subsection[layOutDynClosure]{Lay out a closure}
373 %************************************************************************
376 layOutDynClosure, layOutStaticClosure
377 :: Id -- STG identifier of this closure
378 -> (a -> PrimRep) -- how to get a PrimRep for the fields
379 -> [a] -- the "things" being layed out
380 -> LambdaFormInfo -- what sort of closure it is
382 -> String -- closure description
383 -> (ClosureInfo, -- info about the closure
384 [(a, VirtualHeapOffset)]) -- things w/ offsets pinned on them
386 layOutDynClosure = layOutClosure False
387 layOutStaticClosure = layOutClosure True
389 layOutStaticNoFVClosure id lf_info srt_info descr
390 = fst (layOutClosure True id (panic "kind_fn") [] lf_info srt_info descr)
393 :: Bool -- True <=> static closure
394 -> Id -- STG identifier of this closure
395 -> (a -> PrimRep) -- how to get a PrimRep for the fields
396 -> [a] -- the "things" being layed out
397 -> LambdaFormInfo -- what sort of closure it is
399 -> String -- closure description
400 -> (ClosureInfo, -- info about the closure
401 [(a, VirtualHeapOffset)]) -- things w/ offsets pinned on them
403 layOutClosure is_static id kind_fn things lf_info srt_info descr
404 = (ClosureInfo { closureName = name,
405 closureLFInfo = lf_info,
406 closureSMRep = sm_rep,
407 closureSRT = srt_info,
408 closureType = idType id,
409 closureDescr = descr },
413 (tot_wds, -- #ptr_wds + #nonptr_wds
415 things_w_offsets) = mkVirtHeapOffsets kind_fn things
416 sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds
419 layOutDynConstr, layOutStaticConstr
424 [(a,VirtualHeapOffset)])
426 layOutDynConstr = layOutConstr False
427 layOutStaticConstr = layOutConstr True
429 layOutConstr is_static data_con kind_fn args
430 = (ConInfo { closureSMRep = sm_rep,
431 closureCon = data_con },
434 (tot_wds, -- #ptr_wds + #nonptr_wds
436 things_w_offsets) = mkVirtHeapOffsets kind_fn args
437 sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds
440 %************************************************************************
442 \subsection[mkStaticClosure]{Make a static closure}
444 %************************************************************************
446 Make a static closure, adding on any extra padding needed for CAFs,
447 and adding a static link field if necessary.
450 mkStaticClosure lbl cl_info ccs fields cafrefs
451 | opt_SccProfilingOn =
455 (mkCCostCentreStack ccs)
465 all_fields = fields ++ padding_wds ++ static_link_field
467 upd_reqd = closureUpdReqd cl_info
469 -- for the purposes of laying out the static closure, we consider all
470 -- thunks to be "updatable", so that the static link field is always
471 -- in the same place.
474 | otherwise = replicate n (mkIntCLit 0) -- a bunch of 0s
475 where n = max 0 (mIN_UPD_SIZE - length fields)
477 -- We always have a static link field for a thunk, it's used to
478 -- save the closure's info pointer when we're reverting CAFs
479 -- (see comment in Storage.c)
481 | upd_reqd || staticClosureNeedsLink cl_info = [static_link_value]
484 -- for a static constructor which has NoCafRefs, we set the
485 -- static link field to a non-zero value so the garbage
486 -- collector will ignore it.
488 | cafrefs = mkIntCLit 0
489 | otherwise = mkIntCLit 1
492 %************************************************************************
494 \subsection[SMreps]{Choosing SM reps}
496 %************************************************************************
500 :: Bool -- True <=> static closure
502 -> Int -> Int -- Tot wds, ptr wds
505 chooseSMRep is_static lf_info tot_wds ptr_wds
507 nonptr_wds = tot_wds - ptr_wds
508 closure_type = getClosureType is_static tot_wds ptr_wds lf_info
510 GenericRep is_static ptr_wds nonptr_wds closure_type
512 -- we *do* get non-updatable top-level thunks sometimes. eg. f = g
513 -- gets compiled to a jump to g (if g has non-zero arity), instead of
514 -- messing around with update frames and PAPs. We set the closure type
515 -- to FUN_STATIC in this case.
517 getClosureType :: Bool -> Int -> Int -> LambdaFormInfo -> ClosureType
518 getClosureType is_static tot_wds ptr_wds lf_info
520 LFCon con | is_static && ptr_wds == 0 -> ConstrNoCaf
521 | otherwise -> Constr
522 LFReEntrant _ _ _ _ -> Fun
523 LFThunk _ _ _ (SelectorThunk _) _ -> ThunkSelector
524 LFThunk _ _ _ _ _ -> Thunk
525 _ -> panic "getClosureType"
528 %************************************************************************
530 \subsection[mkVirtHeapOffsets]{Assigning heap offsets in a closure}
532 %************************************************************************
534 @mkVirtHeapOffsets@ (the heap version) always returns boxed things with
535 smaller offsets than the unboxed things, and furthermore, the offsets in
540 (a -> PrimRep) -- To be able to grab kinds;
541 -- w/ a kind, we can find boxedness
542 -> [a] -- Things to make offsets for
543 -> (Int, -- *Total* number of words allocated
544 Int, -- Number of words allocated for *pointers*
545 [(a, VirtualHeapOffset)])
546 -- Things with their offsets from start of
547 -- object in order of increasing offset
549 -- First in list gets lowest offset, which is initial offset + 1.
551 mkVirtHeapOffsets kind_fun things
552 = let (ptrs, non_ptrs) = separateByPtrFollowness kind_fun things
553 (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
554 (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
556 (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
558 computeOffset wds_so_far thing
559 = (wds_so_far + (getPrimRepSize . kind_fun) thing,
560 (thing, fixedHdrSize + wds_so_far)
564 %************************************************************************
566 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
568 %************************************************************************
570 Be sure to see the stg-details notes about these...
573 nodeMustPointToIt :: LambdaFormInfo -> FCode Bool
574 nodeMustPointToIt lf_info
577 LFReEntrant top _ no_fvs _ -> returnFC (
578 not no_fvs || -- Certainly if it has fvs we need to point to it
580 -- If it is not top level we will point to it
581 -- We can have a \r closure with no_fvs which
582 -- is not top level as special case cgRhsClosure
583 -- has been dissabled in favour of let floating
585 -- For lex_profiling we also access the cost centre for a
586 -- non-inherited function i.e. not top level
587 -- the not top case above ensures this is ok.
590 LFCon _ -> returnFC True
592 -- Strictly speaking, the above two don't need Node to point
593 -- to it if the arity = 0. But this is a *really* unlikely
594 -- situation. If we know it's nil (say) and we are entering
595 -- it. Eg: let x = [] in x then we will certainly have inlined
596 -- x, since nil is a simple atom. So we gain little by not
597 -- having Node point to known zero-arity things. On the other
598 -- hand, we do lose something; Patrick's code for figuring out
599 -- when something has been updated but not entered relies on
600 -- having Node point to the result of an update. SLPJ
603 LFThunk _ no_fvs updatable NonStandardThunk _
604 -> returnFC (updatable || not no_fvs || opt_SccProfilingOn)
606 -- For the non-updatable (single-entry case):
608 -- True if has fvs (in which case we need access to them, and we
609 -- should black-hole it)
610 -- or profiling (in which case we need to recover the cost centre
613 LFThunk _ no_fvs updatable some_standard_form_thunk _
615 -- Node must point to any standard-form thunk.
617 LFUnknown _ -> returnFC True
618 LFBlackHole _ -> returnFC True
619 -- BH entry may require Node to point
621 LFLetNoEscape _ -> returnFC False
624 The entry conventions depend on the type of closure being entered,
625 whether or not it has free variables, and whether we're running
626 sequentially or in parallel.
628 \begin{tabular}{lllll}
629 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
630 Unknown & no & yes & stack & node \\
631 Known fun ($\ge$ 1 arg), no fvs & no & no & registers & fast entry (enough args) \\
632 \ & \ & \ & \ & slow entry (otherwise) \\
633 Known fun ($\ge$ 1 arg), fvs & no & yes & registers & fast entry (enough args) \\
634 0 arg, no fvs @\r,\s@ & no & no & n/a & direct entry \\
635 0 arg, no fvs @\u@ & no & yes & n/a & node \\
636 0 arg, fvs @\r,\s@ & no & yes & n/a & direct entry \\
637 0 arg, fvs @\u@ & no & yes & n/a & node \\
639 Unknown & yes & yes & stack & node \\
640 Known fun ($\ge$ 1 arg), no fvs & yes & no & registers & fast entry (enough args) \\
641 \ & \ & \ & \ & slow entry (otherwise) \\
642 Known fun ($\ge$ 1 arg), fvs & yes & yes & registers & node \\
643 0 arg, no fvs @\r,\s@ & yes & no & n/a & direct entry \\
644 0 arg, no fvs @\u@ & yes & yes & n/a & node \\
645 0 arg, fvs @\r,\s@ & yes & yes & n/a & node \\
646 0 arg, fvs @\u@ & yes & yes & n/a & node\\
649 When black-holing, single-entry closures could also be entered via node
650 (rather than directly) to catch double-entry.
653 data CallingConvention
654 = EnterIt -- no args, not a function
656 | JumpToIt CLabel -- no args, not a function, but we
657 -- know what its entry code is
659 | ReturnIt -- it's a function, but we have
660 -- zero args to apply to it, so just
663 | SlowCall -- Unknown fun, or known fun with
666 | DirectEntry -- Jump directly, with args in regs
667 CLabel -- The code label
669 [MagicId] -- Its register assignments
672 getEntryConvention :: Name -- Function being applied
673 -> LambdaFormInfo -- Its info
674 -> [PrimRep] -- Available arguments
675 -> FCode CallingConvention
677 getEntryConvention name lf_info arg_kinds
678 = nodeMustPointToIt lf_info `thenFC` \ node_points ->
681 -- if we're parallel, then we must always enter via node. The reason
682 -- is that the closure may have been fetched since we allocated it.
684 if (node_points && opt_Parallel) then EnterIt else
686 -- Commented out by SDM after futher thoughts:
687 -- - the only closure type that can be blackholed is a thunk
688 -- - we already enter thunks via node (unless the closure is
689 -- non-updatable, in which case why is it being re-entered...)
693 LFReEntrant _ arity _ _ ->
694 if null arg_kinds then
696 EnterIt -- a non-updatable thunk
698 ReturnIt -- no args at all
699 else if listLengthCmp arg_kinds arity == LT then
700 SlowCall -- not enough args
702 DirectEntry (mkEntryLabel name) arity arg_regs
704 (arg_regs, _) = assignRegs [node] (take arity arg_kinds)
705 -- we don't use node to pass args now (SDM)
708 | isNullaryDataCon con
709 -- a real constructor. Don't bother entering it, just jump
710 -- to the constructor entry code directly.
711 -> --false:ASSERT (null arg_kinds)
712 -- Should have no args (meaning what?)
713 JumpToIt (mkStaticConEntryLabel (dataConName con))
715 | otherwise {- not nullary -}
716 -> --false:ASSERT (null arg_kinds)
717 -- Should have no args (meaning what?)
718 JumpToIt (mkConEntryLabel (dataConName con))
720 LFThunk _ _ updatable std_form_info is_fun
721 -- must always "call" a function-typed thing, cannot just enter it
723 | updatable || opt_DoTickyProfiling -- to catch double entry
724 || opt_SMP -- always enter via node on SMP, since the
725 -- thunk might have been blackholed in the
727 -> ASSERT(null arg_kinds) EnterIt
729 -> ASSERT(null arg_kinds)
730 JumpToIt (thunkEntryLabel name std_form_info updatable)
732 LFUnknown True -> SlowCall -- might be a function
733 LFUnknown False -> ASSERT2 (null arg_kinds, ppr name <+> ppr arg_kinds) EnterIt -- not a function
735 LFBlackHole _ -> SlowCall -- Presumably the black hole has by now
736 -- been updated, but we don't know with
737 -- what, so we slow call it
740 -> JumpToIt (mkReturnPtLabel (nameUnique name))
743 -> if (not (arg_kinds `lengthIs` arity)) then pprPanic "let-no-escape: " (ppr name <+> ppr arity) else
744 DirectEntry (mkReturnPtLabel (nameUnique name)) arity arg_regs
746 (arg_regs, _) = assignRegs [] arg_kinds
747 -- node never points to a LetNoEscape, see above --SDM
748 --live_regs = if node_points then [node] else []
751 blackHoleOnEntry :: ClosureInfo -> Bool
753 -- Static closures are never themselves black-holed.
754 -- Updatable ones will be overwritten with a CAFList cell, which points to a
756 -- Single-entry ones have no fvs to plug, and we trust they don't form part
759 blackHoleOnEntry ConInfo{} = False
760 blackHoleOnEntry (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
762 = False -- Never black-hole a static closure
766 LFReEntrant _ _ _ _ -> False
767 LFLetNoEscape _ -> False
768 LFThunk _ no_fvs updatable _ _
770 then not opt_OmitBlackHoling
771 else opt_DoTickyProfiling || not no_fvs
772 -- the former to catch double entry,
773 -- and the latter to plug space-leaks. KSW/SDM 1999-04.
775 other -> panic "blackHoleOnEntry" -- Should never happen
777 isStandardFormThunk :: LambdaFormInfo -> Bool
779 isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
780 isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _) = True
781 isStandardFormThunk other_lf_info = False
785 -----------------------------------------------------------------------------
789 staticClosureNeedsLink :: ClosureInfo -> Bool
790 -- A static closure needs a link field to aid the GC when traversing
791 -- the static closure graph. But it only needs such a field if either
793 -- b) it's a constructor with one or more pointer fields
794 -- In case (b), the constructor's fields themselves play the role
796 staticClosureNeedsLink (ClosureInfo { closureSRT = srt })
798 staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })
799 = not (isNullaryDataCon con) && not_nocaf_constr
803 GenericRep _ _ _ ConstrNoCaf -> False
807 Avoiding generating entries and info tables
808 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
809 At present, for every function we generate all of the following,
810 just in case. But they aren't always all needed, as noted below:
812 [NB1: all of this applies only to *functions*. Thunks always
813 have closure, info table, and entry code.]
815 [NB2: All are needed if the function is *exported*, just to play safe.]
818 * Fast-entry code ALWAYS NEEDED
821 Needed iff (a) we have any un-saturated calls to the function
822 OR (b) the function is passed as an arg
823 OR (c) we're in the parallel world and the function has free vars
824 [Reason: in parallel world, we always enter functions
825 with free vars via the closure.]
827 * The function closure
828 Needed iff (a) we have any un-saturated calls to the function
829 OR (b) the function is passed as an arg
830 OR (c) if the function has free vars (ie not top level)
832 Why case (a) here? Because if the arg-satis check fails,
833 UpdatePAP stuffs a pointer to the function closure in the PAP.
834 [Could be changed; UpdatePAP could stuff in a code ptr instead,
835 but doesn't seem worth it.]
837 [NB: these conditions imply that we might need the closure
838 without the slow-entry code. Here's how.
840 f x y = let g w = ...x..y..w...
844 Here we need a closure for g which contains x and y,
845 but since the calls are all saturated we just jump to the
846 fast entry point for g, with R1 pointing to the closure for g.]
849 * Standard info table
850 Needed iff (a) we have any un-saturated calls to the function
851 OR (b) the function is passed as an arg
852 OR (c) the function has free vars (ie not top level)
854 NB. In the sequential world, (c) is only required so that the function closure has
855 an info table to point to, to keep the storage manager happy.
856 If (c) alone is true we could fake up an info table by choosing
857 one of a standard family of info tables, whose entry code just
860 [NB In the parallel world (c) is needed regardless because
861 we enter functions with free vars via the closure.]
863 If (c) is retained, then we'll sometimes generate an info table
864 (for storage mgr purposes) without slow-entry code. Then we need
865 to use an error label in the info table to substitute for the absent
869 staticClosureRequired
874 staticClosureRequired binder bndr_info
875 (LFReEntrant top_level _ _ _) -- It's a function
876 = ASSERT( isTopLevel top_level )
877 -- Assumption: it's a top-level, no-free-var binding
878 not (satCallsOnly bndr_info)
880 staticClosureRequired binder other_binder_info other_lf_info = True
883 %************************************************************************
885 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
887 %************************************************************************
891 isStaticClosure :: ClosureInfo -> Bool
892 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
894 closureUpdReqd :: ClosureInfo -> Bool
895 closureUpdReqd (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _ }) = upd
896 closureUpdReqd (ClosureInfo { closureLFInfo = LFBlackHole _ }) = True
897 -- Black-hole closures are allocated to receive the results of an
898 -- alg case with a named default... so they need to be updated.
899 closureUpdReqd other_closure = False
901 closureSingleEntry :: ClosureInfo -> Bool
902 closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
903 closureSingleEntry other_closure = False
905 closureReEntrant :: ClosureInfo -> Bool
906 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
907 closureReEntrant other_closure = False
909 closureSemiTag :: ClosureInfo -> Maybe Int
910 closureSemiTag (ConInfo { closureCon = data_con })
911 = Just (dataConTag data_con - fIRST_TAG)
912 closureSemiTag _ = Nothing
914 closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
915 closureFunInfo (ClosureInfo { closureLFInfo = LFReEntrant _ arity _ arg_desc})
916 = Just (arity, arg_desc)
922 isToplevClosure :: ClosureInfo -> Bool
923 isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
925 LFReEntrant TopLevel _ _ _ -> True
926 LFThunk TopLevel _ _ _ _ -> True
928 isToplevClosure _ = False
934 infoTableLabelFromCI :: ClosureInfo -> CLabel
935 infoTableLabelFromCI (ClosureInfo { closureName = name,
936 closureLFInfo = lf_info,
937 closureSMRep = rep })
939 LFBlackHole info -> info
941 LFThunk _ _ upd_flag (SelectorThunk offset) _ ->
942 mkSelectorInfoLabel upd_flag offset
944 LFThunk _ _ upd_flag (ApThunk arity) _ ->
945 mkApInfoTableLabel upd_flag arity
947 LFThunk{} -> mkInfoTableLabel name
949 LFReEntrant _ _ _ (ArgGen _ _) -> mkInfoTableLabel name
950 LFReEntrant _ _ _ _ -> mkInfoTableLabel name
952 other -> panic "infoTableLabelFromCI"
954 infoTableLabelFromCI (ConInfo { closureCon = con, closureSMRep = rep })
955 = mkConInfoPtr con rep
958 mkConInfoPtr :: DataCon -> SMRep -> CLabel
960 | isStaticRep rep = mkStaticInfoTableLabel name
961 | otherwise = mkConInfoTableLabel name
963 name = dataConName con
965 mkConEntryPtr :: DataCon -> SMRep -> CLabel
966 mkConEntryPtr con rep
967 | isStaticRep rep = mkStaticConEntryLabel (dataConName con)
968 | otherwise = mkConEntryLabel (dataConName con)
970 closureLabelFromCI (ClosureInfo { closureName = nm }) = mkClosureLabel nm
971 closureLabelFromCI _ = panic "closureLabelFromCI"
973 entryLabelFromCI :: ClosureInfo -> CLabel
974 entryLabelFromCI (ClosureInfo { closureName = id,
975 closureLFInfo = lf_info,
976 closureSMRep = rep })
978 LFThunk _ _ upd_flag std_form_info _ ->
979 thunkEntryLabel id std_form_info upd_flag
980 other -> mkEntryLabel id
982 entryLabelFromCI (ConInfo { closureCon = con, closureSMRep = rep })
983 = mkConEntryPtr con rep
986 -- thunkEntryLabel is a local help function, not exported. It's used from both
987 -- entryLabelFromCI and getEntryConvention.
989 thunkEntryLabel thunk_id (ApThunk arity) is_updatable
990 = mkApEntryLabel is_updatable arity
991 thunkEntryLabel thunk_id (SelectorThunk offset) upd_flag
992 = mkSelectorEntryLabel upd_flag offset
993 thunkEntryLabel thunk_id _ is_updatable
994 = mkEntryLabel thunk_id
998 allocProfilingMsg :: ClosureInfo -> FastString
999 allocProfilingMsg ConInfo{} = FSLIT("TICK_ALLOC_CON")
1000 allocProfilingMsg ClosureInfo{ closureLFInfo = lf_info }
1002 LFReEntrant _ _ _ _ -> FSLIT("TICK_ALLOC_FUN")
1003 LFThunk _ _ True _ _ -> FSLIT("TICK_ALLOC_UP_THK") -- updatable
1004 LFThunk _ _ False _ _ -> FSLIT("TICK_ALLOC_SE_THK") -- nonupdatable
1005 LFBlackHole _ -> FSLIT("TICK_ALLOC_BH")
1006 _ -> panic "allocProfilingMsg"
1009 We need a black-hole closure info to pass to @allocDynClosure@ when we
1010 want to allocate the black hole on entry to a CAF. These are the only
1011 ways to build an LFBlackHole, maintaining the invariant that it really
1012 is a black hole and not something else.
1015 cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
1017 = ClosureInfo { closureName = nm,
1018 closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel,
1019 closureSMRep = BlackHoleRep,
1020 closureSRT = NoC_SRT,
1023 cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
1025 seCafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
1027 = ClosureInfo { closureName = nm,
1028 closureLFInfo = LFBlackHole mkSECAFBlackHoleInfoTableLabel,
1029 closureSMRep = BlackHoleRep,
1030 closureSRT = NoC_SRT,
1033 seCafBlackHoleClosureInfo _ = panic "seCafBlackHoleClosureInfo"
1036 %************************************************************************
1038 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
1040 %************************************************************************
1042 Profiling requires two pieces of information to be determined for
1043 each closure's info table --- description and type.
1045 The description is stored directly in the @CClosureInfoTable@ when the
1046 info table is built.
1048 The type is determined from the type information stored with the @Id@
1049 in the closure info using @closureTypeDescr@.
1052 closureTypeDescr :: ClosureInfo -> String
1053 closureTypeDescr (ClosureInfo { closureType = ty })
1054 = getTyDescription ty
1055 closureTypeDescr (ConInfo { closureCon = data_con })
1056 = occNameUserString (getOccName (dataConTyCon data_con))
1059 %************************************************************************
1061 \subsection{Making argument bitmaps}
1063 %************************************************************************
1066 -- bring in ARG_P, ARG_N, etc.
1067 #include "../includes/StgFun.h"
1071 !Int -- ARG_P, ARG_N, ...
1073 CLabel -- label for a slow-entry point
1074 Liveness -- the arg bitmap: describes pointedness of arguments
1076 mkArgDescr :: Name -> [Id] -> ArgDescr
1077 mkArgDescr nm args = argDescr nm (filter nonVoidRep (map idPrimRep args))
1078 where nonVoidRep VoidRep = False
1081 argDescr nm [PtrRep] = ArgSpec ARG_P
1082 argDescr nm [FloatRep] = ArgSpec ARG_F
1083 argDescr nm [DoubleRep] = ArgSpec ARG_D
1084 argDescr nm [r] | is64BitRep r = ArgSpec ARG_L
1085 argDescr nm [r] | isNonPtrRep r = ArgSpec ARG_N
1087 argDescr nm [r1,r2] | isNonPtrRep r1 && isNonPtrRep r2 = ArgSpec ARG_NN
1088 argDescr nm [r1,PtrRep] | isNonPtrRep r1 = ArgSpec ARG_NP
1089 argDescr nm [PtrRep,r1] | isNonPtrRep r1 = ArgSpec ARG_PN
1090 argDescr nm [PtrRep,PtrRep] = ArgSpec ARG_PP
1092 argDescr nm [r1,r2,r3] | isNonPtrRep r1 && isNonPtrRep r2 && isNonPtrRep r3 = ArgSpec ARG_NNN
1093 argDescr nm [r1,r2,PtrRep] | isNonPtrRep r1 && isNonPtrRep r2 = ArgSpec ARG_NNP
1094 argDescr nm [r1,PtrRep,r2] | isNonPtrRep r1 && isNonPtrRep r2 = ArgSpec ARG_NPN
1095 argDescr nm [r1,PtrRep,PtrRep] | isNonPtrRep r1 = ArgSpec ARG_NPP
1096 argDescr nm [PtrRep,r1,r2] | isNonPtrRep r1 && isNonPtrRep r2 = ArgSpec ARG_PNN
1097 argDescr nm [PtrRep,r1,PtrRep] | isNonPtrRep r1 = ArgSpec ARG_PNP
1098 argDescr nm [PtrRep,PtrRep,r1] | isNonPtrRep r1 = ArgSpec ARG_PPN
1099 argDescr nm [PtrRep,PtrRep,PtrRep] = ArgSpec ARG_PPP
1101 argDescr nm [PtrRep,PtrRep,PtrRep,PtrRep] = ArgSpec ARG_PPPP
1102 argDescr nm [PtrRep,PtrRep,PtrRep,PtrRep,PtrRep] = ArgSpec ARG_PPPPP
1103 argDescr nm [PtrRep,PtrRep,PtrRep,PtrRep,PtrRep,PtrRep] = ArgSpec ARG_PPPPPP
1105 argDescr name reps = ArgGen (mkSlowEntryLabel name) liveness
1106 where bitmap = argBits reps
1107 lbl = mkBitmapLabel name
1108 liveness = Liveness lbl (length bitmap) (mkBitmap bitmap)
1111 argBits (rep : args)
1112 | isFollowableRep rep = False : argBits args
1113 | otherwise = take (getPrimRepSize rep) (repeat True) ++ argBits args
1117 %************************************************************************
1119 \subsection{Generating info tables}
1121 %************************************************************************
1123 Here we make a concrete info table, represented as a list of CAddrMode
1124 (it can't be simply a list of Word, because the SRT field is
1125 represented by a label+offset expression).
1128 mkInfoTable :: ClosureInfo -> [CAddrMode]
1130 | opt_Unregisterised = std_info ++ extra_bits
1131 | otherwise = extra_bits ++ std_info
1133 std_info = mkStdInfoTable entry_amode
1134 ty_descr_amode cl_descr_amode cl_type srt_len layout_amode
1136 entry_amode = CLbl (entryLabelFromCI cl_info) CodePtrRep
1140 ClosureInfo { closureDescr = descr } -> descr
1141 ConInfo { closureCon = con } -> occNameUserString (getOccName con)
1143 ty_descr_amode = CLit (MachStr (mkFastString (closureTypeDescr cl_info)))
1144 cl_descr_amode = CLit (MachStr (mkFastString closure_descr))
1146 cl_type = getSMRepClosureTypeInt (closureSMRep cl_info)
1148 srt = closureSRT cl_info
1149 needs_srt = needsSRT srt
1151 semi_tag = closureSemiTag cl_info
1152 is_con = isJust semi_tag
1155 | Just tag <- semi_tag = (mkIntCLit 0, fromIntegral tag) -- constructor
1158 NoC_SRT -> (mkIntCLit 0, 0)
1159 C_SRT lbl off bitmap ->
1160 (CAddr (CIndex (CLbl lbl DataPtrRep) (mkIntCLit off) WordRep),
1163 ptrs = closurePtrsSize cl_info
1165 size = closureNonHdrSize cl_info
1167 layout_info :: StgWord
1168 #ifdef WORDS_BIGENDIAN
1169 layout_info = (fromIntegral ptrs `shiftL` hALF_WORD) .|. fromIntegral nptrs
1171 layout_info = (fromIntegral ptrs) .|. (fromIntegral nptrs `shiftL` hALF_WORD)
1174 layout_amode = mkWordCLit layout_info
1177 | is_fun = fun_extra_bits
1179 | needs_srt = [srt_label]
1182 maybe_fun_stuff = closureFunInfo cl_info
1183 is_fun = isJust maybe_fun_stuff
1184 (Just (arity, arg_descr)) = maybe_fun_stuff
1187 | opt_Unregisterised = reverse reg_fun_extra_bits
1188 | otherwise = reg_fun_extra_bits
1191 | ArgGen slow_lbl liveness <- arg_descr
1193 CLbl slow_lbl CodePtrRep,
1194 livenessToAddrMode liveness,
1198 | needs_srt = [srt_label, fun_amode]
1199 | otherwise = [fun_amode]
1201 #ifdef WORDS_BIGENDIAN
1202 fun_desc = (fromIntegral fun_type `shiftL` hALF_WORD) .|. fromIntegral arity
1204 fun_desc = (fromIntegral fun_type) .|. (fromIntegral arity `shiftL` hALF_WORD)
1207 fun_amode = mkWordCLit fun_desc
1209 fun_type = case arg_descr of
1211 ArgGen _ (Liveness _ size _)
1212 | size <= mAX_SMALL_BITMAP_SIZE -> ARG_GEN
1213 | otherwise -> ARG_GEN_BIG
1215 -- Return info tables come in two flavours: direct returns and
1216 -- vectored returns.
1218 mkRetInfoTable :: CLabel -> C_SRT -> Liveness -> [CAddrMode]
1219 mkRetInfoTable entry_lbl srt liveness
1220 = mkBitmapInfoTable (CLbl entry_lbl CodePtrRep) srt liveness []
1222 mkVecInfoTable :: [CAddrMode] -> C_SRT -> Liveness -> [CAddrMode]
1223 mkVecInfoTable vector srt liveness
1224 = mkBitmapInfoTable zero_amode srt liveness vector
1228 -> C_SRT -> Liveness
1231 mkBitmapInfoTable entry_amode srt liveness vector
1232 | opt_Unregisterised = std_info ++ extra_bits
1233 | otherwise = extra_bits ++ std_info
1235 std_info = mkStdInfoTable entry_amode zero_amode zero_amode
1236 cl_type srt_len liveness_amode
1238 liveness_amode = livenessToAddrMode liveness
1240 (srt_label,srt_len) =
1242 NoC_SRT -> (mkIntCLit 0, 0)
1243 C_SRT lbl off bitmap ->
1244 (CAddr (CIndex (CLbl lbl DataPtrRep) (mkIntCLit off) WordRep),
1247 cl_type = case (null vector, isBigLiveness liveness) of
1248 (True, True) -> rET_BIG
1249 (True, False) -> rET_SMALL
1250 (False, True) -> rET_VEC_BIG
1251 (False, False) -> rET_VEC_SMALL
1253 srt_bit | needsSRT srt || not (null vector) = [srt_label]
1256 extra_bits | opt_Unregisterised = srt_bit ++ vector
1257 | otherwise = reverse vector ++ srt_bit
1259 -- The standard bits of an info table. This part of the info table
1260 -- corresponds to the StgInfoTable type defined in InfoTables.h.
1263 :: CAddrMode -- entry label
1264 -> CAddrMode -- closure type descr (profiling)
1265 -> CAddrMode -- closure descr (profiling)
1266 -> Int -- closure type
1267 -> StgHalfWord -- SRT length
1268 -> CAddrMode -- layout field
1270 mkStdInfoTable entry_lbl type_descr closure_descr cl_type srt_len layout_amode
1274 | opt_Unregisterised = entry_lbl : std_info'
1275 | otherwise = std_info'
1283 CLit (MachWord (fromIntegral type_info)) :
1287 | opt_SccProfilingOn = [ type_descr, closure_descr ]
1290 -- sigh: building up the info table is endian-dependent.
1291 -- ToDo: do this using .byte and .word directives.
1292 type_info :: StgWord
1293 #ifdef WORDS_BIGENDIAN
1294 type_info = (fromIntegral cl_type `shiftL` hALF_WORD) .|.
1295 (fromIntegral srt_len)
1297 type_info = (fromIntegral cl_type) .|.
1298 (fromIntegral srt_len `shiftL` hALF_WORD)
1301 isBigLiveness (Liveness _ size _) = size > mAX_SMALL_BITMAP_SIZE
1303 livenessToAddrMode :: Liveness -> CAddrMode
1304 livenessToAddrMode (Liveness lbl size bits)
1305 | size <= mAX_SMALL_BITMAP_SIZE = small
1306 | otherwise = CLbl lbl DataPtrRep
1308 small = mkWordCLit (fromIntegral size .|. (small_bits `shiftL` bITMAP_BITS_SHIFT))
1309 small_bits = case bits of
1311 [b] -> fromIntegral b
1312 _ -> panic "livenessToAddrMode"
1314 zero_amode = mkIntCLit 0