2 % (c) The University of Glasgow 2006
3 % (c) The Univserity of Glasgow 1992-2004
6 Data structures which describe closures, and
7 operations over those data structures
9 Nothing monadic in here
11 Much of the rationale for these things is in the ``details'' part of
16 ClosureInfo(..), LambdaFormInfo(..), -- would be abstract but
17 StandardFormInfo(..), -- mkCmmInfo looks inside
20 ArgDescr(..), Liveness(..),
23 mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,
24 mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
26 mkClosureInfo, mkConInfo, maybeIsLFCon,
28 closureSize, closureNonHdrSize,
29 closureGoodStuffSize, closurePtrsSize,
34 isLFThunk, closureUpdReqd,
35 closureNeedsUpdSpace, closureIsThunk,
36 closureSingleEntry, closureReEntrant, isConstrClosure_maybe,
37 closureFunInfo, isStandardFormThunk, isKnownFun,
38 funTag, funTagLFInfo, tagForArity,
40 enterIdLabel, enterLocalIdLabel, enterReturnPtLabel,
43 CallMethod(..), getCallMethod,
47 staticClosureRequired,
51 closureValDescr, closureTypeDescr, -- profiling
54 cafBlackHoleClosureInfo,
56 staticClosureNeedsLink,
59 #include "../includes/MachDeps.h"
60 #include "HsVersions.h"
88 %************************************************************************
90 \subsection[ClosureInfo-datatypes]{Data types for closure information}
92 %************************************************************************
94 Information about a closure, from the code generator's point of view.
96 A ClosureInfo decribes the info pointer of a closure. It has
98 a) to construct the info table itself
99 b) to allocate a closure containing that info pointer (i.e.
100 it knows the info table label)
102 We make a ClosureInfo for
103 - each let binding (both top level and not)
104 - each data constructor (for its shared static and
110 closureName :: !Name, -- The thing bound to this closure
111 closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon (see below)
112 closureSMRep :: !SMRep, -- representation used by storage mgr
113 closureSRT :: !C_SRT, -- What SRT applies to this closure
114 closureType :: !Type, -- Type of closure (ToDo: remove)
115 closureDescr :: !String -- closure description (for profiling)
118 -- Constructor closures don't have a unique info table label (they use
119 -- the constructor's info table), and they don't have an SRT.
121 closureCon :: !DataCon,
122 closureSMRep :: !SMRep
125 -- C_SRT is what StgSyn.SRT gets translated to...
126 -- we add a label for the table, and expect only the 'offset/length' form
129 | C_SRT !CLabel !WordOff !StgHalfWord {-bitmap or escape-}
132 needsSRT :: C_SRT -> Bool
133 needsSRT NoC_SRT = False
134 needsSRT (C_SRT _ _ _) = True
136 instance Outputable C_SRT where
137 ppr (NoC_SRT) = ptext (sLit "_no_srt_")
138 ppr (C_SRT label off bitmap) = parens (ppr label <> comma <> ppr off <> comma <> text (show bitmap))
141 %************************************************************************
143 \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
145 %************************************************************************
147 Information about an identifier, from the code generator's point of
148 view. Every identifier is bound to a LambdaFormInfo in the
149 environment, which gives the code generator enough info to be able to
150 tail call or return that identifier.
152 Note that a closure is usually bound to an identifier, so a
153 ClosureInfo contains a LambdaFormInfo.
157 = LFReEntrant -- Reentrant closure (a function)
158 TopLevelFlag -- True if top level
159 !Int -- Arity. Invariant: always > 0
160 !Bool -- True <=> no fvs
161 ArgDescr -- Argument descriptor (should reall be in ClosureInfo)
163 | LFCon -- A saturated constructor application
164 DataCon -- The constructor
166 | LFThunk -- Thunk (zero arity)
168 !Bool -- True <=> no free vars
169 !Bool -- True <=> updatable (i.e., *not* single-entry)
171 !Bool -- True <=> *might* be a function type
173 | LFUnknown -- Used for function arguments and imported things.
174 -- We know nothing about this closure. Treat like
175 -- updatable "LFThunk"...
176 -- Imported things which we do know something about use
177 -- one of the other LF constructors (eg LFReEntrant for
179 !Bool -- True <=> *might* be a function type
181 | LFLetNoEscape -- See LetNoEscape module for precise description of
185 | LFBlackHole -- Used for the closures allocated to hold the result
186 -- of a CAF. We want the target of the update frame to
187 -- be in the heap, so we make a black hole to hold it.
188 CLabel -- Flavour (info label, eg CAF_BLACKHOLE_info).
191 -------------------------
192 -- An ArgDsecr describes the argument pattern of a function
195 = ArgSpec -- Fits one of the standard patterns
196 !StgHalfWord -- RTS type identifier ARG_P, ARG_N, ...
198 | ArgGen -- General case
199 Liveness -- Details about the arguments
202 -------------------------
203 -- We represent liveness bitmaps as a Bitmap (whose internal
204 -- representation really is a bitmap). These are pinned onto case return
205 -- vectors to indicate the state of the stack for the garbage collector.
207 -- In the compiled program, liveness bitmaps that fit inside a single
208 -- word (StgWord) are stored as a single word, while larger bitmaps are
209 -- stored as a pointer to an array of words.
212 = SmallLiveness -- Liveness info that fits in one word
213 StgWord -- Here's the bitmap
215 | BigLiveness -- Liveness info witha a multi-word bitmap
216 CLabel -- Label for the bitmap
219 -------------------------
220 -- StandardFormInfo tells whether this thunk has one of
221 -- a small number of standard forms
223 data StandardFormInfo
225 -- Not of of the standard forms
228 -- A SelectorThunk is of form
230 -- con a1,..,an -> ak
231 -- and the constructor is from a single-constr type.
232 WordOff -- 0-origin offset of ak within the "goods" of
233 -- constructor (Recall that the a1,...,an may be laid
234 -- out in the heap in a non-obvious order.)
237 -- An ApThunk is of form
239 -- The code for the thunk just pushes x2..xn on the stack and enters x1.
240 -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
241 -- in the RTS to save space.
245 %************************************************************************
247 \subsection[ClosureInfo-construction]{Functions which build LFInfos}
249 %************************************************************************
252 mkLFReEntrant :: TopLevelFlag -- True of top level
255 -> ArgDescr -- Argument descriptor
258 mkLFReEntrant top fvs args arg_descr
259 = LFReEntrant top (length args) (null fvs) arg_descr
261 mkLFThunk :: Type -> TopLevelFlag -> [Var] -> UpdateFlag -> LambdaFormInfo
262 mkLFThunk thunk_ty top fvs upd_flag
263 = ASSERT2( not (isUpdatable upd_flag) || not (isUnLiftedType thunk_ty), ppr thunk_ty $$ ppr fvs )
264 LFThunk top (null fvs)
265 (isUpdatable upd_flag)
267 (might_be_a_function thunk_ty)
269 might_be_a_function :: Type -> Bool
270 -- Return False only if we are *sure* it's a data type
271 -- Look through newtypes etc as much as poss
272 might_be_a_function ty
273 = case splitTyConApp_maybe (repType ty) of
274 Just (tc, _) -> not (isDataTyCon tc)
278 @mkConLFInfo@ is similar, for constructors.
281 mkConLFInfo :: DataCon -> LambdaFormInfo
282 mkConLFInfo con = LFCon con
284 maybeIsLFCon :: LambdaFormInfo -> Maybe DataCon
285 maybeIsLFCon (LFCon con) = Just con
286 maybeIsLFCon _ = Nothing
288 mkSelectorLFInfo :: Id -> WordOff -> Bool -> LambdaFormInfo
289 mkSelectorLFInfo id offset updatable
290 = LFThunk NotTopLevel False updatable (SelectorThunk offset)
291 (might_be_a_function (idType id))
293 mkApLFInfo :: Id -> UpdateFlag -> Int -> LambdaFormInfo
294 mkApLFInfo id upd_flag arity
295 = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)
296 (might_be_a_function (idType id))
299 Miscellaneous LF-infos.
302 mkLFArgument :: Id -> LambdaFormInfo
303 mkLFArgument id = LFUnknown (might_be_a_function (idType id))
305 mkLFLetNoEscape :: Int -> LambdaFormInfo
306 mkLFLetNoEscape = LFLetNoEscape
308 mkLFImported :: Id -> LambdaFormInfo
311 n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr") -- n > 0
312 _ -> mkLFArgument id -- Not sure of exact arity
316 isLFThunk :: LambdaFormInfo -> Bool
317 isLFThunk (LFThunk _ _ _ _ _) = True
318 isLFThunk (LFBlackHole _) = True
319 -- return True for a blackhole: this function is used to determine
320 -- whether to use the thunk header in SMP mode, and a blackhole
325 %************************************************************************
327 Building ClosureInfos
329 %************************************************************************
332 mkClosureInfo :: Bool -- Is static
335 -> Int -> Int -- Total and pointer words
337 -> String -- String descriptor
339 mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr
340 = ClosureInfo { closureName = name,
341 closureLFInfo = lf_info,
342 closureSMRep = sm_rep,
343 closureSRT = srt_info,
344 closureType = idType id,
345 closureDescr = descr }
348 sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds
350 mkConInfo :: Bool -- Is static
352 -> Int -> Int -- Total and pointer words
354 mkConInfo is_static data_con tot_wds ptr_wds
355 = ConInfo { closureSMRep = sm_rep,
356 closureCon = data_con }
358 sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds
361 %************************************************************************
363 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
365 %************************************************************************
368 closureSize :: ClosureInfo -> WordOff
369 closureSize cl_info = hdr_size + closureNonHdrSize cl_info
370 where hdr_size | closureIsThunk cl_info = thunkHdrSize
371 | otherwise = fixedHdrSize
372 -- All thunks use thunkHdrSize, even if they are non-updatable.
373 -- this is because we don't have separate closure types for
374 -- updatable vs. non-updatable thunks, so the GC can't tell the
375 -- difference. If we ever have significant numbers of non-
376 -- updatable thunks, it might be worth fixing this.
378 closureNonHdrSize :: ClosureInfo -> WordOff
379 closureNonHdrSize cl_info
380 = tot_wds + computeSlopSize tot_wds cl_info
382 tot_wds = closureGoodStuffSize cl_info
384 closureGoodStuffSize :: ClosureInfo -> WordOff
385 closureGoodStuffSize cl_info
386 = let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info)
389 closurePtrsSize :: ClosureInfo -> WordOff
390 closurePtrsSize cl_info
391 = let (ptrs, _) = sizes_from_SMRep (closureSMRep cl_info)
395 sizes_from_SMRep :: SMRep -> (WordOff,WordOff)
396 sizes_from_SMRep (GenericRep _ ptrs nonptrs _) = (ptrs, nonptrs)
397 sizes_from_SMRep BlackHoleRep = (0, 0)
400 Computing slop size. WARNING: this looks dodgy --- it has deep
401 knowledge of what the storage manager does with the various
404 Slop Requirements: every thunk gets an extra padding word in the
405 header, which takes the the updated value.
408 slopSize :: ClosureInfo -> WordOff
409 slopSize cl_info = computeSlopSize payload_size cl_info
410 where payload_size = closureGoodStuffSize cl_info
412 computeSlopSize :: WordOff -> ClosureInfo -> WordOff
413 computeSlopSize payload_size cl_info
414 = max 0 (minPayloadSize smrep updatable - payload_size)
416 smrep = closureSMRep cl_info
417 updatable = closureNeedsUpdSpace cl_info
419 -- we leave space for an update if either (a) the closure is updatable
420 -- or (b) it is a static thunk. This is because a static thunk needs
421 -- a static link field in a predictable place (after the slop), regardless
422 -- of whether it is updatable or not.
423 closureNeedsUpdSpace :: ClosureInfo -> Bool
424 closureNeedsUpdSpace (ClosureInfo { closureLFInfo =
425 LFThunk TopLevel _ _ _ _ }) = True
426 closureNeedsUpdSpace cl_info = closureUpdReqd cl_info
428 minPayloadSize :: SMRep -> Bool -> WordOff
429 minPayloadSize smrep updatable
431 BlackHoleRep -> min_upd_size
432 GenericRep _ _ _ _ | updatable -> min_upd_size
433 GenericRep True _ _ _ -> 0 -- static
434 GenericRep False _ _ _ -> mIN_PAYLOAD_SIZE
438 ASSERT(mIN_PAYLOAD_SIZE <= sIZEOF_StgSMPThunkHeader)
439 0 -- check that we already have enough
440 -- room for mIN_SIZE_NonUpdHeapObject,
441 -- due to the extra header word in SMP
444 %************************************************************************
446 \subsection[SMreps]{Choosing SM reps}
448 %************************************************************************
452 :: Bool -- True <=> static closure
454 -> WordOff -> WordOff -- Tot wds, ptr wds
457 chooseSMRep is_static lf_info tot_wds ptr_wds
459 nonptr_wds = tot_wds - ptr_wds
460 closure_type = getClosureType is_static ptr_wds lf_info
462 GenericRep is_static ptr_wds nonptr_wds closure_type
464 -- We *do* get non-updatable top-level thunks sometimes. eg. f = g
465 -- gets compiled to a jump to g (if g has non-zero arity), instead of
466 -- messing around with update frames and PAPs. We set the closure type
467 -- to FUN_STATIC in this case.
469 getClosureType :: Bool -> WordOff -> LambdaFormInfo -> ClosureType
470 getClosureType is_static ptr_wds lf_info
472 LFCon _ | is_static && ptr_wds == 0 -> ConstrNoCaf
473 | otherwise -> Constr
474 LFReEntrant _ _ _ _ -> Fun
475 LFThunk _ _ _ (SelectorThunk _) _ -> ThunkSelector
476 LFThunk _ _ _ _ _ -> Thunk
477 _ -> panic "getClosureType"
480 %************************************************************************
482 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
484 %************************************************************************
486 Be sure to see the stg-details notes about these...
489 nodeMustPointToIt :: LambdaFormInfo -> Bool
490 nodeMustPointToIt (LFReEntrant top _ no_fvs _)
491 = not no_fvs || -- Certainly if it has fvs we need to point to it
493 -- If it is not top level we will point to it
494 -- We can have a \r closure with no_fvs which
495 -- is not top level as special case cgRhsClosure
496 -- has been dissabled in favour of let floating
498 -- For lex_profiling we also access the cost centre for a
499 -- non-inherited function i.e. not top level
500 -- the not top case above ensures this is ok.
502 nodeMustPointToIt (LFCon _) = True
504 -- Strictly speaking, the above two don't need Node to point
505 -- to it if the arity = 0. But this is a *really* unlikely
506 -- situation. If we know it's nil (say) and we are entering
507 -- it. Eg: let x = [] in x then we will certainly have inlined
508 -- x, since nil is a simple atom. So we gain little by not
509 -- having Node point to known zero-arity things. On the other
510 -- hand, we do lose something; Patrick's code for figuring out
511 -- when something has been updated but not entered relies on
512 -- having Node point to the result of an update. SLPJ
515 nodeMustPointToIt (LFThunk _ no_fvs updatable NonStandardThunk _)
516 = updatable || not no_fvs || opt_SccProfilingOn
517 -- For the non-updatable (single-entry case):
519 -- True if has fvs (in which case we need access to them, and we
520 -- should black-hole it)
521 -- or profiling (in which case we need to recover the cost centre
524 nodeMustPointToIt (LFThunk _ _ _ _ _)
525 = True -- Node must point to any standard-form thunk
527 nodeMustPointToIt (LFUnknown _) = True
528 nodeMustPointToIt (LFBlackHole _) = True -- BH entry may require Node to point
529 nodeMustPointToIt (LFLetNoEscape _) = False
532 The entry conventions depend on the type of closure being entered,
533 whether or not it has free variables, and whether we're running
534 sequentially or in parallel.
536 \begin{tabular}{lllll}
537 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
538 Unknown & no & yes & stack & node \\
539 Known fun ($\ge$ 1 arg), no fvs & no & no & registers & fast entry (enough args) \\
540 \ & \ & \ & \ & slow entry (otherwise) \\
541 Known fun ($\ge$ 1 arg), fvs & no & yes & registers & fast entry (enough args) \\
542 0 arg, no fvs @\r,\s@ & no & no & n/a & direct entry \\
543 0 arg, no fvs @\u@ & no & yes & n/a & node \\
544 0 arg, fvs @\r,\s@ & no & yes & n/a & direct entry \\
545 0 arg, fvs @\u@ & no & yes & n/a & node \\
547 Unknown & yes & yes & stack & node \\
548 Known fun ($\ge$ 1 arg), no fvs & yes & no & registers & fast entry (enough args) \\
549 \ & \ & \ & \ & slow entry (otherwise) \\
550 Known fun ($\ge$ 1 arg), fvs & yes & yes & registers & node \\
551 0 arg, no fvs @\r,\s@ & yes & no & n/a & direct entry \\
552 0 arg, no fvs @\u@ & yes & yes & n/a & node \\
553 0 arg, fvs @\r,\s@ & yes & yes & n/a & node \\
554 0 arg, fvs @\u@ & yes & yes & n/a & node\\
557 When black-holing, single-entry closures could also be entered via node
558 (rather than directly) to catch double-entry.
562 = EnterIt -- no args, not a function
564 | JumpToIt CLabel -- no args, not a function, but we
565 -- know what its entry code is
567 | ReturnIt -- it's a function, but we have
568 -- zero args to apply to it, so just
571 | ReturnCon DataCon -- It's a data constructor, just return it
573 | SlowCall -- Unknown fun, or known fun with
576 | DirectEntry -- Jump directly, with args in regs
577 CLabel -- The code label
580 getCallMethod :: DynFlags
581 -> Name -- Function being applied
582 -> CafInfo -- Can it refer to CAF's?
583 -> LambdaFormInfo -- Its info
584 -> Int -- Number of available arguments
587 getCallMethod _ _ _ lf_info _
588 | nodeMustPointToIt lf_info && opt_Parallel
589 = -- If we're parallel, then we must always enter via node.
590 -- The reason is that the closure may have been
591 -- fetched since we allocated it.
594 getCallMethod _ name caf (LFReEntrant _ arity _ _) n_args
595 | n_args == 0 = ASSERT( arity /= 0 )
596 ReturnIt -- No args at all
597 | n_args < arity = SlowCall -- Not enough args
598 | otherwise = DirectEntry (enterIdLabel name caf) arity
600 getCallMethod _ _ _ (LFCon con) n_args
601 = ASSERT( n_args == 0 )
604 getCallMethod dflags name caf (LFThunk _ _ updatable std_form_info is_fun) n_args
605 | is_fun -- it *might* be a function, so we must "call" it (which is
607 = SlowCall -- We cannot just enter it [in eval/apply, the entry code
608 -- is the fast-entry code]
610 -- Since is_fun is False, we are *definitely* looking at a data value
611 | updatable || doingTickyProfiling dflags -- to catch double entry
613 I decided to remove this, because in SMP mode it doesn't matter
614 if we enter the same thunk multiple times, so the optimisation
615 of jumping directly to the entry code is still valid. --SDM
618 -- We used to have ASSERT( n_args == 0 ), but actually it is
619 -- possible for the optimiser to generate
620 -- let bot :: Int = error Int "urk"
621 -- in (bot `cast` unsafeCoerce Int (Int -> Int)) 3
622 -- This happens as a result of the case-of-error transformation
623 -- So the right thing to do is just to enter the thing
625 | otherwise -- Jump direct to code for single-entry thunks
626 = ASSERT( n_args == 0 )
627 JumpToIt (thunkEntryLabel name caf std_form_info updatable)
629 getCallMethod _ _ _ (LFUnknown True) _
630 = SlowCall -- Might be a function
632 getCallMethod _ name _ (LFUnknown False) n_args
634 = WARN( True, ppr name <+> ppr n_args )
635 SlowCall -- Note [Unsafe coerce complications]
638 = EnterIt -- Not a function
640 getCallMethod _ _ _ (LFBlackHole _) _
641 = SlowCall -- Presumably the black hole has by now
642 -- been updated, but we don't know with
643 -- what, so we slow call it
645 getCallMethod _ name _ (LFLetNoEscape 0) _
646 = JumpToIt (enterReturnPtLabel (nameUnique name))
648 getCallMethod _ name _ (LFLetNoEscape arity) n_args
649 | n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity
650 | otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity)
652 blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool
653 -- Static closures are never themselves black-holed.
654 -- Updatable ones will be overwritten with a CAFList cell, which points to a
656 -- Single-entry ones have no fvs to plug, and we trust they don't form part
659 blackHoleOnEntry _ ConInfo{} = False
660 blackHoleOnEntry dflags (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
662 = False -- Never black-hole a static closure
666 LFReEntrant _ _ _ _ -> False
667 LFLetNoEscape _ -> False
668 LFThunk _ no_fvs updatable _ _
670 then not opt_OmitBlackHoling
671 else doingTickyProfiling dflags || not no_fvs
672 -- the former to catch double entry,
673 -- and the latter to plug space-leaks. KSW/SDM 1999-04.
675 _ -> panic "blackHoleOnEntry" -- Should never happen
677 isStandardFormThunk :: LambdaFormInfo -> Bool
678 isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
679 isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _) = True
680 isStandardFormThunk _ = False
682 isKnownFun :: LambdaFormInfo -> Bool
683 isKnownFun (LFReEntrant _ _ _ _) = True
684 isKnownFun (LFLetNoEscape _) = True
688 Note [Unsafe coerce complications]
689 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
690 In some (badly-optimised) DPH code we see this
691 Module X: rr :: Int = error Int "Urk"
692 Module Y: ...((X.rr |> g) True) ...
693 where g is an (unsafe) coercion of kind (Int ~ Bool->Bool), say
695 It's badly optimised, because knowing that 'X.rr' is bottom, we should
696 have dumped the application to True. But it should still work. These
697 strange unsafe coercions arise from the case-of-error transformation:
698 (case (error Int "foo") of { ... }) True
699 ---> (error Int "foo" |> g) True
701 Anyway, the net effect is that in STG-land, when casts are discarded,
702 we *can* see a value of type Int applied to an argument. This only happens
703 if (a) the programmer made a mistake, or (b) the value of type Int is
706 So it's wrong to trigger an ASSERT failure in this circumstance. Instead
707 we now emit a WARN -- mainly to draw attention to a probably-badly-optimised
708 program fragment -- and do the conservative thing which is SlowCall.
711 -----------------------------------------------------------------------------
715 staticClosureNeedsLink :: ClosureInfo -> Bool
716 -- A static closure needs a link field to aid the GC when traversing
717 -- the static closure graph. But it only needs such a field if either
719 -- b) it's a constructor with one or more pointer fields
720 -- In case (b), the constructor's fields themselves play the role
722 staticClosureNeedsLink (ClosureInfo { closureSRT = srt })
724 staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })
725 = not (isNullaryRepDataCon con) && not_nocaf_constr
729 GenericRep _ _ _ ConstrNoCaf -> False
733 Note [Entering error thunks]
734 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
738 fail = error Int "Urk"
741 foo True y = (fail `cast` Bool -> Bool) y
744 This looks silly, but it can arise from case-of-error. Even if it
745 does, we'd usually see that 'fail' is a bottoming function and would
746 discard the extra argument 'y'. But even if that does not occur,
747 this program is still OK. We will enter 'fail', which never returns.
749 The WARN is just to alert me to the fact that we aren't spotting that
752 (We are careful never to make a funtion value look like a data type,
753 because we can't enter a function closure -- but that is not the
757 Avoiding generating entries and info tables
758 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
759 At present, for every function we generate all of the following,
760 just in case. But they aren't always all needed, as noted below:
762 [NB1: all of this applies only to *functions*. Thunks always
763 have closure, info table, and entry code.]
765 [NB2: All are needed if the function is *exported*, just to play safe.]
768 * Fast-entry code ALWAYS NEEDED
771 Needed iff (a) we have any un-saturated calls to the function
772 OR (b) the function is passed as an arg
773 OR (c) we're in the parallel world and the function has free vars
774 [Reason: in parallel world, we always enter functions
775 with free vars via the closure.]
777 * The function closure
778 Needed iff (a) we have any un-saturated calls to the function
779 OR (b) the function is passed as an arg
780 OR (c) if the function has free vars (ie not top level)
782 Why case (a) here? Because if the arg-satis check fails,
783 UpdatePAP stuffs a pointer to the function closure in the PAP.
784 [Could be changed; UpdatePAP could stuff in a code ptr instead,
785 but doesn't seem worth it.]
787 [NB: these conditions imply that we might need the closure
788 without the slow-entry code. Here's how.
790 f x y = let g w = ...x..y..w...
794 Here we need a closure for g which contains x and y,
795 but since the calls are all saturated we just jump to the
796 fast entry point for g, with R1 pointing to the closure for g.]
799 * Standard info table
800 Needed iff (a) we have any un-saturated calls to the function
801 OR (b) the function is passed as an arg
802 OR (c) the function has free vars (ie not top level)
804 NB. In the sequential world, (c) is only required so that the function closure has
805 an info table to point to, to keep the storage manager happy.
806 If (c) alone is true we could fake up an info table by choosing
807 one of a standard family of info tables, whose entry code just
810 [NB In the parallel world (c) is needed regardless because
811 we enter functions with free vars via the closure.]
813 If (c) is retained, then we'll sometimes generate an info table
814 (for storage mgr purposes) without slow-entry code. Then we need
815 to use an error label in the info table to substitute for the absent
819 staticClosureRequired
824 staticClosureRequired _ bndr_info
825 (LFReEntrant top_level _ _ _) -- It's a function
826 = ASSERT( isTopLevel top_level )
827 -- Assumption: it's a top-level, no-free-var binding
828 not (satCallsOnly bndr_info)
830 staticClosureRequired _ _ _ = True
833 %************************************************************************
835 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
837 %************************************************************************
841 isStaticClosure :: ClosureInfo -> Bool
842 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
844 closureUpdReqd :: ClosureInfo -> Bool
845 closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info
846 closureUpdReqd ConInfo{} = False
848 lfUpdatable :: LambdaFormInfo -> Bool
849 lfUpdatable (LFThunk _ _ upd _ _) = upd
850 lfUpdatable (LFBlackHole _) = True
851 -- Black-hole closures are allocated to receive the results of an
852 -- alg case with a named default... so they need to be updated.
853 lfUpdatable _ = False
855 closureIsThunk :: ClosureInfo -> Bool
856 closureIsThunk ClosureInfo{ closureLFInfo = lf_info } = isLFThunk lf_info
857 closureIsThunk ConInfo{} = False
859 closureSingleEntry :: ClosureInfo -> Bool
860 closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
861 closureSingleEntry _ = False
863 closureReEntrant :: ClosureInfo -> Bool
864 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
865 closureReEntrant _ = False
867 isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon
868 isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con
869 isConstrClosure_maybe _ = Nothing
871 closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
872 closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info
873 closureFunInfo _ = Nothing
875 lfFunInfo :: LambdaFormInfo -> Maybe (Int, ArgDescr)
876 lfFunInfo (LFReEntrant _ arity _ arg_desc) = Just (arity, arg_desc)
877 lfFunInfo _ = Nothing
879 funTag :: ClosureInfo -> Int
880 funTag (ClosureInfo { closureLFInfo = lf_info }) = funTagLFInfo lf_info
883 -- maybe this should do constructor tags too?
884 funTagLFInfo :: LambdaFormInfo -> Int
886 -- A function is tagged with its arity
887 | Just (arity,_) <- lfFunInfo lf,
888 Just tag <- tagForArity arity
891 -- other closures (and unknown ones) are not tagged
895 tagForArity :: Int -> Maybe Int
896 tagForArity i | i <= mAX_PTR_TAG = Just i
897 | otherwise = Nothing
901 isToplevClosure :: ClosureInfo -> Bool
902 isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
904 LFReEntrant TopLevel _ _ _ -> True
905 LFThunk TopLevel _ _ _ _ -> True
907 isToplevClosure _ = False
913 infoTableLabelFromCI :: ClosureInfo -> CafInfo -> CLabel
914 infoTableLabelFromCI (ClosureInfo { closureName = name,
915 closureLFInfo = lf_info }) caf
917 LFBlackHole info -> info
919 LFThunk _ _ upd_flag (SelectorThunk offset) _ ->
920 mkSelectorInfoLabel upd_flag offset
922 LFThunk _ _ upd_flag (ApThunk arity) _ ->
923 mkApInfoTableLabel upd_flag arity
925 LFThunk{} -> mkLocalInfoTableLabel name caf
927 LFReEntrant _ _ _ _ -> mkLocalInfoTableLabel name caf
929 _ -> panic "infoTableLabelFromCI"
931 infoTableLabelFromCI (ConInfo { closureCon = con,
932 closureSMRep = rep }) caf
933 | isStaticRep rep = mkStaticInfoTableLabel name caf
934 | otherwise = mkConInfoTableLabel name caf
936 name = dataConName con
938 -- ClosureInfo for a closure (as opposed to a constructor) is always local
939 closureLabelFromCI :: ClosureInfo -> CafInfo -> CLabel
940 closureLabelFromCI (ClosureInfo { closureName = nm }) caf = mkLocalClosureLabel nm caf
941 closureLabelFromCI _ _ = panic "closureLabelFromCI"
943 -- thunkEntryLabel is a local help function, not exported. It's used from both
944 -- entryLabelFromCI and getCallMethod.
946 thunkEntryLabel :: Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel
947 thunkEntryLabel _thunk_id _ (ApThunk arity) is_updatable
948 = enterApLabel is_updatable arity
949 thunkEntryLabel _thunk_id _ (SelectorThunk offset) upd_flag
950 = enterSelectorLabel upd_flag offset
951 thunkEntryLabel thunk_id caf _ _is_updatable
952 = enterIdLabel thunk_id caf
954 enterApLabel :: Bool -> Int -> CLabel
955 enterApLabel is_updatable arity
956 | tablesNextToCode = mkApInfoTableLabel is_updatable arity
957 | otherwise = mkApEntryLabel is_updatable arity
959 enterSelectorLabel :: Bool -> Int -> CLabel
960 enterSelectorLabel upd_flag offset
961 | tablesNextToCode = mkSelectorInfoLabel upd_flag offset
962 | otherwise = mkSelectorEntryLabel upd_flag offset
964 enterIdLabel :: Name -> CafInfo -> CLabel
966 | tablesNextToCode = mkInfoTableLabel id
967 | otherwise = mkEntryLabel id
969 enterLocalIdLabel :: Name -> CafInfo -> CLabel
971 | tablesNextToCode = mkLocalInfoTableLabel id
972 | otherwise = mkLocalEntryLabel id
974 enterReturnPtLabel :: Unique -> CLabel
975 enterReturnPtLabel name
976 | tablesNextToCode = mkReturnInfoLabel name
977 | otherwise = mkReturnPtLabel name
981 We need a black-hole closure info to pass to @allocDynClosure@ when we
982 want to allocate the black hole on entry to a CAF. These are the only
983 ways to build an LFBlackHole, maintaining the invariant that it really
984 is a black hole and not something else.
987 cafBlackHoleClosureInfo :: ClosureInfo -> ClosureInfo
988 cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
990 = ClosureInfo { closureName = nm,
991 closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel,
992 closureSMRep = BlackHoleRep,
993 closureSRT = NoC_SRT,
996 cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
999 %************************************************************************
1001 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
1003 %************************************************************************
1005 Profiling requires two pieces of information to be determined for
1006 each closure's info table --- description and type.
1008 The description is stored directly in the @CClosureInfoTable@ when the
1009 info table is built.
1011 The type is determined from the type information stored with the @Id@
1012 in the closure info using @closureTypeDescr@.
1015 closureValDescr, closureTypeDescr :: ClosureInfo -> String
1016 closureValDescr (ClosureInfo {closureDescr = descr})
1018 closureValDescr (ConInfo {closureCon = con})
1019 = occNameString (getOccName con)
1021 closureTypeDescr (ClosureInfo { closureType = ty })
1022 = getTyDescription ty
1023 closureTypeDescr (ConInfo { closureCon = data_con })
1024 = occNameString (getOccName (dataConTyCon data_con))
1026 getTyDescription :: Type -> String
1028 = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
1031 AppTy fun _ -> getTyDescription fun
1032 FunTy _ res -> '-' : '>' : fun_result res
1033 TyConApp tycon _ -> getOccString tycon
1034 PredTy sty -> getPredTyDescription sty
1035 ForAllTy _ ty -> getTyDescription ty
1038 fun_result (FunTy _ res) = '>' : fun_result res
1039 fun_result other = getTyDescription other
1041 getPredTyDescription :: PredType -> String
1042 getPredTyDescription (ClassP cl _) = getOccString cl
1043 getPredTyDescription (IParam ip _) = getOccString (ipNameName ip)
1044 getPredTyDescription (EqPred _ _) = panic "getPredTyDescription EqPred"