2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 % $Id: ClosureInfo.lhs,v 1.56 2002/12/12 11:53:11 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 )
95 %************************************************************************
97 \subsection[ClosureInfo-datatypes]{Data types for closure information}
99 %************************************************************************
101 Information about a closure, from the code generator's point of view.
103 A ClosureInfo decribes the info pointer of a closure. It has
105 a) to construct the info table itself
106 b) to allocate a closure containing that info pointer (i.e.
107 it knows the info table label)
109 We make a ClosureInfo for
110 - each let binding (both top level and not)
111 - each data constructor (for its shared static and
117 closureName :: !Name, -- The thing bound to this closure
118 closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon (see below)
119 closureSMRep :: !SMRep, -- representation used by storage mgr
120 closureSRT :: !C_SRT, -- What SRT applies to this closure
121 closureType :: !Type, -- Type of closure (ToDo: remove)
122 closureDescr :: !String -- closure description (for profiling)
125 -- constructor closures don't have a unique info table label (they use
126 -- the constructor's info table), and they don't have an SRT.
128 closureCon :: !DataCon,
129 closureSMRep :: !SMRep
133 %************************************************************************
135 \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
137 %************************************************************************
139 Information about an identifier, from the code generator's point of
140 view. Every identifier is bound to a LambdaFormInfo in the
141 environment, which gives the code generator enough info to be able to
142 tail call or return that identifier.
144 Note that a closure is usually bound to an identifier, so a
145 ClosureInfo contains a LambdaFormInfo.
149 = LFReEntrant -- Reentrant closure (a function)
150 TopLevelFlag -- True if top level
152 !Bool -- True <=> no fvs
153 ArgDescr -- Argument descriptor (should reall be in ClosureInfo)
155 | LFCon -- Constructor
156 DataCon -- The constructor
158 | LFThunk -- Thunk (zero arity)
160 !Bool -- True <=> no free vars
161 !Bool -- True <=> updatable (i.e., *not* single-entry)
163 !Bool -- True <=> *might* be a function type
165 | LFUnknown -- Used for function arguments and imported things.
166 -- We know nothing about this closure. Treat like
167 -- updatable "LFThunk"...
168 -- Imported things which we do know something about use
169 -- one of the other LF constructors (eg LFReEntrant for
171 !Bool -- True <=> *might* be a function type
173 | LFLetNoEscape -- See LetNoEscape module for precise description of
177 | LFBlackHole -- Used for the closures allocated to hold the result
178 -- of a CAF. We want the target of the update frame to
179 -- be in the heap, so we make a black hole to hold it.
180 CLabel -- Flavour (info label, eg CAF_BLACKHOLE_info).
183 data StandardFormInfo -- Tells whether this thunk has one of a small number
186 = NonStandardThunk -- No, it isn't
189 Int -- 0-origin offset of ak within the "goods" of
190 -- constructor (Recall that the a1,...,an may be laid
191 -- out in the heap in a non-obvious order.)
193 {- A SelectorThunk is of form
198 and the constructor is from a single-constr type.
204 {- An ApThunk is of form
208 The code for the thunk just pushes x2..xn on the stack and enters x1.
209 There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
210 in the RTS to save space.
215 %************************************************************************
217 \subsection[ClosureInfo-construction]{Functions which build LFInfos}
219 %************************************************************************
221 @mkClosureLFInfo@ figures out the appropriate LFInfo for the closure.
224 mkClosureLFInfo :: Id -- The binder
225 -> TopLevelFlag -- True of top level
227 -> UpdateFlag -- Update flag
231 mkClosureLFInfo bndr top fvs upd_flag args@(_:_) -- Non-empty args
232 = LFReEntrant top (length args) (null fvs) (mkArgDescr (getName bndr) args)
234 mkClosureLFInfo bndr top fvs upd_flag []
235 = ASSERT( not updatable || not (isUnLiftedType id_ty) )
236 LFThunk top (null fvs) updatable NonStandardThunk
237 (might_be_a_function id_ty)
239 updatable = isUpdatable upd_flag
242 might_be_a_function :: Type -> Bool
243 might_be_a_function ty
244 | Just (tc,_) <- splitTyConApp_maybe (repType ty),
245 not (isFunTyCon tc) = False
249 @mkConLFInfo@ is similar, for constructors.
252 mkConLFInfo :: DataCon -> LambdaFormInfo
253 mkConLFInfo con = LFCon con
255 mkSelectorLFInfo id offset updatable
256 = LFThunk NotTopLevel False updatable (SelectorThunk offset)
257 (might_be_a_function (idType id))
259 mkApLFInfo id upd_flag arity
260 = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)
261 (might_be_a_function (idType id))
264 Miscellaneous LF-infos.
267 mkLFArgument id = LFUnknown (might_be_a_function (idType id))
269 mkLFLetNoEscape = LFLetNoEscape
271 mkLFImported :: Id -> LambdaFormInfo
274 n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr") -- n > 0
275 other -> mkLFArgument id -- Not sure of exact arity
278 %************************************************************************
280 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
282 %************************************************************************
285 closureSize :: ClosureInfo -> HeapOffset
286 closureSize cl_info = fixedHdrSize + closureNonHdrSize cl_info
288 closureNonHdrSize :: ClosureInfo -> Int
289 closureNonHdrSize cl_info
290 = tot_wds + computeSlopSize tot_wds
291 (closureSMRep cl_info)
292 (closureNeedsUpdSpace cl_info)
294 tot_wds = closureGoodStuffSize cl_info
296 -- we leave space for an update if either (a) the closure is updatable
297 -- or (b) it is a static thunk. This is because a static thunk needs
298 -- a static link field in a predictable place (after the slop), regardless
299 -- of whether it is updatable or not.
300 closureNeedsUpdSpace (ClosureInfo { closureLFInfo =
301 LFThunk TopLevel _ _ _ _ }) = True
302 closureNeedsUpdSpace cl_info = closureUpdReqd cl_info
304 slopSize :: ClosureInfo -> Int
306 = computeSlopSize (closureGoodStuffSize cl_info)
307 (closureSMRep cl_info)
308 (closureNeedsUpdSpace cl_info)
310 closureGoodStuffSize :: ClosureInfo -> Int
311 closureGoodStuffSize cl_info
312 = let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info)
315 closurePtrsSize :: ClosureInfo -> Int
316 closurePtrsSize cl_info
317 = let (ptrs, _) = sizes_from_SMRep (closureSMRep cl_info)
321 sizes_from_SMRep :: SMRep -> (Int,Int)
322 sizes_from_SMRep (GenericRep _ ptrs nonptrs _) = (ptrs, nonptrs)
323 sizes_from_SMRep BlackHoleRep = (0, 0)
326 Computing slop size. WARNING: this looks dodgy --- it has deep
327 knowledge of what the storage manager does with the various
333 Updateable closures must be @mIN_UPD_SIZE@.
336 Indirections require 1 word
338 Appels collector indirections 2 words
340 THEREFORE: @mIN_UPD_SIZE = 2@.
343 Collectable closures which are allocated in the heap
344 must be @mIN_SIZE_NonUpdHeapObject@.
346 Copying collector forward pointer requires 1 word
348 THEREFORE: @mIN_SIZE_NonUpdHeapObject = 1@
351 Static closures have an extra ``static link field'' at the end, but we
352 don't bother taking that into account here.
355 computeSlopSize :: Int -> SMRep -> Bool -> Int
357 computeSlopSize tot_wds (GenericRep _ _ _ _) True -- Updatable
358 = max 0 (mIN_UPD_SIZE - tot_wds)
360 computeSlopSize tot_wds (GenericRep True _ _ _) False -- Non updatable
363 computeSlopSize tot_wds (GenericRep False _ _ _) False -- Non updatable
364 = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds) -- Dynamic
366 computeSlopSize tot_wds BlackHoleRep _ -- Updatable
367 = max 0 (mIN_UPD_SIZE - tot_wds)
370 %************************************************************************
372 \subsection[layOutDynClosure]{Lay out a closure}
374 %************************************************************************
377 layOutDynClosure, layOutStaticClosure
378 :: Id -- STG identifier of this closure
379 -> (a -> PrimRep) -- how to get a PrimRep for the fields
380 -> [a] -- the "things" being layed out
381 -> LambdaFormInfo -- what sort of closure it is
383 -> String -- closure description
384 -> (ClosureInfo, -- info about the closure
385 [(a, VirtualHeapOffset)]) -- things w/ offsets pinned on them
387 layOutDynClosure = layOutClosure False
388 layOutStaticClosure = layOutClosure True
390 layOutStaticNoFVClosure id lf_info srt_info descr
391 = fst (layOutClosure True id (panic "kind_fn") [] lf_info srt_info descr)
394 :: Bool -- True <=> static closure
395 -> Id -- STG identifier of this closure
396 -> (a -> PrimRep) -- how to get a PrimRep for the fields
397 -> [a] -- the "things" being layed out
398 -> LambdaFormInfo -- what sort of closure it is
400 -> String -- closure description
401 -> (ClosureInfo, -- info about the closure
402 [(a, VirtualHeapOffset)]) -- things w/ offsets pinned on them
404 layOutClosure is_static id kind_fn things lf_info srt_info descr
405 = (ClosureInfo { closureName = name,
406 closureLFInfo = lf_info,
407 closureSMRep = sm_rep,
408 closureSRT = srt_info,
409 closureType = idType id,
410 closureDescr = descr },
414 (tot_wds, -- #ptr_wds + #nonptr_wds
416 things_w_offsets) = mkVirtHeapOffsets kind_fn things
417 sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds
420 layOutDynConstr, layOutStaticConstr
425 [(a,VirtualHeapOffset)])
427 layOutDynConstr = layOutConstr False
428 layOutStaticConstr = layOutConstr True
430 layOutConstr is_static data_con kind_fn args
431 = (ConInfo { closureSMRep = sm_rep,
432 closureCon = data_con },
435 (tot_wds, -- #ptr_wds + #nonptr_wds
437 things_w_offsets) = mkVirtHeapOffsets kind_fn args
438 sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds
441 %************************************************************************
443 \subsection[mkStaticClosure]{Make a static closure}
445 %************************************************************************
447 Make a static closure, adding on any extra padding needed for CAFs,
448 and adding a static link field if necessary.
451 mkStaticClosure lbl cl_info ccs fields cafrefs
452 | opt_SccProfilingOn =
456 (mkCCostCentreStack ccs)
466 all_fields = fields ++ padding_wds ++ static_link_field
468 upd_reqd = closureUpdReqd cl_info
470 -- for the purposes of laying out the static closure, we consider all
471 -- thunks to be "updatable", so that the static link field is always
472 -- in the same place.
475 | otherwise = replicate n (mkIntCLit 0) -- a bunch of 0s
476 where n = max 0 (mIN_UPD_SIZE - length fields)
478 -- We always have a static link field for a thunk, it's used to
479 -- save the closure's info pointer when we're reverting CAFs
480 -- (see comment in Storage.c)
482 | upd_reqd || staticClosureNeedsLink cl_info = [static_link_value]
485 -- for a static constructor which has NoCafRefs, we set the
486 -- static link field to a non-zero value so the garbage
487 -- collector will ignore it.
489 | cafrefs = mkIntCLit 0
490 | otherwise = mkIntCLit 1
493 %************************************************************************
495 \subsection[SMreps]{Choosing SM reps}
497 %************************************************************************
501 :: Bool -- True <=> static closure
503 -> Int -> Int -- Tot wds, ptr wds
506 chooseSMRep is_static lf_info tot_wds ptr_wds
508 nonptr_wds = tot_wds - ptr_wds
509 closure_type = getClosureType is_static tot_wds ptr_wds lf_info
511 GenericRep is_static ptr_wds nonptr_wds closure_type
513 -- we *do* get non-updatable top-level thunks sometimes. eg. f = g
514 -- gets compiled to a jump to g (if g has non-zero arity), instead of
515 -- messing around with update frames and PAPs. We set the closure type
516 -- to FUN_STATIC in this case.
518 getClosureType :: Bool -> Int -> Int -> LambdaFormInfo -> ClosureType
519 getClosureType is_static tot_wds ptr_wds lf_info
521 LFCon con | is_static && ptr_wds == 0 -> ConstrNoCaf
522 | otherwise -> Constr
523 LFReEntrant _ _ _ _ -> Fun
524 LFThunk _ _ _ (SelectorThunk _) _ -> ThunkSelector
525 LFThunk _ _ _ _ _ -> Thunk
526 _ -> panic "getClosureType"
529 %************************************************************************
531 \subsection[mkVirtHeapOffsets]{Assigning heap offsets in a closure}
533 %************************************************************************
535 @mkVirtHeapOffsets@ (the heap version) always returns boxed things with
536 smaller offsets than the unboxed things, and furthermore, the offsets in
541 (a -> PrimRep) -- To be able to grab kinds;
542 -- w/ a kind, we can find boxedness
543 -> [a] -- Things to make offsets for
544 -> (Int, -- *Total* number of words allocated
545 Int, -- Number of words allocated for *pointers*
546 [(a, VirtualHeapOffset)])
547 -- Things with their offsets from start of
548 -- object in order of increasing offset
550 -- First in list gets lowest offset, which is initial offset + 1.
552 mkVirtHeapOffsets kind_fun things
553 = let (ptrs, non_ptrs) = separateByPtrFollowness kind_fun things
554 (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
555 (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
557 (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
559 computeOffset wds_so_far thing
560 = (wds_so_far + (getPrimRepSize . kind_fun) thing,
561 (thing, fixedHdrSize + wds_so_far)
565 %************************************************************************
567 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
569 %************************************************************************
571 Be sure to see the stg-details notes about these...
574 nodeMustPointToIt :: LambdaFormInfo -> FCode Bool
575 nodeMustPointToIt lf_info
578 LFReEntrant top _ no_fvs _ -> returnFC (
579 not no_fvs || -- Certainly if it has fvs we need to point to it
581 -- If it is not top level we will point to it
582 -- We can have a \r closure with no_fvs which
583 -- is not top level as special case cgRhsClosure
584 -- has been dissabled in favour of let floating
586 -- For lex_profiling we also access the cost centre for a
587 -- non-inherited function i.e. not top level
588 -- the not top case above ensures this is ok.
591 LFCon _ -> returnFC True
593 -- Strictly speaking, the above two don't need Node to point
594 -- to it if the arity = 0. But this is a *really* unlikely
595 -- situation. If we know it's nil (say) and we are entering
596 -- it. Eg: let x = [] in x then we will certainly have inlined
597 -- x, since nil is a simple atom. So we gain little by not
598 -- having Node point to known zero-arity things. On the other
599 -- hand, we do lose something; Patrick's code for figuring out
600 -- when something has been updated but not entered relies on
601 -- having Node point to the result of an update. SLPJ
604 LFThunk _ no_fvs updatable NonStandardThunk _
605 -> returnFC (updatable || not no_fvs || opt_SccProfilingOn)
607 -- For the non-updatable (single-entry case):
609 -- True if has fvs (in which case we need access to them, and we
610 -- should black-hole it)
611 -- or profiling (in which case we need to recover the cost centre
614 LFThunk _ no_fvs updatable some_standard_form_thunk _
616 -- Node must point to any standard-form thunk.
618 LFUnknown _ -> returnFC True
619 LFBlackHole _ -> returnFC True
620 -- BH entry may require Node to point
622 LFLetNoEscape _ -> returnFC False
625 The entry conventions depend on the type of closure being entered,
626 whether or not it has free variables, and whether we're running
627 sequentially or in parallel.
629 \begin{tabular}{lllll}
630 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
631 Unknown & no & yes & stack & node \\
632 Known fun ($\ge$ 1 arg), no fvs & no & no & registers & fast entry (enough args) \\
633 \ & \ & \ & \ & slow entry (otherwise) \\
634 Known fun ($\ge$ 1 arg), fvs & no & yes & registers & fast entry (enough args) \\
635 0 arg, no fvs @\r,\s@ & no & no & n/a & direct entry \\
636 0 arg, no fvs @\u@ & no & yes & n/a & node \\
637 0 arg, fvs @\r,\s@ & no & yes & n/a & direct entry \\
638 0 arg, fvs @\u@ & no & yes & n/a & node \\
640 Unknown & yes & yes & stack & node \\
641 Known fun ($\ge$ 1 arg), no fvs & yes & no & registers & fast entry (enough args) \\
642 \ & \ & \ & \ & slow entry (otherwise) \\
643 Known fun ($\ge$ 1 arg), fvs & yes & yes & registers & node \\
644 0 arg, no fvs @\r,\s@ & yes & no & n/a & direct entry \\
645 0 arg, no fvs @\u@ & yes & yes & n/a & node \\
646 0 arg, fvs @\r,\s@ & yes & yes & n/a & node \\
647 0 arg, fvs @\u@ & yes & yes & n/a & node\\
650 When black-holing, single-entry closures could also be entered via node
651 (rather than directly) to catch double-entry.
654 data CallingConvention
655 = EnterIt -- no args, not a function
657 | JumpToIt CLabel -- no args, not a function, but we
658 -- know what its entry code is
660 | ReturnIt -- it's a function, but we have
661 -- zero args to apply to it, so just
664 | SlowCall -- Unknown fun, or known fun with
667 | DirectEntry -- Jump directly, with args in regs
668 CLabel -- The code label
670 [MagicId] -- Its register assignments
673 getEntryConvention :: Name -- Function being applied
674 -> LambdaFormInfo -- Its info
675 -> [PrimRep] -- Available arguments
676 -> FCode CallingConvention
678 getEntryConvention name lf_info arg_kinds
679 = nodeMustPointToIt lf_info `thenFC` \ node_points ->
682 -- if we're parallel, then we must always enter via node. The reason
683 -- is that the closure may have been fetched since we allocated it.
685 if (node_points && opt_Parallel) then EnterIt else
687 -- Commented out by SDM after futher thoughts:
688 -- - the only closure type that can be blackholed is a thunk
689 -- - we already enter thunks via node (unless the closure is
690 -- non-updatable, in which case why is it being re-entered...)
694 LFReEntrant _ arity _ _ ->
695 if null arg_kinds then
697 EnterIt -- a non-updatable thunk
699 ReturnIt -- no args at all
700 else if listLengthCmp arg_kinds arity == LT then
701 SlowCall -- not enough args
703 DirectEntry (mkEntryLabel name) arity arg_regs
705 (arg_regs, _) = assignRegs [node] (take arity arg_kinds)
706 -- we don't use node to pass args now (SDM)
709 | isNullaryDataCon con
710 -- a real constructor. Don't bother entering it, just jump
711 -- to the constructor entry code directly.
712 -> --false:ASSERT (null arg_kinds)
713 -- Should have no args (meaning what?)
714 JumpToIt (mkStaticConEntryLabel (dataConName con))
716 | otherwise {- not nullary -}
717 -> --false:ASSERT (null arg_kinds)
718 -- Should have no args (meaning what?)
719 JumpToIt (mkConEntryLabel (dataConName con))
721 LFThunk _ _ updatable std_form_info is_fun
722 -- must always "call" a function-typed thing, cannot just enter it
724 | updatable || opt_DoTickyProfiling -- to catch double entry
725 || opt_SMP -- always enter via node on SMP, since the
726 -- thunk might have been blackholed in the
728 -> ASSERT(null arg_kinds) EnterIt
730 -> ASSERT(null arg_kinds)
731 JumpToIt (thunkEntryLabel name std_form_info updatable)
733 LFUnknown True -> SlowCall -- might be a function
734 LFUnknown False -> ASSERT2 (null arg_kinds, ppr name <+> ppr arg_kinds) EnterIt -- not a function
736 LFBlackHole _ -> SlowCall -- Presumably the black hole has by now
737 -- been updated, but we don't know with
738 -- what, so we slow call it
741 -> JumpToIt (mkReturnPtLabel (nameUnique name))
744 -> if (not (arg_kinds `lengthIs` arity)) then pprPanic "let-no-escape: " (ppr name <+> ppr arity) else
745 DirectEntry (mkReturnPtLabel (nameUnique name)) arity arg_regs
747 (arg_regs, _) = assignRegs [] arg_kinds
748 -- node never points to a LetNoEscape, see above --SDM
749 --live_regs = if node_points then [node] else []
752 blackHoleOnEntry :: ClosureInfo -> Bool
754 -- Static closures are never themselves black-holed.
755 -- Updatable ones will be overwritten with a CAFList cell, which points to a
757 -- Single-entry ones have no fvs to plug, and we trust they don't form part
760 blackHoleOnEntry ConInfo{} = False
761 blackHoleOnEntry (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
763 = False -- Never black-hole a static closure
767 LFReEntrant _ _ _ _ -> False
768 LFLetNoEscape _ -> False
769 LFThunk _ no_fvs updatable _ _
771 then not opt_OmitBlackHoling
772 else opt_DoTickyProfiling || not no_fvs
773 -- the former to catch double entry,
774 -- and the latter to plug space-leaks. KSW/SDM 1999-04.
776 other -> panic "blackHoleOnEntry" -- Should never happen
778 isStandardFormThunk :: LambdaFormInfo -> Bool
780 isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
781 isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _) = True
782 isStandardFormThunk other_lf_info = False
786 -----------------------------------------------------------------------------
790 staticClosureNeedsLink :: ClosureInfo -> Bool
791 -- A static closure needs a link field to aid the GC when traversing
792 -- the static closure graph. But it only needs such a field if either
794 -- b) it's a constructor with one or more pointer fields
795 -- In case (b), the constructor's fields themselves play the role
797 staticClosureNeedsLink (ClosureInfo { closureSRT = srt })
799 staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })
800 = not (isNullaryDataCon con) && not_nocaf_constr
804 GenericRep _ _ _ ConstrNoCaf -> False
808 Avoiding generating entries and info tables
809 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
810 At present, for every function we generate all of the following,
811 just in case. But they aren't always all needed, as noted below:
813 [NB1: all of this applies only to *functions*. Thunks always
814 have closure, info table, and entry code.]
816 [NB2: All are needed if the function is *exported*, just to play safe.]
819 * Fast-entry code ALWAYS NEEDED
822 Needed iff (a) we have any un-saturated calls to the function
823 OR (b) the function is passed as an arg
824 OR (c) we're in the parallel world and the function has free vars
825 [Reason: in parallel world, we always enter functions
826 with free vars via the closure.]
828 * The function closure
829 Needed iff (a) we have any un-saturated calls to the function
830 OR (b) the function is passed as an arg
831 OR (c) if the function has free vars (ie not top level)
833 Why case (a) here? Because if the arg-satis check fails,
834 UpdatePAP stuffs a pointer to the function closure in the PAP.
835 [Could be changed; UpdatePAP could stuff in a code ptr instead,
836 but doesn't seem worth it.]
838 [NB: these conditions imply that we might need the closure
839 without the slow-entry code. Here's how.
841 f x y = let g w = ...x..y..w...
845 Here we need a closure for g which contains x and y,
846 but since the calls are all saturated we just jump to the
847 fast entry point for g, with R1 pointing to the closure for g.]
850 * Standard info table
851 Needed iff (a) we have any un-saturated calls to the function
852 OR (b) the function is passed as an arg
853 OR (c) the function has free vars (ie not top level)
855 NB. In the sequential world, (c) is only required so that the function closure has
856 an info table to point to, to keep the storage manager happy.
857 If (c) alone is true we could fake up an info table by choosing
858 one of a standard family of info tables, whose entry code just
861 [NB In the parallel world (c) is needed regardless because
862 we enter functions with free vars via the closure.]
864 If (c) is retained, then we'll sometimes generate an info table
865 (for storage mgr purposes) without slow-entry code. Then we need
866 to use an error label in the info table to substitute for the absent
870 staticClosureRequired
875 staticClosureRequired binder bndr_info
876 (LFReEntrant top_level _ _ _) -- It's a function
877 = ASSERT( isTopLevel top_level )
878 -- Assumption: it's a top-level, no-free-var binding
879 not (satCallsOnly bndr_info)
881 staticClosureRequired binder other_binder_info other_lf_info = True
884 %************************************************************************
886 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
888 %************************************************************************
892 isStaticClosure :: ClosureInfo -> Bool
893 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
895 closureUpdReqd :: ClosureInfo -> Bool
896 closureUpdReqd (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _ }) = upd
897 closureUpdReqd (ClosureInfo { closureLFInfo = LFBlackHole _ }) = True
898 -- Black-hole closures are allocated to receive the results of an
899 -- alg case with a named default... so they need to be updated.
900 closureUpdReqd other_closure = False
902 closureSingleEntry :: ClosureInfo -> Bool
903 closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
904 closureSingleEntry other_closure = False
906 closureReEntrant :: ClosureInfo -> Bool
907 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
908 closureReEntrant other_closure = False
910 closureSemiTag :: ClosureInfo -> Maybe Int
911 closureSemiTag (ConInfo { closureCon = data_con })
912 = Just (dataConTag data_con - fIRST_TAG)
913 closureSemiTag _ = Nothing
915 closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
916 closureFunInfo (ClosureInfo { closureLFInfo = LFReEntrant _ arity _ arg_desc})
917 = Just (arity, arg_desc)
923 isToplevClosure :: ClosureInfo -> Bool
924 isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
926 LFReEntrant TopLevel _ _ _ -> True
927 LFThunk TopLevel _ _ _ _ -> True
929 isToplevClosure _ = False
935 infoTableLabelFromCI :: ClosureInfo -> CLabel
936 infoTableLabelFromCI (ClosureInfo { closureName = name,
937 closureLFInfo = lf_info,
938 closureSMRep = rep })
940 LFBlackHole info -> info
942 LFThunk _ _ upd_flag (SelectorThunk offset) _ ->
943 mkSelectorInfoLabel upd_flag offset
945 LFThunk _ _ upd_flag (ApThunk arity) _ ->
946 mkApInfoTableLabel upd_flag arity
948 LFThunk{} -> mkInfoTableLabel name
950 LFReEntrant _ _ _ (ArgGen _ _) -> mkInfoTableLabel name
951 LFReEntrant _ _ _ _ -> mkInfoTableLabel name
953 other -> panic "infoTableLabelFromCI"
955 infoTableLabelFromCI (ConInfo { closureCon = con, closureSMRep = rep })
956 = mkConInfoPtr con rep
959 mkConInfoPtr :: DataCon -> SMRep -> CLabel
961 | isStaticRep rep = mkStaticInfoTableLabel name
962 | otherwise = mkConInfoTableLabel name
964 name = dataConName con
966 mkConEntryPtr :: DataCon -> SMRep -> CLabel
967 mkConEntryPtr con rep
968 | isStaticRep rep = mkStaticConEntryLabel (dataConName con)
969 | otherwise = mkConEntryLabel (dataConName con)
971 closureLabelFromCI (ClosureInfo { closureName = nm }) = mkClosureLabel nm
972 closureLabelFromCI _ = panic "closureLabelFromCI"
974 entryLabelFromCI :: ClosureInfo -> CLabel
975 entryLabelFromCI (ClosureInfo { closureName = id,
976 closureLFInfo = lf_info,
977 closureSMRep = rep })
979 LFThunk _ _ upd_flag std_form_info _ ->
980 thunkEntryLabel id std_form_info upd_flag
981 other -> mkEntryLabel id
983 entryLabelFromCI (ConInfo { closureCon = con, closureSMRep = rep })
984 = mkConEntryPtr con rep
987 -- thunkEntryLabel is a local help function, not exported. It's used from both
988 -- entryLabelFromCI and getEntryConvention.
990 thunkEntryLabel thunk_id (ApThunk arity) is_updatable
991 = mkApEntryLabel is_updatable arity
992 thunkEntryLabel thunk_id (SelectorThunk offset) upd_flag
993 = mkSelectorEntryLabel upd_flag offset
994 thunkEntryLabel thunk_id _ is_updatable
995 = mkEntryLabel thunk_id
999 allocProfilingMsg :: ClosureInfo -> FastString
1000 allocProfilingMsg ConInfo{} = FSLIT("TICK_ALLOC_CON")
1001 allocProfilingMsg ClosureInfo{ closureLFInfo = lf_info }
1003 LFReEntrant _ _ _ _ -> FSLIT("TICK_ALLOC_FUN")
1004 LFThunk _ _ True _ _ -> FSLIT("TICK_ALLOC_UP_THK") -- updatable
1005 LFThunk _ _ False _ _ -> FSLIT("TICK_ALLOC_SE_THK") -- nonupdatable
1006 LFBlackHole _ -> FSLIT("TICK_ALLOC_BH")
1007 _ -> panic "allocProfilingMsg"
1010 We need a black-hole closure info to pass to @allocDynClosure@ when we
1011 want to allocate the black hole on entry to a CAF. These are the only
1012 ways to build an LFBlackHole, maintaining the invariant that it really
1013 is a black hole and not something else.
1016 cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
1018 = ClosureInfo { closureName = nm,
1019 closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel,
1020 closureSMRep = BlackHoleRep,
1021 closureSRT = NoC_SRT,
1024 cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
1026 seCafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
1028 = ClosureInfo { closureName = nm,
1029 closureLFInfo = LFBlackHole mkSECAFBlackHoleInfoTableLabel,
1030 closureSMRep = BlackHoleRep,
1031 closureSRT = NoC_SRT,
1034 seCafBlackHoleClosureInfo _ = panic "seCafBlackHoleClosureInfo"
1037 %************************************************************************
1039 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
1041 %************************************************************************
1043 Profiling requires two pieces of information to be determined for
1044 each closure's info table --- description and type.
1046 The description is stored directly in the @CClosureInfoTable@ when the
1047 info table is built.
1049 The type is determined from the type information stored with the @Id@
1050 in the closure info using @closureTypeDescr@.
1053 closureTypeDescr :: ClosureInfo -> String
1054 closureTypeDescr (ClosureInfo { closureType = ty })
1055 = getTyDescription ty
1056 closureTypeDescr (ConInfo { closureCon = data_con })
1057 = occNameUserString (getOccName (dataConTyCon data_con))
1060 %************************************************************************
1062 \subsection{Making argument bitmaps}
1064 %************************************************************************
1067 -- bring in ARG_P, ARG_N, etc.
1068 #include "../includes/StgFun.h"
1072 !Int -- ARG_P, ARG_N, ...
1074 CLabel -- label for a slow-entry point
1075 Liveness -- the arg bitmap: describes pointedness of arguments
1077 mkArgDescr :: Name -> [Id] -> ArgDescr
1078 mkArgDescr nm args = argDescr nm (filter nonVoidRep (map idPrimRep args))
1079 where nonVoidRep VoidRep = False
1082 argDescr nm [PtrRep] = ArgSpec ARG_P
1083 argDescr nm [FloatRep] = ArgSpec ARG_F
1084 argDescr nm [DoubleRep] = ArgSpec ARG_D
1085 argDescr nm [r] | is64BitRep r = ArgSpec ARG_L
1086 argDescr nm [r] | isNonPtrRep r = ArgSpec ARG_N
1088 argDescr nm [r1,r2] | isNonPtrRep r1 && isNonPtrRep r2 = ArgSpec ARG_NN
1089 argDescr nm [r1,PtrRep] | isNonPtrRep r1 = ArgSpec ARG_NP
1090 argDescr nm [PtrRep,r1] | isNonPtrRep r1 = ArgSpec ARG_PN
1091 argDescr nm [PtrRep,PtrRep] = ArgSpec ARG_PP
1093 argDescr nm [r1,r2,r3] | isNonPtrRep r1 && isNonPtrRep r2 && isNonPtrRep r3 = ArgSpec ARG_NNN
1094 argDescr nm [r1,r2,PtrRep] | isNonPtrRep r1 && isNonPtrRep r2 = ArgSpec ARG_NNP
1095 argDescr nm [r1,PtrRep,r2] | isNonPtrRep r1 && isNonPtrRep r2 = ArgSpec ARG_NPN
1096 argDescr nm [r1,PtrRep,PtrRep] | isNonPtrRep r1 = ArgSpec ARG_NPP
1097 argDescr nm [PtrRep,r1,r2] | isNonPtrRep r1 && isNonPtrRep r2 = ArgSpec ARG_PNN
1098 argDescr nm [PtrRep,r1,PtrRep] | isNonPtrRep r1 = ArgSpec ARG_PNP
1099 argDescr nm [PtrRep,PtrRep,r1] | isNonPtrRep r1 = ArgSpec ARG_PPN
1100 argDescr nm [PtrRep,PtrRep,PtrRep] = ArgSpec ARG_PPP
1102 argDescr nm [PtrRep,PtrRep,PtrRep,PtrRep] = ArgSpec ARG_PPPP
1103 argDescr nm [PtrRep,PtrRep,PtrRep,PtrRep,PtrRep] = ArgSpec ARG_PPPPP
1104 argDescr nm [PtrRep,PtrRep,PtrRep,PtrRep,PtrRep,PtrRep] = ArgSpec ARG_PPPPPP
1106 argDescr name reps = ArgGen (mkSlowEntryLabel name) liveness
1107 where bitmap = argBits reps
1108 lbl = mkBitmapLabel name
1109 liveness = Liveness lbl (length bitmap)
1110 (map chunkToLiveness (mkChunks bitmap))
1113 argBits (rep : args)
1114 | isFollowableRep rep = False : argBits args
1115 | otherwise = take (getPrimRepSize rep) (repeat True) ++ argBits args
1118 mkChunks stuff = chunk : mkChunks rest
1119 where (chunk, rest) = splitAt 32 stuff
1121 chunkToLiveness chunk = mkBS [ n | (True,n) <- zip chunk [0..] ]
1125 %************************************************************************
1127 \subsection{Generating info tables}
1129 %************************************************************************
1131 Here we make a concrete info table, represented as a list of CAddrMode
1132 (it can't be simply a list of Word, because the SRT field is
1133 represented by a label+offset expression).
1136 #if SIZEOF_HSWORD == 4
1137 type StgWord = Word32
1138 #define HALF_WORD 16
1139 #elif SIZEOF_HSWORD == 8
1140 type StgWord = Word64
1141 #define HALF_WORD 32
1144 mkInfoTable :: ClosureInfo -> [CAddrMode]
1146 | opt_Unregisterised = std_info ++ extra_bits
1147 | otherwise = extra_bits ++ std_info
1149 std_info = mkStdInfoTable entry_amode
1150 ty_descr_amode cl_descr_amode cl_type srt_len layout_amode
1152 entry_amode = CLbl (entryLabelFromCI cl_info) CodePtrRep
1156 ClosureInfo { closureDescr = descr } -> descr
1157 ConInfo { closureCon = con } -> occNameUserString (getOccName con)
1159 ty_descr_amode = CLit (MachStr (mkFastString (closureTypeDescr cl_info)))
1160 cl_descr_amode = CLit (MachStr (mkFastString closure_descr))
1162 cl_type = getSMRepClosureTypeInt (closureSMRep cl_info)
1164 srt = closureSRT cl_info
1165 needs_srt = needsSRT srt
1167 semi_tag = closureSemiTag cl_info
1168 is_con = isJust semi_tag
1171 | Just tag <- semi_tag = (mkIntCLit 0, tag) -- constructor
1174 NoC_SRT -> (mkIntCLit 0, 0)
1175 C_SRT lbl off len ->
1176 (CAddr (CIndex (CLbl lbl DataPtrRep) (mkIntCLit off) WordRep),
1179 ptrs = closurePtrsSize cl_info
1181 size = closureNonHdrSize cl_info
1183 layout_info :: StgWord
1184 #ifdef WORDS_BIGENDIAN
1185 layout_info = (fromIntegral ptrs `shiftL` HALF_WORD) .|. fromIntegral nptrs
1187 layout_info = (fromIntegral ptrs) .|. (fromIntegral nptrs `shiftL` HALF_WORD)
1190 layout_amode = mkWordCLit layout_info
1193 | is_fun = fun_extra_bits
1195 | needs_srt = [srt_label]
1198 maybe_fun_stuff = closureFunInfo cl_info
1199 is_fun = isJust maybe_fun_stuff
1200 (Just (arity, arg_descr)) = maybe_fun_stuff
1203 | opt_Unregisterised = reverse reg_fun_extra_bits
1204 | otherwise = reg_fun_extra_bits
1207 | ArgGen slow_lbl liveness <- arg_descr
1209 CLbl slow_lbl CodePtrRep,
1210 livenessToAddrMode liveness,
1214 | needs_srt = [srt_label, fun_amode]
1215 | otherwise = [fun_amode]
1217 #ifdef WORDS_BIGENDIAN
1218 fun_desc = (fromIntegral fun_type `shiftL` HALF_WORD) .|. fromIntegral arity
1220 fun_desc = (fromIntegral fun_type) .|. (fromIntegral arity `shiftL` HALF_WORD)
1223 fun_amode = mkWordCLit fun_desc
1225 fun_type = case arg_descr of
1227 ArgGen _ (Liveness _ size _)
1228 | size <= mAX_SMALL_BITMAP_SIZE -> ARG_GEN
1229 | otherwise -> ARG_GEN_BIG
1231 -- Return info tables come in two flavours: direct returns and
1232 -- vectored returns.
1234 mkRetInfoTable :: CLabel -> C_SRT -> Liveness -> [CAddrMode]
1235 mkRetInfoTable entry_lbl srt liveness
1236 = mkBitmapInfoTable (CLbl entry_lbl CodePtrRep) srt liveness []
1238 mkVecInfoTable :: [CAddrMode] -> C_SRT -> Liveness -> [CAddrMode]
1239 mkVecInfoTable vector srt liveness
1240 = mkBitmapInfoTable zero_amode srt liveness vector
1244 -> C_SRT -> Liveness
1247 mkBitmapInfoTable entry_amode srt liveness vector
1248 | opt_Unregisterised = std_info ++ extra_bits
1249 | otherwise = extra_bits ++ std_info
1251 std_info = mkStdInfoTable entry_amode zero_amode zero_amode
1252 cl_type srt_len liveness_amode
1254 liveness_amode = livenessToAddrMode liveness
1256 (srt_label,srt_len) =
1258 NoC_SRT -> (mkIntCLit 0, 0)
1259 C_SRT lbl off len ->
1260 (CAddr (CIndex (CLbl lbl DataPtrRep) (mkIntCLit off) WordRep),
1263 cl_type = case (null vector, isBigLiveness liveness) of
1264 (True, True) -> rET_BIG
1265 (True, False) -> rET_SMALL
1266 (False, True) -> rET_VEC_BIG
1267 (False, False) -> rET_VEC_SMALL
1269 srt_bit | needsSRT srt || not (null vector) = [srt_label]
1272 extra_bits | opt_Unregisterised = srt_bit ++ vector
1273 | otherwise = reverse vector ++ srt_bit
1275 -- The standard bits of an info table. This part of the info table
1276 -- corresponds to the StgInfoTable type defined in InfoTables.h.
1279 :: CAddrMode -- entry label
1280 -> CAddrMode -- closure type descr (profiling)
1281 -> CAddrMode -- closure descr (profiling)
1282 -> Int -- closure type
1283 -> Int -- SRT length
1284 -> CAddrMode -- layout field
1286 mkStdInfoTable entry_lbl type_descr closure_descr cl_type srt_len layout_amode
1290 | opt_Unregisterised = entry_lbl : std_info'
1291 | otherwise = std_info'
1299 CLit (MachWord (fromIntegral type_info)) :
1303 | opt_SccProfilingOn = [ type_descr, closure_descr ]
1306 -- sigh: building up the info table is endian-dependent.
1307 -- ToDo: do this using .byte and .word directives.
1308 type_info :: StgWord
1309 #ifdef WORDS_BIGENDIAN
1310 type_info = (fromIntegral cl_type `shiftL` HALF_WORD) .|.
1311 (fromIntegral srt_len)
1313 type_info = (fromIntegral cl_type) .|.
1314 (fromIntegral srt_len `shiftL` HALF_WORD)
1317 isBigLiveness (Liveness _ size _) = size > mAX_SMALL_BITMAP_SIZE
1319 livenessToAddrMode :: Liveness -> CAddrMode
1320 livenessToAddrMode (Liveness lbl size bits)
1321 | size <= mAX_SMALL_BITMAP_SIZE = small
1322 | otherwise = CLbl lbl DataPtrRep
1324 small = mkWordCLit (fromIntegral size .|. (small_bits `shiftL` bITMAP_BITS_SHIFT))
1325 small_bits = case bits of
1327 [b] -> fromIntegral (intBS b)
1328 _ -> panic "livenessToAddrMode"
1330 mAX_SMALL_BITMAP_SIZE = (wORD_SIZE * 8) - bITMAP_BITS_SHIFT
1332 mkWordCLit :: StgWord -> CAddrMode
1333 mkWordCLit wd = CLit (MachWord (fromIntegral wd))
1335 zero_amode = mkIntCLit 0