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 | opt_SccProfilingOn -- when profiling, we must always enter
602 = EnterIt -- a closure when we use it, so that the closure
603 -- can be recorded as used for LDV profiling.
605 = ASSERT( n_args == 0 )
608 getCallMethod dflags name caf (LFThunk _ _ updatable std_form_info is_fun) n_args
609 | is_fun -- it *might* be a function, so we must "call" it (which is
611 = SlowCall -- We cannot just enter it [in eval/apply, the entry code
612 -- is the fast-entry code]
614 -- Since is_fun is False, we are *definitely* looking at a data value
615 | updatable || doingTickyProfiling dflags -- to catch double entry
617 I decided to remove this, because in SMP mode it doesn't matter
618 if we enter the same thunk multiple times, so the optimisation
619 of jumping directly to the entry code is still valid. --SDM
622 -- We used to have ASSERT( n_args == 0 ), but actually it is
623 -- possible for the optimiser to generate
624 -- let bot :: Int = error Int "urk"
625 -- in (bot `cast` unsafeCoerce Int (Int -> Int)) 3
626 -- This happens as a result of the case-of-error transformation
627 -- So the right thing to do is just to enter the thing
629 | otherwise -- Jump direct to code for single-entry thunks
630 = ASSERT( n_args == 0 )
631 JumpToIt (thunkEntryLabel name caf std_form_info updatable)
633 getCallMethod _ _ _ (LFUnknown True) _
634 = SlowCall -- Might be a function
636 getCallMethod _ name _ (LFUnknown False) n_args
638 = WARN( True, ppr name <+> ppr n_args )
639 SlowCall -- Note [Unsafe coerce complications]
642 = EnterIt -- Not a function
644 getCallMethod _ _ _ (LFBlackHole _) _
645 = SlowCall -- Presumably the black hole has by now
646 -- been updated, but we don't know with
647 -- what, so we slow call it
649 getCallMethod _ name _ (LFLetNoEscape 0) _
650 = JumpToIt (enterReturnPtLabel (nameUnique name))
652 getCallMethod _ name _ (LFLetNoEscape arity) n_args
653 | n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity
654 | otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity)
656 blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool
657 -- Static closures are never themselves black-holed.
658 -- Updatable ones will be overwritten with a CAFList cell, which points to a
660 -- Single-entry ones have no fvs to plug, and we trust they don't form part
663 blackHoleOnEntry _ ConInfo{} = False
664 blackHoleOnEntry dflags (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
666 = False -- Never black-hole a static closure
670 LFReEntrant _ _ _ _ -> False
671 LFLetNoEscape _ -> False
672 LFThunk _ no_fvs updatable _ _
674 then not opt_OmitBlackHoling
675 else doingTickyProfiling dflags || not no_fvs
676 -- the former to catch double entry,
677 -- and the latter to plug space-leaks. KSW/SDM 1999-04.
679 _ -> panic "blackHoleOnEntry" -- Should never happen
681 isStandardFormThunk :: LambdaFormInfo -> Bool
682 isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
683 isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _) = True
684 isStandardFormThunk _ = False
686 isKnownFun :: LambdaFormInfo -> Bool
687 isKnownFun (LFReEntrant _ _ _ _) = True
688 isKnownFun (LFLetNoEscape _) = True
692 Note [Unsafe coerce complications]
693 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
694 In some (badly-optimised) DPH code we see this
695 Module X: rr :: Int = error Int "Urk"
696 Module Y: ...((X.rr |> g) True) ...
697 where g is an (unsafe) coercion of kind (Int ~ Bool->Bool), say
699 It's badly optimised, because knowing that 'X.rr' is bottom, we should
700 have dumped the application to True. But it should still work. These
701 strange unsafe coercions arise from the case-of-error transformation:
702 (case (error Int "foo") of { ... }) True
703 ---> (error Int "foo" |> g) True
705 Anyway, the net effect is that in STG-land, when casts are discarded,
706 we *can* see a value of type Int applied to an argument. This only happens
707 if (a) the programmer made a mistake, or (b) the value of type Int is
710 So it's wrong to trigger an ASSERT failure in this circumstance. Instead
711 we now emit a WARN -- mainly to draw attention to a probably-badly-optimised
712 program fragment -- and do the conservative thing which is SlowCall.
715 -----------------------------------------------------------------------------
719 staticClosureNeedsLink :: ClosureInfo -> Bool
720 -- A static closure needs a link field to aid the GC when traversing
721 -- the static closure graph. But it only needs such a field if either
723 -- b) it's a constructor with one or more pointer fields
724 -- In case (b), the constructor's fields themselves play the role
726 staticClosureNeedsLink (ClosureInfo { closureSRT = srt })
728 staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })
729 = not (isNullaryRepDataCon con) && not_nocaf_constr
733 GenericRep _ _ _ ConstrNoCaf -> False
737 Note [Entering error thunks]
738 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
742 fail = error Int "Urk"
745 foo True y = (fail `cast` Bool -> Bool) y
748 This looks silly, but it can arise from case-of-error. Even if it
749 does, we'd usually see that 'fail' is a bottoming function and would
750 discard the extra argument 'y'. But even if that does not occur,
751 this program is still OK. We will enter 'fail', which never returns.
753 The WARN is just to alert me to the fact that we aren't spotting that
756 (We are careful never to make a funtion value look like a data type,
757 because we can't enter a function closure -- but that is not the
761 Avoiding generating entries and info tables
762 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
763 At present, for every function we generate all of the following,
764 just in case. But they aren't always all needed, as noted below:
766 [NB1: all of this applies only to *functions*. Thunks always
767 have closure, info table, and entry code.]
769 [NB2: All are needed if the function is *exported*, just to play safe.]
772 * Fast-entry code ALWAYS NEEDED
775 Needed iff (a) we have any un-saturated calls to the function
776 OR (b) the function is passed as an arg
777 OR (c) we're in the parallel world and the function has free vars
778 [Reason: in parallel world, we always enter functions
779 with free vars via the closure.]
781 * The function closure
782 Needed iff (a) we have any un-saturated calls to the function
783 OR (b) the function is passed as an arg
784 OR (c) if the function has free vars (ie not top level)
786 Why case (a) here? Because if the arg-satis check fails,
787 UpdatePAP stuffs a pointer to the function closure in the PAP.
788 [Could be changed; UpdatePAP could stuff in a code ptr instead,
789 but doesn't seem worth it.]
791 [NB: these conditions imply that we might need the closure
792 without the slow-entry code. Here's how.
794 f x y = let g w = ...x..y..w...
798 Here we need a closure for g which contains x and y,
799 but since the calls are all saturated we just jump to the
800 fast entry point for g, with R1 pointing to the closure for g.]
803 * Standard info table
804 Needed iff (a) we have any un-saturated calls to the function
805 OR (b) the function is passed as an arg
806 OR (c) the function has free vars (ie not top level)
808 NB. In the sequential world, (c) is only required so that the function closure has
809 an info table to point to, to keep the storage manager happy.
810 If (c) alone is true we could fake up an info table by choosing
811 one of a standard family of info tables, whose entry code just
814 [NB In the parallel world (c) is needed regardless because
815 we enter functions with free vars via the closure.]
817 If (c) is retained, then we'll sometimes generate an info table
818 (for storage mgr purposes) without slow-entry code. Then we need
819 to use an error label in the info table to substitute for the absent
823 staticClosureRequired
828 staticClosureRequired _ bndr_info
829 (LFReEntrant top_level _ _ _) -- It's a function
830 = ASSERT( isTopLevel top_level )
831 -- Assumption: it's a top-level, no-free-var binding
832 not (satCallsOnly bndr_info)
834 staticClosureRequired _ _ _ = True
837 %************************************************************************
839 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
841 %************************************************************************
845 isStaticClosure :: ClosureInfo -> Bool
846 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
848 closureUpdReqd :: ClosureInfo -> Bool
849 closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info
850 closureUpdReqd ConInfo{} = False
852 lfUpdatable :: LambdaFormInfo -> Bool
853 lfUpdatable (LFThunk _ _ upd _ _) = upd
854 lfUpdatable (LFBlackHole _) = True
855 -- Black-hole closures are allocated to receive the results of an
856 -- alg case with a named default... so they need to be updated.
857 lfUpdatable _ = False
859 closureIsThunk :: ClosureInfo -> Bool
860 closureIsThunk ClosureInfo{ closureLFInfo = lf_info } = isLFThunk lf_info
861 closureIsThunk ConInfo{} = False
863 closureSingleEntry :: ClosureInfo -> Bool
864 closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
865 closureSingleEntry _ = False
867 closureReEntrant :: ClosureInfo -> Bool
868 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
869 closureReEntrant _ = False
871 isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon
872 isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con
873 isConstrClosure_maybe _ = Nothing
875 closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
876 closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info
877 closureFunInfo _ = Nothing
879 lfFunInfo :: LambdaFormInfo -> Maybe (Int, ArgDescr)
880 lfFunInfo (LFReEntrant _ arity _ arg_desc) = Just (arity, arg_desc)
881 lfFunInfo _ = Nothing
883 funTag :: ClosureInfo -> Int
884 funTag (ClosureInfo { closureLFInfo = lf_info }) = funTagLFInfo lf_info
887 -- maybe this should do constructor tags too?
888 funTagLFInfo :: LambdaFormInfo -> Int
890 -- A function is tagged with its arity
891 | Just (arity,_) <- lfFunInfo lf,
892 Just tag <- tagForArity arity
895 -- other closures (and unknown ones) are not tagged
899 tagForArity :: Int -> Maybe Int
900 tagForArity i | i <= mAX_PTR_TAG = Just i
901 | otherwise = Nothing
905 isToplevClosure :: ClosureInfo -> Bool
906 isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
908 LFReEntrant TopLevel _ _ _ -> True
909 LFThunk TopLevel _ _ _ _ -> True
911 isToplevClosure _ = False
917 infoTableLabelFromCI :: ClosureInfo -> CafInfo -> CLabel
918 infoTableLabelFromCI (ClosureInfo { closureName = name,
919 closureLFInfo = lf_info }) caf
921 LFBlackHole info -> info
923 LFThunk _ _ upd_flag (SelectorThunk offset) _ ->
924 mkSelectorInfoLabel upd_flag offset
926 LFThunk _ _ upd_flag (ApThunk arity) _ ->
927 mkApInfoTableLabel upd_flag arity
929 LFThunk{} -> mkLocalInfoTableLabel name caf
931 LFReEntrant _ _ _ _ -> mkLocalInfoTableLabel name caf
933 _ -> panic "infoTableLabelFromCI"
935 infoTableLabelFromCI (ConInfo { closureCon = con,
936 closureSMRep = rep }) caf
937 | isStaticRep rep = mkStaticInfoTableLabel name caf
938 | otherwise = mkConInfoTableLabel name caf
940 name = dataConName con
942 -- ClosureInfo for a closure (as opposed to a constructor) is always local
943 closureLabelFromCI :: ClosureInfo -> CafInfo -> CLabel
944 closureLabelFromCI (ClosureInfo { closureName = nm }) caf = mkLocalClosureLabel nm caf
945 closureLabelFromCI _ _ = panic "closureLabelFromCI"
947 -- thunkEntryLabel is a local help function, not exported. It's used from both
948 -- entryLabelFromCI and getCallMethod.
950 thunkEntryLabel :: Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel
951 thunkEntryLabel _thunk_id _ (ApThunk arity) is_updatable
952 = enterApLabel is_updatable arity
953 thunkEntryLabel _thunk_id _ (SelectorThunk offset) upd_flag
954 = enterSelectorLabel upd_flag offset
955 thunkEntryLabel thunk_id caf _ _is_updatable
956 = enterIdLabel thunk_id caf
958 enterApLabel :: Bool -> Int -> CLabel
959 enterApLabel is_updatable arity
960 | tablesNextToCode = mkApInfoTableLabel is_updatable arity
961 | otherwise = mkApEntryLabel is_updatable arity
963 enterSelectorLabel :: Bool -> Int -> CLabel
964 enterSelectorLabel upd_flag offset
965 | tablesNextToCode = mkSelectorInfoLabel upd_flag offset
966 | otherwise = mkSelectorEntryLabel upd_flag offset
968 enterIdLabel :: Name -> CafInfo -> CLabel
970 | tablesNextToCode = mkInfoTableLabel id
971 | otherwise = mkEntryLabel id
973 enterLocalIdLabel :: Name -> CafInfo -> CLabel
975 | tablesNextToCode = mkLocalInfoTableLabel id
976 | otherwise = mkLocalEntryLabel id
978 enterReturnPtLabel :: Unique -> CLabel
979 enterReturnPtLabel name
980 | tablesNextToCode = mkReturnInfoLabel name
981 | otherwise = mkReturnPtLabel name
985 We need a black-hole closure info to pass to @allocDynClosure@ when we
986 want to allocate the black hole on entry to a CAF. These are the only
987 ways to build an LFBlackHole, maintaining the invariant that it really
988 is a black hole and not something else.
991 cafBlackHoleClosureInfo :: ClosureInfo -> ClosureInfo
992 cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
994 = ClosureInfo { closureName = nm,
995 closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel,
996 closureSMRep = BlackHoleRep,
997 closureSRT = NoC_SRT,
1000 cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
1003 %************************************************************************
1005 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
1007 %************************************************************************
1009 Profiling requires two pieces of information to be determined for
1010 each closure's info table --- description and type.
1012 The description is stored directly in the @CClosureInfoTable@ when the
1013 info table is built.
1015 The type is determined from the type information stored with the @Id@
1016 in the closure info using @closureTypeDescr@.
1019 closureValDescr, closureTypeDescr :: ClosureInfo -> String
1020 closureValDescr (ClosureInfo {closureDescr = descr})
1022 closureValDescr (ConInfo {closureCon = con})
1023 = occNameString (getOccName con)
1025 closureTypeDescr (ClosureInfo { closureType = ty })
1026 = getTyDescription ty
1027 closureTypeDescr (ConInfo { closureCon = data_con })
1028 = occNameString (getOccName (dataConTyCon data_con))
1030 getTyDescription :: Type -> String
1032 = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
1035 AppTy fun _ -> getTyDescription fun
1036 FunTy _ res -> '-' : '>' : fun_result res
1037 TyConApp tycon _ -> getOccString tycon
1038 PredTy sty -> getPredTyDescription sty
1039 ForAllTy _ ty -> getTyDescription ty
1042 fun_result (FunTy _ res) = '>' : fun_result res
1043 fun_result other = getTyDescription other
1045 getPredTyDescription :: PredType -> String
1046 getPredTyDescription (ClassP cl _) = getOccString cl
1047 getPredTyDescription (IParam ip _) = getOccString (ipNameName ip)
1048 getPredTyDescription (EqPred _ _) = panic "getPredTyDescription EqPred"