2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: ClosureInfo.lhs,v 1.59 2003/10/09 11:58:46 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
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 )
93 import TypeRep -- TEMP
96 %************************************************************************
98 \subsection[ClosureInfo-datatypes]{Data types for closure information}
100 %************************************************************************
102 Information about a closure, from the code generator's point of view.
104 A ClosureInfo decribes the info pointer of a closure. It has
106 a) to construct the info table itself
107 b) to allocate a closure containing that info pointer (i.e.
108 it knows the info table label)
110 We make a ClosureInfo for
111 - each let binding (both top level and not)
112 - each data constructor (for its shared static and
118 closureName :: !Name, -- The thing bound to this closure
119 closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon (see below)
120 closureSMRep :: !SMRep, -- representation used by storage mgr
121 closureSRT :: !C_SRT, -- What SRT applies to this closure
122 closureType :: !Type, -- Type of closure (ToDo: remove)
123 closureDescr :: !String -- closure description (for profiling)
126 -- constructor closures don't have a unique info table label (they use
127 -- the constructor's info table), and they don't have an SRT.
129 closureCon :: !DataCon,
130 closureSMRep :: !SMRep
134 %************************************************************************
136 \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
138 %************************************************************************
140 Information about an identifier, from the code generator's point of
141 view. Every identifier is bound to a LambdaFormInfo in the
142 environment, which gives the code generator enough info to be able to
143 tail call or return that identifier.
145 Note that a closure is usually bound to an identifier, so a
146 ClosureInfo contains a LambdaFormInfo.
150 = LFReEntrant -- Reentrant closure (a function)
151 TopLevelFlag -- True if top level
153 !Bool -- True <=> no fvs
154 ArgDescr -- Argument descriptor (should reall be in ClosureInfo)
156 | LFCon -- Constructor
157 DataCon -- The constructor
159 | LFThunk -- Thunk (zero arity)
161 !Bool -- True <=> no free vars
162 !Bool -- True <=> updatable (i.e., *not* single-entry)
164 !Bool -- True <=> *might* be a function type
166 | LFUnknown -- Used for function arguments and imported things.
167 -- We know nothing about this closure. Treat like
168 -- updatable "LFThunk"...
169 -- Imported things which we do know something about use
170 -- one of the other LF constructors (eg LFReEntrant for
172 !Bool -- True <=> *might* be a function type
174 | LFLetNoEscape -- See LetNoEscape module for precise description of
178 | LFBlackHole -- Used for the closures allocated to hold the result
179 -- of a CAF. We want the target of the update frame to
180 -- be in the heap, so we make a black hole to hold it.
181 CLabel -- Flavour (info label, eg CAF_BLACKHOLE_info).
184 data StandardFormInfo -- Tells whether this thunk has one of a small number
187 = NonStandardThunk -- No, it isn't
190 Int -- 0-origin offset of ak within the "goods" of
191 -- constructor (Recall that the a1,...,an may be laid
192 -- out in the heap in a non-obvious order.)
194 {- A SelectorThunk is of form
199 and the constructor is from a single-constr type.
205 {- An ApThunk is of form
209 The code for the thunk just pushes x2..xn on the stack and enters x1.
210 There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
211 in the RTS to save space.
216 %************************************************************************
218 \subsection[ClosureInfo-construction]{Functions which build LFInfos}
220 %************************************************************************
222 @mkClosureLFInfo@ figures out the appropriate LFInfo for the closure.
225 mkClosureLFInfo :: Id -- The binder
226 -> TopLevelFlag -- True of top level
228 -> UpdateFlag -- Update flag
232 mkClosureLFInfo bndr top fvs upd_flag args@(_:_) -- Non-empty args
233 = LFReEntrant top (length args) (null fvs) (mkArgDescr (getName bndr) args)
235 mkClosureLFInfo bndr top fvs upd_flag []
236 = ASSERT( not updatable || not (isUnLiftedType id_ty) )
237 LFThunk top (null fvs) updatable NonStandardThunk
238 (might_be_a_function id_ty)
240 updatable = isUpdatable upd_flag
243 might_be_a_function :: Type -> Bool
244 might_be_a_function ty
245 | Just (tc,_) <- splitTyConApp_maybe (repType ty),
246 not (isFunTyCon tc) = False
250 @mkConLFInfo@ is similar, for constructors.
253 mkConLFInfo :: DataCon -> LambdaFormInfo
254 mkConLFInfo con = LFCon con
256 mkSelectorLFInfo id offset updatable
257 = LFThunk NotTopLevel False updatable (SelectorThunk offset)
258 (might_be_a_function (idType id))
260 mkApLFInfo id upd_flag arity
261 = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)
262 (might_be_a_function (idType id))
265 Miscellaneous LF-infos.
268 mkLFArgument id = LFUnknown (might_be_a_function (idType id))
270 mkLFLetNoEscape = LFLetNoEscape
272 mkLFImported :: Id -> LambdaFormInfo
275 n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr") -- n > 0
276 other -> mkLFArgument id -- Not sure of exact arity
279 %************************************************************************
281 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
283 %************************************************************************
286 closureSize :: ClosureInfo -> HeapOffset
287 closureSize cl_info = fixedHdrSize + closureNonHdrSize cl_info
289 closureNonHdrSize :: ClosureInfo -> Int
290 closureNonHdrSize cl_info
291 = tot_wds + computeSlopSize tot_wds
292 (closureSMRep cl_info)
293 (closureNeedsUpdSpace cl_info)
295 tot_wds = closureGoodStuffSize cl_info
297 -- we leave space for an update if either (a) the closure is updatable
298 -- or (b) it is a static thunk. This is because a static thunk needs
299 -- a static link field in a predictable place (after the slop), regardless
300 -- of whether it is updatable or not.
301 closureNeedsUpdSpace (ClosureInfo { closureLFInfo =
302 LFThunk TopLevel _ _ _ _ }) = True
303 closureNeedsUpdSpace cl_info = closureUpdReqd cl_info
305 slopSize :: ClosureInfo -> Int
307 = computeSlopSize (closureGoodStuffSize cl_info)
308 (closureSMRep cl_info)
309 (closureNeedsUpdSpace cl_info)
311 closureGoodStuffSize :: ClosureInfo -> Int
312 closureGoodStuffSize cl_info
313 = let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info)
316 closurePtrsSize :: ClosureInfo -> Int
317 closurePtrsSize cl_info
318 = let (ptrs, _) = sizes_from_SMRep (closureSMRep cl_info)
322 sizes_from_SMRep :: SMRep -> (Int,Int)
323 sizes_from_SMRep (GenericRep _ ptrs nonptrs _) = (ptrs, nonptrs)
324 sizes_from_SMRep BlackHoleRep = (0, 0)
327 Computing slop size. WARNING: this looks dodgy --- it has deep
328 knowledge of what the storage manager does with the various
334 Updateable closures must be @mIN_UPD_SIZE@.
337 Indirections require 1 word
339 Appels collector indirections 2 words
341 THEREFORE: @mIN_UPD_SIZE = 2@.
344 Collectable closures which are allocated in the heap
345 must be @mIN_SIZE_NonUpdHeapObject@.
347 Copying collector forward pointer requires 1 word
349 THEREFORE: @mIN_SIZE_NonUpdHeapObject = 1@
352 Static closures have an extra ``static link field'' at the end, but we
353 don't bother taking that into account here.
356 computeSlopSize :: Int -> SMRep -> Bool -> Int
358 computeSlopSize tot_wds (GenericRep _ _ _ _) True -- Updatable
359 = max 0 (mIN_UPD_SIZE - tot_wds)
361 computeSlopSize tot_wds (GenericRep True _ _ _) False -- Non updatable
364 computeSlopSize tot_wds (GenericRep False _ _ _) False -- Non updatable
365 = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds) -- Dynamic
367 computeSlopSize tot_wds BlackHoleRep _ -- Updatable
368 = max 0 (mIN_UPD_SIZE - tot_wds)
371 %************************************************************************
373 \subsection[layOutDynClosure]{Lay out a closure}
375 %************************************************************************
378 layOutDynClosure, layOutStaticClosure
379 :: Id -- STG identifier of this closure
380 -> (a -> PrimRep) -- how to get a PrimRep for the fields
381 -> [a] -- the "things" being layed out
382 -> LambdaFormInfo -- what sort of closure it is
384 -> String -- closure description
385 -> (ClosureInfo, -- info about the closure
386 [(a, VirtualHeapOffset)]) -- things w/ offsets pinned on them
388 layOutDynClosure = layOutClosure False
389 layOutStaticClosure = layOutClosure True
391 layOutStaticNoFVClosure id lf_info srt_info descr
392 = fst (layOutClosure True id (panic "kind_fn") [] lf_info srt_info descr)
395 :: Bool -- True <=> static closure
396 -> Id -- STG identifier of this closure
397 -> (a -> PrimRep) -- how to get a PrimRep for the fields
398 -> [a] -- the "things" being layed out
399 -> LambdaFormInfo -- what sort of closure it is
401 -> String -- closure description
402 -> (ClosureInfo, -- info about the closure
403 [(a, VirtualHeapOffset)]) -- things w/ offsets pinned on them
405 layOutClosure is_static id kind_fn things lf_info srt_info descr
406 = (ClosureInfo { closureName = name,
407 closureLFInfo = lf_info,
408 closureSMRep = sm_rep,
409 closureSRT = srt_info,
410 closureType = idType id,
411 closureDescr = descr },
415 (tot_wds, -- #ptr_wds + #nonptr_wds
417 things_w_offsets) = mkVirtHeapOffsets kind_fn things
418 sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds
421 layOutDynConstr, layOutStaticConstr
426 [(a,VirtualHeapOffset)])
428 layOutDynConstr = layOutConstr False
429 layOutStaticConstr = layOutConstr True
431 layOutConstr is_static data_con kind_fn args
432 = (ConInfo { closureSMRep = sm_rep,
433 closureCon = data_con },
436 (tot_wds, -- #ptr_wds + #nonptr_wds
438 things_w_offsets) = mkVirtHeapOffsets kind_fn args
439 sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds
442 %************************************************************************
444 \subsection[mkStaticClosure]{Make a static closure}
446 %************************************************************************
448 Make a static closure, adding on any extra padding needed for CAFs,
449 and adding a static link field if necessary.
452 mkStaticClosure lbl cl_info ccs fields cafrefs
453 | opt_SccProfilingOn =
457 (mkCCostCentreStack ccs)
467 all_fields = fields ++ padding_wds ++ static_link_field
469 upd_reqd = closureUpdReqd cl_info
471 -- for the purposes of laying out the static closure, we consider all
472 -- thunks to be "updatable", so that the static link field is always
473 -- in the same place.
476 | otherwise = replicate n (mkIntCLit 0) -- a bunch of 0s
477 where n = max 0 (mIN_UPD_SIZE - length fields)
479 -- We always have a static link field for a thunk, it's used to
480 -- save the closure's info pointer when we're reverting CAFs
481 -- (see comment in Storage.c)
483 | upd_reqd || staticClosureNeedsLink cl_info = [static_link_value]
486 -- for a static constructor which has NoCafRefs, we set the
487 -- static link field to a non-zero value so the garbage
488 -- collector will ignore it.
490 | cafrefs = mkIntCLit 0
491 | otherwise = mkIntCLit 1
494 %************************************************************************
496 \subsection[SMreps]{Choosing SM reps}
498 %************************************************************************
502 :: Bool -- True <=> static closure
504 -> Int -> Int -- Tot wds, ptr wds
507 chooseSMRep is_static lf_info tot_wds ptr_wds
509 nonptr_wds = tot_wds - ptr_wds
510 closure_type = getClosureType is_static tot_wds ptr_wds lf_info
512 GenericRep is_static ptr_wds nonptr_wds closure_type
514 -- we *do* get non-updatable top-level thunks sometimes. eg. f = g
515 -- gets compiled to a jump to g (if g has non-zero arity), instead of
516 -- messing around with update frames and PAPs. We set the closure type
517 -- to FUN_STATIC in this case.
519 getClosureType :: Bool -> Int -> Int -> LambdaFormInfo -> ClosureType
520 getClosureType is_static tot_wds ptr_wds lf_info
522 LFCon con | is_static && ptr_wds == 0 -> ConstrNoCaf
523 | otherwise -> Constr
524 LFReEntrant _ _ _ _ -> Fun
525 LFThunk _ _ _ (SelectorThunk _) _ -> ThunkSelector
526 LFThunk _ _ _ _ _ -> Thunk
527 _ -> panic "getClosureType"
530 %************************************************************************
532 \subsection[mkVirtHeapOffsets]{Assigning heap offsets in a closure}
534 %************************************************************************
536 @mkVirtHeapOffsets@ (the heap version) always returns boxed things with
537 smaller offsets than the unboxed things, and furthermore, the offsets in
542 (a -> PrimRep) -- To be able to grab kinds;
543 -- w/ a kind, we can find boxedness
544 -> [a] -- Things to make offsets for
545 -> (Int, -- *Total* number of words allocated
546 Int, -- Number of words allocated for *pointers*
547 [(a, VirtualHeapOffset)])
548 -- Things with their offsets from start of
549 -- object in order of increasing offset
551 -- First in list gets lowest offset, which is initial offset + 1.
553 mkVirtHeapOffsets kind_fun things
554 = let (ptrs, non_ptrs) = separateByPtrFollowness kind_fun things
555 (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
556 (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
558 (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
560 computeOffset wds_so_far thing
561 = (wds_so_far + (getPrimRepSize . kind_fun) thing,
562 (thing, fixedHdrSize + wds_so_far)
566 %************************************************************************
568 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
570 %************************************************************************
572 Be sure to see the stg-details notes about these...
575 nodeMustPointToIt :: LambdaFormInfo -> FCode Bool
576 nodeMustPointToIt lf_info
579 LFReEntrant top _ no_fvs _ -> returnFC (
580 not no_fvs || -- Certainly if it has fvs we need to point to it
582 -- If it is not top level we will point to it
583 -- We can have a \r closure with no_fvs which
584 -- is not top level as special case cgRhsClosure
585 -- has been dissabled in favour of let floating
587 -- For lex_profiling we also access the cost centre for a
588 -- non-inherited function i.e. not top level
589 -- the not top case above ensures this is ok.
592 LFCon _ -> returnFC True
594 -- Strictly speaking, the above two don't need Node to point
595 -- to it if the arity = 0. But this is a *really* unlikely
596 -- situation. If we know it's nil (say) and we are entering
597 -- it. Eg: let x = [] in x then we will certainly have inlined
598 -- x, since nil is a simple atom. So we gain little by not
599 -- having Node point to known zero-arity things. On the other
600 -- hand, we do lose something; Patrick's code for figuring out
601 -- when something has been updated but not entered relies on
602 -- having Node point to the result of an update. SLPJ
605 LFThunk _ no_fvs updatable NonStandardThunk _
606 -> returnFC (updatable || not no_fvs || opt_SccProfilingOn)
608 -- For the non-updatable (single-entry case):
610 -- True if has fvs (in which case we need access to them, and we
611 -- should black-hole it)
612 -- or profiling (in which case we need to recover the cost centre
615 LFThunk _ no_fvs updatable some_standard_form_thunk _
617 -- Node must point to any standard-form thunk.
619 LFUnknown _ -> returnFC True
620 LFBlackHole _ -> returnFC True
621 -- BH entry may require Node to point
623 LFLetNoEscape _ -> returnFC False
626 The entry conventions depend on the type of closure being entered,
627 whether or not it has free variables, and whether we're running
628 sequentially or in parallel.
630 \begin{tabular}{lllll}
631 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
632 Unknown & no & yes & stack & node \\
633 Known fun ($\ge$ 1 arg), no fvs & no & no & registers & fast entry (enough args) \\
634 \ & \ & \ & \ & slow entry (otherwise) \\
635 Known fun ($\ge$ 1 arg), fvs & no & yes & registers & fast entry (enough args) \\
636 0 arg, no fvs @\r,\s@ & no & no & n/a & direct entry \\
637 0 arg, no fvs @\u@ & no & yes & n/a & node \\
638 0 arg, fvs @\r,\s@ & no & yes & n/a & direct entry \\
639 0 arg, fvs @\u@ & no & yes & n/a & node \\
641 Unknown & yes & yes & stack & node \\
642 Known fun ($\ge$ 1 arg), no fvs & yes & no & registers & fast entry (enough args) \\
643 \ & \ & \ & \ & slow entry (otherwise) \\
644 Known fun ($\ge$ 1 arg), fvs & yes & yes & registers & node \\
645 0 arg, no fvs @\r,\s@ & yes & no & n/a & direct entry \\
646 0 arg, no fvs @\u@ & yes & yes & n/a & node \\
647 0 arg, fvs @\r,\s@ & yes & yes & n/a & node \\
648 0 arg, fvs @\u@ & yes & yes & n/a & node\\
651 When black-holing, single-entry closures could also be entered via node
652 (rather than directly) to catch double-entry.
655 data CallingConvention
656 = EnterIt -- no args, not a function
658 | JumpToIt CLabel -- no args, not a function, but we
659 -- know what its entry code is
661 | ReturnIt -- it's a function, but we have
662 -- zero args to apply to it, so just
665 | SlowCall -- Unknown fun, or known fun with
668 | DirectEntry -- Jump directly, with args in regs
669 CLabel -- The code label
671 [MagicId] -- Its register assignments
674 getEntryConvention :: Name -- Function being applied
675 -> LambdaFormInfo -- Its info
676 -> [PrimRep] -- Available arguments
677 -> FCode CallingConvention
679 getEntryConvention name lf_info arg_kinds
680 = nodeMustPointToIt lf_info `thenFC` \ node_points ->
683 -- if we're parallel, then we must always enter via node. The reason
684 -- is that the closure may have been fetched since we allocated it.
686 if (node_points && opt_Parallel) then EnterIt else
688 -- Commented out by SDM after futher thoughts:
689 -- - the only closure type that can be blackholed is a thunk
690 -- - we already enter thunks via node (unless the closure is
691 -- non-updatable, in which case why is it being re-entered...)
695 LFReEntrant _ arity _ _ ->
696 if null arg_kinds then
698 EnterIt -- a non-updatable thunk
700 ReturnIt -- no args at all
701 else if listLengthCmp arg_kinds arity == LT then
702 SlowCall -- not enough args
704 DirectEntry (mkEntryLabel name) arity arg_regs
706 (arg_regs, _) = assignRegs [node] (take arity arg_kinds)
707 -- we don't use node to pass args now (SDM)
710 | isNullaryDataCon con
711 -- a real constructor. Don't bother entering it, just jump
712 -- to the constructor entry code directly.
713 -> --false:ASSERT (null arg_kinds)
714 -- Should have no args (meaning what?)
715 JumpToIt (mkStaticConEntryLabel (dataConName con))
717 | otherwise {- not nullary -}
718 -> --false:ASSERT (null arg_kinds)
719 -- Should have no args (meaning what?)
720 JumpToIt (mkConEntryLabel (dataConName con))
722 LFThunk _ _ updatable std_form_info is_fun
723 -- must always "call" a function-typed thing, cannot just enter it
725 | updatable || opt_DoTickyProfiling -- to catch double entry
726 || opt_SMP -- always enter via node on SMP, since the
727 -- thunk might have been blackholed in the
729 -> ASSERT(null arg_kinds) EnterIt
731 -> ASSERT(null arg_kinds)
732 JumpToIt (thunkEntryLabel name std_form_info updatable)
734 LFUnknown True -> SlowCall -- might be a function
735 LFUnknown False -> ASSERT2 (null arg_kinds, ppr name <+> ppr arg_kinds) EnterIt -- not a function
737 LFBlackHole _ -> SlowCall -- Presumably the black hole has by now
738 -- been updated, but we don't know with
739 -- what, so we slow call it
742 -> JumpToIt (mkReturnPtLabel (nameUnique name))
745 -> if (not (arg_kinds `lengthIs` arity)) then pprPanic "let-no-escape: " (ppr name <+> ppr arity) else
746 DirectEntry (mkReturnPtLabel (nameUnique name)) arity arg_regs
748 (arg_regs, _) = assignRegs [] arg_kinds
749 -- node never points to a LetNoEscape, see above --SDM
750 --live_regs = if node_points then [node] else []
753 blackHoleOnEntry :: ClosureInfo -> Bool
755 -- Static closures are never themselves black-holed.
756 -- Updatable ones will be overwritten with a CAFList cell, which points to a
758 -- Single-entry ones have no fvs to plug, and we trust they don't form part
761 blackHoleOnEntry ConInfo{} = False
762 blackHoleOnEntry (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
764 = False -- Never black-hole a static closure
768 LFReEntrant _ _ _ _ -> False
769 LFLetNoEscape _ -> False
770 LFThunk _ no_fvs updatable _ _
772 then not opt_OmitBlackHoling
773 else opt_DoTickyProfiling || not no_fvs
774 -- the former to catch double entry,
775 -- and the latter to plug space-leaks. KSW/SDM 1999-04.
777 other -> panic "blackHoleOnEntry" -- Should never happen
779 isStandardFormThunk :: LambdaFormInfo -> Bool
781 isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
782 isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _) = True
783 isStandardFormThunk other_lf_info = False
787 -----------------------------------------------------------------------------
791 staticClosureNeedsLink :: ClosureInfo -> Bool
792 -- A static closure needs a link field to aid the GC when traversing
793 -- the static closure graph. But it only needs such a field if either
795 -- b) it's a constructor with one or more pointer fields
796 -- In case (b), the constructor's fields themselves play the role
798 staticClosureNeedsLink (ClosureInfo { closureSRT = srt })
800 staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })
801 = not (isNullaryDataCon con) && not_nocaf_constr
805 GenericRep _ _ _ ConstrNoCaf -> False
809 Avoiding generating entries and info tables
810 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
811 At present, for every function we generate all of the following,
812 just in case. But they aren't always all needed, as noted below:
814 [NB1: all of this applies only to *functions*. Thunks always
815 have closure, info table, and entry code.]
817 [NB2: All are needed if the function is *exported*, just to play safe.]
820 * Fast-entry code ALWAYS NEEDED
823 Needed iff (a) we have any un-saturated calls to the function
824 OR (b) the function is passed as an arg
825 OR (c) we're in the parallel world and the function has free vars
826 [Reason: in parallel world, we always enter functions
827 with free vars via the closure.]
829 * The function closure
830 Needed iff (a) we have any un-saturated calls to the function
831 OR (b) the function is passed as an arg
832 OR (c) if the function has free vars (ie not top level)
834 Why case (a) here? Because if the arg-satis check fails,
835 UpdatePAP stuffs a pointer to the function closure in the PAP.
836 [Could be changed; UpdatePAP could stuff in a code ptr instead,
837 but doesn't seem worth it.]
839 [NB: these conditions imply that we might need the closure
840 without the slow-entry code. Here's how.
842 f x y = let g w = ...x..y..w...
846 Here we need a closure for g which contains x and y,
847 but since the calls are all saturated we just jump to the
848 fast entry point for g, with R1 pointing to the closure for g.]
851 * Standard info table
852 Needed iff (a) we have any un-saturated calls to the function
853 OR (b) the function is passed as an arg
854 OR (c) the function has free vars (ie not top level)
856 NB. In the sequential world, (c) is only required so that the function closure has
857 an info table to point to, to keep the storage manager happy.
858 If (c) alone is true we could fake up an info table by choosing
859 one of a standard family of info tables, whose entry code just
862 [NB In the parallel world (c) is needed regardless because
863 we enter functions with free vars via the closure.]
865 If (c) is retained, then we'll sometimes generate an info table
866 (for storage mgr purposes) without slow-entry code. Then we need
867 to use an error label in the info table to substitute for the absent
871 staticClosureRequired
876 staticClosureRequired binder bndr_info
877 (LFReEntrant top_level _ _ _) -- It's a function
878 = ASSERT( isTopLevel top_level )
879 -- Assumption: it's a top-level, no-free-var binding
880 not (satCallsOnly bndr_info)
882 staticClosureRequired binder other_binder_info other_lf_info = True
885 %************************************************************************
887 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
889 %************************************************************************
893 isStaticClosure :: ClosureInfo -> Bool
894 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
896 closureUpdReqd :: ClosureInfo -> Bool
897 closureUpdReqd (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _ }) = upd
898 closureUpdReqd (ClosureInfo { closureLFInfo = LFBlackHole _ }) = True
899 -- Black-hole closures are allocated to receive the results of an
900 -- alg case with a named default... so they need to be updated.
901 closureUpdReqd other_closure = False
903 closureSingleEntry :: ClosureInfo -> Bool
904 closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
905 closureSingleEntry other_closure = False
907 closureReEntrant :: ClosureInfo -> Bool
908 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
909 closureReEntrant other_closure = False
911 closureSemiTag :: ClosureInfo -> Maybe Int
912 closureSemiTag (ConInfo { closureCon = data_con })
913 = Just (dataConTag data_con - fIRST_TAG)
914 closureSemiTag _ = Nothing
916 closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
917 closureFunInfo (ClosureInfo { closureLFInfo = LFReEntrant _ arity _ arg_desc})
918 = Just (arity, arg_desc)
924 isToplevClosure :: ClosureInfo -> Bool
925 isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
927 LFReEntrant TopLevel _ _ _ -> True
928 LFThunk TopLevel _ _ _ _ -> True
930 isToplevClosure _ = False
936 infoTableLabelFromCI :: ClosureInfo -> CLabel
937 infoTableLabelFromCI (ClosureInfo { closureName = name,
938 closureLFInfo = lf_info,
939 closureSMRep = rep })
941 LFBlackHole info -> info
943 LFThunk _ _ upd_flag (SelectorThunk offset) _ ->
944 mkSelectorInfoLabel upd_flag offset
946 LFThunk _ _ upd_flag (ApThunk arity) _ ->
947 mkApInfoTableLabel upd_flag arity
949 LFThunk{} -> mkInfoTableLabel name
951 LFReEntrant _ _ _ (ArgGen _ _) -> mkInfoTableLabel name
952 LFReEntrant _ _ _ _ -> mkInfoTableLabel name
954 other -> panic "infoTableLabelFromCI"
956 infoTableLabelFromCI (ConInfo { closureCon = con, closureSMRep = rep })
957 = mkConInfoPtr con rep
960 mkConInfoPtr :: DataCon -> SMRep -> CLabel
962 | isStaticRep rep = mkStaticInfoTableLabel name
963 | otherwise = mkConInfoTableLabel name
965 name = dataConName con
967 mkConEntryPtr :: DataCon -> SMRep -> CLabel
968 mkConEntryPtr con rep
969 | isStaticRep rep = mkStaticConEntryLabel (dataConName con)
970 | otherwise = mkConEntryLabel (dataConName con)
972 closureLabelFromCI (ClosureInfo { closureName = nm }) = mkClosureLabel nm
973 closureLabelFromCI _ = panic "closureLabelFromCI"
975 entryLabelFromCI :: ClosureInfo -> CLabel
976 entryLabelFromCI (ClosureInfo { closureName = id,
977 closureLFInfo = lf_info,
978 closureSMRep = rep })
980 LFThunk _ _ upd_flag std_form_info _ ->
981 thunkEntryLabel id std_form_info upd_flag
982 other -> mkEntryLabel id
984 entryLabelFromCI (ConInfo { closureCon = con, closureSMRep = rep })
985 = mkConEntryPtr con rep
988 -- thunkEntryLabel is a local help function, not exported. It's used from both
989 -- entryLabelFromCI and getEntryConvention.
991 thunkEntryLabel thunk_id (ApThunk arity) is_updatable
992 = mkApEntryLabel is_updatable arity
993 thunkEntryLabel thunk_id (SelectorThunk offset) upd_flag
994 = mkSelectorEntryLabel upd_flag offset
995 thunkEntryLabel thunk_id _ is_updatable
996 = mkEntryLabel thunk_id
1000 allocProfilingMsg :: ClosureInfo -> FastString
1001 allocProfilingMsg ConInfo{} = FSLIT("TICK_ALLOC_CON")
1002 allocProfilingMsg ClosureInfo{ closureLFInfo = lf_info }
1004 LFReEntrant _ _ _ _ -> FSLIT("TICK_ALLOC_FUN")
1005 LFThunk _ _ True _ _ -> FSLIT("TICK_ALLOC_UP_THK") -- updatable
1006 LFThunk _ _ False _ _ -> FSLIT("TICK_ALLOC_SE_THK") -- nonupdatable
1007 LFBlackHole _ -> FSLIT("TICK_ALLOC_BH")
1008 _ -> panic "allocProfilingMsg"
1011 We need a black-hole closure info to pass to @allocDynClosure@ when we
1012 want to allocate the black hole on entry to a CAF. These are the only
1013 ways to build an LFBlackHole, maintaining the invariant that it really
1014 is a black hole and not something else.
1017 cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
1019 = ClosureInfo { closureName = nm,
1020 closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel,
1021 closureSMRep = BlackHoleRep,
1022 closureSRT = NoC_SRT,
1025 cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
1027 seCafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
1029 = ClosureInfo { closureName = nm,
1030 closureLFInfo = LFBlackHole mkSECAFBlackHoleInfoTableLabel,
1031 closureSMRep = BlackHoleRep,
1032 closureSRT = NoC_SRT,
1035 seCafBlackHoleClosureInfo _ = panic "seCafBlackHoleClosureInfo"
1038 %************************************************************************
1040 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
1042 %************************************************************************
1044 Profiling requires two pieces of information to be determined for
1045 each closure's info table --- description and type.
1047 The description is stored directly in the @CClosureInfoTable@ when the
1048 info table is built.
1050 The type is determined from the type information stored with the @Id@
1051 in the closure info using @closureTypeDescr@.
1054 closureTypeDescr :: ClosureInfo -> String
1055 closureTypeDescr (ClosureInfo { closureType = ty })
1056 = getTyDescription ty
1057 closureTypeDescr (ConInfo { closureCon = data_con })
1058 = occNameUserString (getOccName (dataConTyCon data_con))
1061 %************************************************************************
1063 \subsection{Making argument bitmaps}
1065 %************************************************************************
1068 -- bring in ARG_P, ARG_N, etc.
1069 #include "../includes/StgFun.h"
1073 !Int -- ARG_P, ARG_N, ...
1075 CLabel -- label for a slow-entry point
1076 Liveness -- the arg bitmap: describes pointedness of arguments
1078 mkArgDescr :: Name -> [Id] -> ArgDescr
1079 mkArgDescr nm args = argDescr nm (filter nonVoidRep (map idPrimRep args))
1080 where nonVoidRep VoidRep = False
1083 argDescr nm [PtrRep] = ArgSpec ARG_P
1084 argDescr nm [FloatRep] = ArgSpec ARG_F
1085 argDescr nm [DoubleRep] = ArgSpec ARG_D
1086 argDescr nm [r] | is64BitRep r = ArgSpec ARG_L
1087 argDescr nm [r] | isNonPtrRep r = ArgSpec ARG_N
1089 argDescr nm [r1,r2] | isNonPtrRep r1 && isNonPtrRep r2 = ArgSpec ARG_NN
1090 argDescr nm [r1,PtrRep] | isNonPtrRep r1 = ArgSpec ARG_NP
1091 argDescr nm [PtrRep,r1] | isNonPtrRep r1 = ArgSpec ARG_PN
1092 argDescr nm [PtrRep,PtrRep] = ArgSpec ARG_PP
1094 argDescr nm [r1,r2,r3] | isNonPtrRep r1 && isNonPtrRep r2 && isNonPtrRep r3 = ArgSpec ARG_NNN
1095 argDescr nm [r1,r2,PtrRep] | isNonPtrRep r1 && isNonPtrRep r2 = ArgSpec ARG_NNP
1096 argDescr nm [r1,PtrRep,r2] | isNonPtrRep r1 && isNonPtrRep r2 = ArgSpec ARG_NPN
1097 argDescr nm [r1,PtrRep,PtrRep] | isNonPtrRep r1 = ArgSpec ARG_NPP
1098 argDescr nm [PtrRep,r1,r2] | isNonPtrRep r1 && isNonPtrRep r2 = ArgSpec ARG_PNN
1099 argDescr nm [PtrRep,r1,PtrRep] | isNonPtrRep r1 = ArgSpec ARG_PNP
1100 argDescr nm [PtrRep,PtrRep,r1] | isNonPtrRep r1 = ArgSpec ARG_PPN
1101 argDescr nm [PtrRep,PtrRep,PtrRep] = ArgSpec ARG_PPP
1103 argDescr nm [PtrRep,PtrRep,PtrRep,PtrRep] = ArgSpec ARG_PPPP
1104 argDescr nm [PtrRep,PtrRep,PtrRep,PtrRep,PtrRep] = ArgSpec ARG_PPPPP
1105 argDescr nm [PtrRep,PtrRep,PtrRep,PtrRep,PtrRep,PtrRep] = ArgSpec ARG_PPPPPP
1107 argDescr name reps = ArgGen (mkSlowEntryLabel name) liveness
1108 where bitmap = argBits reps
1109 lbl = mkBitmapLabel name
1110 liveness = Liveness lbl (length bitmap) (mkBitmap bitmap)
1113 argBits (rep : args)
1114 | isFollowableRep rep = False : argBits args
1115 | otherwise = take (getPrimRepSize rep) (repeat True) ++ argBits args
1119 %************************************************************************
1121 \subsection{Generating info tables}
1123 %************************************************************************
1125 Here we make a concrete info table, represented as a list of CAddrMode
1126 (it can't be simply a list of Word, because the SRT field is
1127 represented by a label+offset expression).
1130 mkInfoTable :: ClosureInfo -> [CAddrMode]
1132 | tablesNextToCode = extra_bits ++ std_info
1133 | otherwise = std_info ++ extra_bits
1135 std_info = mkStdInfoTable entry_amode
1136 ty_descr_amode cl_descr_amode cl_type srt_len layout_amode
1138 entry_amode = CLbl (entryLabelFromCI cl_info) CodePtrRep
1142 ClosureInfo { closureDescr = descr } -> descr
1143 ConInfo { closureCon = con } -> occNameUserString (getOccName con)
1145 ty_descr_amode = CLit (MachStr (mkFastString (closureTypeDescr cl_info)))
1146 cl_descr_amode = CLit (MachStr (mkFastString closure_descr))
1148 cl_type = getSMRepClosureTypeInt (closureSMRep cl_info)
1150 srt = closureSRT cl_info
1151 needs_srt = needsSRT srt
1153 semi_tag = closureSemiTag cl_info
1154 is_con = isJust semi_tag
1157 | Just tag <- semi_tag = (mkIntCLit 0, fromIntegral tag) -- constructor
1160 NoC_SRT -> (mkIntCLit 0, 0)
1161 C_SRT lbl off bitmap ->
1162 (CAddr (CIndex (CLbl lbl DataPtrRep) (mkIntCLit off) WordRep),
1165 ptrs = closurePtrsSize cl_info
1167 size = closureNonHdrSize cl_info
1169 layout_info :: StgWord
1170 #ifdef WORDS_BIGENDIAN
1171 layout_info = (fromIntegral ptrs `shiftL` hALF_WORD) .|. fromIntegral nptrs
1173 layout_info = (fromIntegral ptrs) .|. (fromIntegral nptrs `shiftL` hALF_WORD)
1176 layout_amode = mkWordCLit layout_info
1179 | is_fun = fun_extra_bits
1181 | needs_srt = [srt_label]
1184 maybe_fun_stuff = closureFunInfo cl_info
1185 is_fun = isJust maybe_fun_stuff
1186 (Just (arity, arg_descr)) = maybe_fun_stuff
1189 | tablesNextToCode = reg_fun_extra_bits
1190 | otherwise = reverse reg_fun_extra_bits
1193 | ArgGen slow_lbl liveness <- arg_descr
1195 CLbl slow_lbl CodePtrRep,
1196 livenessToAddrMode liveness,
1200 | needs_srt = [srt_label, fun_amode]
1201 | otherwise = [fun_amode]
1203 #ifdef WORDS_BIGENDIAN
1204 fun_desc = (fromIntegral fun_type `shiftL` hALF_WORD) .|. fromIntegral arity
1206 fun_desc = (fromIntegral fun_type) .|. (fromIntegral arity `shiftL` hALF_WORD)
1209 fun_amode = mkWordCLit fun_desc
1211 fun_type = case arg_descr of
1213 ArgGen _ (Liveness _ size _)
1214 | size <= mAX_SMALL_BITMAP_SIZE -> ARG_GEN
1215 | otherwise -> ARG_GEN_BIG
1217 -- Return info tables come in two flavours: direct returns and
1218 -- vectored returns.
1220 mkRetInfoTable :: CLabel -> C_SRT -> Liveness -> [CAddrMode]
1221 mkRetInfoTable entry_lbl srt liveness
1222 = mkBitmapInfoTable (CLbl entry_lbl CodePtrRep) srt liveness []
1224 mkVecInfoTable :: [CAddrMode] -> C_SRT -> Liveness -> [CAddrMode]
1225 mkVecInfoTable vector srt liveness
1226 = mkBitmapInfoTable zero_amode srt liveness vector
1230 -> C_SRT -> Liveness
1233 mkBitmapInfoTable entry_amode srt liveness vector
1234 | tablesNextToCode = extra_bits ++ std_info
1235 | otherwise = std_info ++ extra_bits
1237 std_info = mkStdInfoTable entry_amode zero_amode zero_amode
1238 cl_type srt_len liveness_amode
1240 liveness_amode = livenessToAddrMode liveness
1242 (srt_label,srt_len) =
1244 NoC_SRT -> (mkIntCLit 0, 0)
1245 C_SRT lbl off bitmap ->
1246 (CAddr (CIndex (CLbl lbl DataPtrRep) (mkIntCLit off) WordRep),
1249 cl_type = case (null vector, isBigLiveness liveness) of
1250 (True, True) -> rET_BIG
1251 (True, False) -> rET_SMALL
1252 (False, True) -> rET_VEC_BIG
1253 (False, False) -> rET_VEC_SMALL
1255 srt_bit | needsSRT srt || not (null vector) = [srt_label]
1258 extra_bits | tablesNextToCode = reverse vector ++ srt_bit
1259 | otherwise = srt_bit ++ vector
1261 -- The standard bits of an info table. This part of the info table
1262 -- corresponds to the StgInfoTable type defined in InfoTables.h.
1265 :: CAddrMode -- entry label
1266 -> CAddrMode -- closure type descr (profiling)
1267 -> CAddrMode -- closure descr (profiling)
1268 -> Int -- closure type
1269 -> StgHalfWord -- SRT length
1270 -> CAddrMode -- layout field
1272 mkStdInfoTable entry_lbl type_descr closure_descr cl_type srt_len layout_amode
1276 | tablesNextToCode = std_info'
1277 | otherwise = entry_lbl : std_info'
1285 CLit (MachWord (fromIntegral type_info)) :
1289 | opt_SccProfilingOn = [ type_descr, closure_descr ]
1292 -- sigh: building up the info table is endian-dependent.
1293 -- ToDo: do this using .byte and .word directives.
1294 type_info :: StgWord
1295 #ifdef WORDS_BIGENDIAN
1296 type_info = (fromIntegral cl_type `shiftL` hALF_WORD) .|.
1297 (fromIntegral srt_len)
1299 type_info = (fromIntegral cl_type) .|.
1300 (fromIntegral srt_len `shiftL` hALF_WORD)
1303 isBigLiveness (Liveness _ size _) = size > mAX_SMALL_BITMAP_SIZE
1305 livenessToAddrMode :: Liveness -> CAddrMode
1306 livenessToAddrMode (Liveness lbl size bits)
1307 | size <= mAX_SMALL_BITMAP_SIZE = small
1308 | otherwise = CLbl lbl DataPtrRep
1310 small = mkWordCLit (fromIntegral size .|. (small_bits `shiftL` bITMAP_BITS_SHIFT))
1311 small_bits = case bits of
1313 [b] -> fromIntegral b
1314 _ -> panic "livenessToAddrMode"
1316 zero_amode = mkIntCLit 0
1318 -- IA64 mangler doesn't place tables next to code
1319 tablesNextToCode :: Bool
1320 #ifdef ia64_TARGET_ARCH
1321 tablesNextToCode = False
1323 tablesNextToCode = not opt_Unregisterised