1 -----------------------------------------------------------------------------
3 -- Stg to C-- code generation:
5 -- The types LambdaFormInfo
8 -- Nothing monadic in here!
10 -- (c) The University of Glasgow 2004-2006
12 -----------------------------------------------------------------------------
15 module StgCmmClosure (
17 DynTag, tagForCon, isSmallFamily,
20 ArgDescr(..), Liveness(..),
23 isVoidRep, isGcPtrRep, addIdReps, addArgReps,
26 LambdaFormInfo, -- Abstract
27 StandardFormInfo, -- ...ditto...
28 mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,
29 mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
33 mkClosureInfo, mkConInfo, maybeIsLFCon,
35 closureSize, closureNonHdrSize,
36 closureGoodStuffSize, closurePtrsSize,
39 closureName, infoTableLabelFromCI,
42 closureLFInfo, isLFThunk,closureSMRep, closureUpdReqd,
43 closureNeedsUpdSpace, closureIsThunk,
44 closureSingleEntry, closureReEntrant, isConstrClosure_maybe,
45 closureFunInfo, isStandardFormThunk, isKnownFun,
48 enterIdLabel, enterLocalIdLabel,
51 CallMethod(..), getCallMethod,
58 closureValDescr, closureTypeDescr, -- profiling
61 cafBlackHoleClosureInfo, seCafBlackHoleClosureInfo,
63 staticClosureNeedsLink, clHasCafRefs
66 #include "../includes/MachDeps.h"
68 #define FAST_STRING_NOT_NEEDED
69 #include "HsVersions.h"
71 import ClosureInfo (ArgDescr(..), C_SRT(..), Liveness(..))
72 -- XXX temporary becuase FunInfo needs this one
76 import Cmm ( ClosureTypeInfo(..), ConstrDescription )
95 -----------------------------------------------------------------------------
97 -----------------------------------------------------------------------------
99 addIdReps :: [Id] -> [(PrimRep, Id)]
100 addIdReps ids = [(idPrimRep id, id) | id <- ids]
102 addArgReps :: [StgArg] -> [(PrimRep, StgArg)]
103 addArgReps args = [(argPrimRep arg, arg) | arg <- args]
105 argPrimRep :: StgArg -> PrimRep
106 argPrimRep arg = typePrimRep (stgArgType arg)
108 isVoidRep :: PrimRep -> Bool
109 isVoidRep VoidRep = True
110 isVoidRep _other = False
112 isGcPtrRep :: PrimRep -> Bool
113 isGcPtrRep PtrRep = True
117 -----------------------------------------------------------------------------
119 -----------------------------------------------------------------------------
121 -- Information about an identifier, from the code generator's point of
122 -- view. Every identifier is bound to a LambdaFormInfo in the
123 -- environment, which gives the code generator enough info to be able to
124 -- tail call or return that identifier.
127 = LFReEntrant -- Reentrant closure (a function)
128 TopLevelFlag -- True if top level
129 !Int -- Arity. Invariant: always > 0
130 !Bool -- True <=> no fvs
131 ArgDescr -- Argument descriptor (should really be in ClosureInfo)
133 | LFThunk -- Thunk (zero arity)
135 !Bool -- True <=> no free vars
136 !Bool -- True <=> updatable (i.e., *not* single-entry)
138 !Bool -- True <=> *might* be a function type
140 | LFCon -- A saturated constructor application
141 DataCon -- The constructor
143 | LFUnknown -- Used for function arguments and imported things.
144 -- We know nothing about this closure.
145 -- Treat like updatable "LFThunk"...
146 -- Imported things which we *do* know something about use
147 -- one of the other LF constructors (eg LFReEntrant for
149 !Bool -- True <=> *might* be a function type
150 -- The False case is good when we want to enter it,
151 -- because then we know the entry code will do
152 -- For a function, the entry code is the fast entry point
154 | LFUnLifted -- A value of unboxed type;
155 -- always a value, neeeds evaluation
157 | LFLetNoEscape -- See LetNoEscape module for precise description
159 | LFBlackHole -- Used for the closures allocated to hold the result
160 -- of a CAF. We want the target of the update frame to
161 -- be in the heap, so we make a black hole to hold it.
162 CLabel -- Flavour (info label, eg CAF_BLACKHOLE_info).
165 -------------------------
166 -- An ArgDsecr describes the argument pattern of a function
168 {- XXX -- imported from old ClosureInfo for now
170 = ArgSpec -- Fits one of the standard patterns
171 !StgHalfWord -- RTS type identifier ARG_P, ARG_N, ...
173 | ArgGen -- General case
174 Liveness -- Details about the arguments
177 {- XXX -- imported from old ClosureInfo for now
178 -------------------------
179 -- We represent liveness bitmaps as a Bitmap (whose internal
180 -- representation really is a bitmap). These are pinned onto case return
181 -- vectors to indicate the state of the stack for the garbage collector.
183 -- In the compiled program, liveness bitmaps that fit inside a single
184 -- word (StgWord) are stored as a single word, while larger bitmaps are
185 -- stored as a pointer to an array of words.
188 = SmallLiveness -- Liveness info that fits in one word
189 StgWord -- Here's the bitmap
191 | BigLiveness -- Liveness info witha a multi-word bitmap
192 CLabel -- Label for the bitmap
195 -------------------------
196 -- StandardFormInfo tells whether this thunk has one of
197 -- a small number of standard forms
199 data StandardFormInfo
201 -- Not of of the standard forms
204 -- A SelectorThunk is of form
206 -- con a1,..,an -> ak
207 -- and the constructor is from a single-constr type.
208 WordOff -- 0-origin offset of ak within the "goods" of
209 -- constructor (Recall that the a1,...,an may be laid
210 -- out in the heap in a non-obvious order.)
213 -- An ApThunk is of form
215 -- The code for the thunk just pushes x2..xn on the stack and enters x1.
216 -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
217 -- in the RTS to save space.
221 ------------------------------------------------------
222 -- Building LambdaFormInfo
223 ------------------------------------------------------
225 mkLFArgument :: Id -> LambdaFormInfo
227 | isUnLiftedType ty = LFUnLifted
228 | might_be_a_function ty = LFUnknown True
229 | otherwise = LFUnknown False
234 mkLFLetNoEscape :: LambdaFormInfo
235 mkLFLetNoEscape = LFLetNoEscape
238 mkLFReEntrant :: TopLevelFlag -- True of top level
241 -> ArgDescr -- Argument descriptor
244 mkLFReEntrant top fvs args arg_descr
245 = LFReEntrant top (length args) (null fvs) arg_descr
248 mkLFThunk :: Type -> TopLevelFlag -> [Id] -> UpdateFlag -> LambdaFormInfo
249 mkLFThunk thunk_ty top fvs upd_flag
250 = ASSERT( not (isUpdatable upd_flag) || not (isUnLiftedType thunk_ty) )
251 LFThunk top (null fvs)
252 (isUpdatable upd_flag)
254 (might_be_a_function thunk_ty)
257 might_be_a_function :: Type -> Bool
258 -- Return False only if we are *sure* it's a data type
259 -- Look through newtypes etc as much as poss
260 might_be_a_function ty
261 = case splitTyConApp_maybe (repType ty) of
262 Just (tc, _) -> not (isDataTyCon tc)
266 mkConLFInfo :: DataCon -> LambdaFormInfo
267 mkConLFInfo con = LFCon con
270 mkSelectorLFInfo :: Id -> Int -> Bool -> LambdaFormInfo
271 mkSelectorLFInfo id offset updatable
272 = LFThunk NotTopLevel False updatable (SelectorThunk offset)
273 (might_be_a_function (idType id))
276 mkApLFInfo :: Id -> UpdateFlag -> Arity -> LambdaFormInfo
277 mkApLFInfo id upd_flag arity
278 = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)
279 (might_be_a_function (idType id))
282 mkLFImported :: Id -> LambdaFormInfo
284 | Just con <- isDataConWorkId_maybe id
285 , isNullaryRepDataCon con
286 = LFCon con -- An imported nullary constructor
287 -- We assume that the constructor is evaluated so that
288 -- the id really does point directly to the constructor
291 = LFReEntrant TopLevel arity True (panic "arg_descr")
294 = mkLFArgument id -- Not sure of exact arity
298 -----------------------------------------------------
299 -- Dynamic pointer tagging
300 -----------------------------------------------------
302 type ConTagZ = Int -- A *zero-indexed* contructor tag
304 type DynTag = Int -- The tag on a *pointer*
305 -- (from the dynamic-tagging paper)
307 {- Note [Data constructor dynamic tags]
308 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
309 The family size of a data type (the number of constructors)
311 * small, if the family size < 2**tag_bits
314 Small families can have the constructor tag in the tag bits.
315 Big families only use the tag value 1 to represent evaluatedness. -}
317 isSmallFamily :: Int -> Bool
318 isSmallFamily fam_size = fam_size <= mAX_PTR_TAG
320 -- We keep the *zero-indexed* tag in the srt_len field of the info
321 -- table of a data constructor.
322 dataConTagZ :: DataCon -> ConTagZ
323 dataConTagZ con = dataConTag con - fIRST_TAG
325 tagForCon :: DataCon -> DynTag
327 | isSmallFamily fam_size = con_tag + 1
330 con_tag = dataConTagZ con
331 fam_size = tyConFamilySize (dataConTyCon con)
333 tagForArity :: Int -> DynTag
334 tagForArity arity | isSmallFamily arity = arity
337 lfDynTag :: LambdaFormInfo -> DynTag
338 -- Return the tag in the low order bits of a variable bound
339 -- to this LambdaForm
340 lfDynTag (LFCon con) = pprTrace "tagForCon" (ppr con <+> ppr (tagForCon con)) $ tagForCon con
341 lfDynTag (LFReEntrant _ arity _ _) = pprTrace "reentrant" (ppr arity) $ tagForArity arity
345 -----------------------------------------------------------------------------
346 -- Observing LambdaFormInfo
347 -----------------------------------------------------------------------------
350 maybeIsLFCon :: LambdaFormInfo -> Maybe DataCon
351 maybeIsLFCon (LFCon con) = Just con
352 maybeIsLFCon _ = Nothing
355 isLFThunk :: LambdaFormInfo -> Bool
356 isLFThunk (LFThunk _ _ _ _ _) = True
357 isLFThunk (LFBlackHole _) = True
358 -- return True for a blackhole: this function is used to determine
359 -- whether to use the thunk header in SMP mode, and a blackhole
364 -----------------------------------------------------------------------------
366 -----------------------------------------------------------------------------
369 :: Bool -- True <=> static closure
371 -> WordOff -> WordOff -- Tot wds, ptr wds
374 chooseSMRep is_static lf_info tot_wds ptr_wds
376 nonptr_wds = tot_wds - ptr_wds
377 closure_type = getClosureType is_static ptr_wds lf_info
379 GenericRep is_static ptr_wds nonptr_wds closure_type
381 -- We *do* get non-updatable top-level thunks sometimes. eg. f = g
382 -- gets compiled to a jump to g (if g has non-zero arity), instead of
383 -- messing around with update frames and PAPs. We set the closure type
384 -- to FUN_STATIC in this case.
386 getClosureType :: Bool -> WordOff -> LambdaFormInfo -> ClosureType
387 getClosureType is_static ptr_wds lf_info
389 LFCon {} | is_static && ptr_wds == 0 -> ConstrNoCaf
390 | otherwise -> Constr
391 LFReEntrant {} -> Fun
392 LFThunk _ _ _ (SelectorThunk {}) _ -> ThunkSelector
394 _ -> panic "getClosureType"
397 -----------------------------------------------------------------------------
399 -----------------------------------------------------------------------------
401 -- Be sure to see the stg-details notes about these...
403 nodeMustPointToIt :: LambdaFormInfo -> Bool
404 nodeMustPointToIt (LFReEntrant top _ no_fvs _)
405 = not no_fvs || -- Certainly if it has fvs we need to point to it
407 -- If it is not top level we will point to it
408 -- We can have a \r closure with no_fvs which
409 -- is not top level as special case cgRhsClosure
410 -- has been dissabled in favour of let floating
412 -- For lex_profiling we also access the cost centre for a
413 -- non-inherited function i.e. not top level
414 -- the not top case above ensures this is ok.
416 nodeMustPointToIt (LFCon _) = True
418 -- Strictly speaking, the above two don't need Node to point
419 -- to it if the arity = 0. But this is a *really* unlikely
420 -- situation. If we know it's nil (say) and we are entering
421 -- it. Eg: let x = [] in x then we will certainly have inlined
422 -- x, since nil is a simple atom. So we gain little by not
423 -- having Node point to known zero-arity things. On the other
424 -- hand, we do lose something; Patrick's code for figuring out
425 -- when something has been updated but not entered relies on
426 -- having Node point to the result of an update. SLPJ
429 nodeMustPointToIt (LFThunk _ no_fvs updatable NonStandardThunk _)
430 = updatable || not no_fvs || opt_SccProfilingOn
431 -- For the non-updatable (single-entry case):
433 -- True if has fvs (in which case we need access to them, and we
434 -- should black-hole it)
435 -- or profiling (in which case we need to recover the cost centre
438 nodeMustPointToIt (LFThunk {}) -- Node must point to a standard-form thunk
441 nodeMustPointToIt (LFUnknown _) = True
442 nodeMustPointToIt LFUnLifted = False
443 nodeMustPointToIt (LFBlackHole _) = True -- BH entry may require Node to point
444 nodeMustPointToIt LFLetNoEscape = False
446 -----------------------------------------------------------------------------
448 -----------------------------------------------------------------------------
450 {- The entry conventions depend on the type of closure being entered,
451 whether or not it has free variables, and whether we're running
452 sequentially or in parallel.
454 Closure Node Argument Enter
455 Characteristics Par Req'd Passing Via
456 -------------------------------------------------------------------------------
457 Unknown & no & yes & stack & node
458 Known fun (>1 arg), no fvs & no & no & registers & fast entry (enough args)
459 & slow entry (otherwise)
460 Known fun (>1 arg), fvs & no & yes & registers & fast entry (enough args)
461 0 arg, no fvs \r,\s & no & no & n/a & direct entry
462 0 arg, no fvs \u & no & yes & n/a & node
463 0 arg, fvs \r,\s & no & yes & n/a & direct entry
464 0 arg, fvs \u & no & yes & n/a & node
466 Unknown & yes & yes & stack & node
467 Known fun (>1 arg), no fvs & yes & no & registers & fast entry (enough args)
468 & slow entry (otherwise)
469 Known fun (>1 arg), fvs & yes & yes & registers & node
470 0 arg, no fvs \r,\s & yes & no & n/a & direct entry
471 0 arg, no fvs \u & yes & yes & n/a & node
472 0 arg, fvs \r,\s & yes & yes & n/a & node
473 0 arg, fvs \u & yes & yes & n/a & node
476 When black-holing, single-entry closures could also be entered via node
477 (rather than directly) to catch double-entry. -}
480 = EnterIt -- No args, not a function
482 | JumpToIt -- A join point
484 | ReturnIt -- It's a value (function, unboxed value,
485 -- or constructor), so just return it.
487 | SlowCall -- Unknown fun, or known fun with
490 | DirectEntry -- Jump directly, with args in regs
491 CLabel -- The code label
494 getCallMethod :: Name -- Function being applied
495 -> CafInfo -- Can it refer to CAF's?
496 -> LambdaFormInfo -- Its info
497 -> Int -- Number of available arguments
500 getCallMethod _name _ lf_info _n_args
501 | nodeMustPointToIt lf_info && opt_Parallel
502 = -- If we're parallel, then we must always enter via node.
503 -- The reason is that the closure may have been
504 -- fetched since we allocated it.
507 getCallMethod name caf (LFReEntrant _ arity _ _) n_args
508 | n_args == 0 = ASSERT( arity /= 0 )
509 ReturnIt -- No args at all
510 | n_args < arity = SlowCall -- Not enough args
511 | otherwise = pprTrace "getCallMethod" (ppr name <+> ppr arity) $
512 DirectEntry (enterIdLabel name caf) arity
514 getCallMethod _name _ LFUnLifted n_args
515 = ASSERT( n_args == 0 ) ReturnIt
517 getCallMethod _name _ (LFCon _) n_args
518 = ASSERT( n_args == 0 ) ReturnIt
520 getCallMethod name caf (LFThunk _ _ updatable std_form_info is_fun) n_args
521 | is_fun -- it *might* be a function, so we must "call" it (which is always safe)
522 = SlowCall -- We cannot just enter it [in eval/apply, the entry code
523 -- is the fast-entry code]
525 -- Since is_fun is False, we are *definitely* looking at a data value
526 | updatable || opt_DoTickyProfiling -- to catch double entry
528 I decided to remove this, because in SMP mode it doesn't matter
529 if we enter the same thunk multiple times, so the optimisation
530 of jumping directly to the entry code is still valid. --SDM
533 -- We used to have ASSERT( n_args == 0 ), but actually it is
534 -- possible for the optimiser to generate
535 -- let bot :: Int = error Int "urk"
536 -- in (bot `cast` unsafeCoerce Int (Int -> Int)) 3
537 -- This happens as a result of the case-of-error transformation
538 -- So the right thing to do is just to enter the thing
540 | otherwise -- Jump direct to code for single-entry thunks
541 = ASSERT( n_args == 0 )
542 DirectEntry (thunkEntryLabel name caf std_form_info updatable) 0
544 getCallMethod _name _ (LFUnknown True) _n_args
545 = SlowCall -- might be a function
547 getCallMethod name _ (LFUnknown False) n_args
548 = ASSERT2 ( n_args == 0, ppr name <+> ppr n_args )
549 EnterIt -- Not a function
551 getCallMethod _name _ (LFBlackHole _) _n_args
552 = SlowCall -- Presumably the black hole has by now
553 -- been updated, but we don't know with
554 -- what, so we slow call it
556 getCallMethod _name _ LFLetNoEscape _n_args
559 isStandardFormThunk :: LambdaFormInfo -> Bool
560 isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
561 isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _) = True
562 isStandardFormThunk _other_lf_info = False
564 isKnownFun :: LambdaFormInfo -> Bool
565 isKnownFun (LFReEntrant _ _ _ _) = True
566 isKnownFun LFLetNoEscape = True
569 -----------------------------------------------------------------------------
570 -- staticClosureRequired
571 -----------------------------------------------------------------------------
573 {- staticClosureRequired is never called (hence commented out)
575 SimonMar writes (Sept 07) It's an optimisation we used to apply at
576 one time, I believe, but it got lost probably in the rewrite of
577 the RTS/code generator. I left that code there to remind me to
578 look into whether it was worth doing sometime
580 {- Avoiding generating entries and info tables
581 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
582 At present, for every function we generate all of the following,
583 just in case. But they aren't always all needed, as noted below:
585 [NB1: all of this applies only to *functions*. Thunks always
586 have closure, info table, and entry code.]
588 [NB2: All are needed if the function is *exported*, just to play safe.]
590 * Fast-entry code ALWAYS NEEDED
593 Needed iff (a) we have any un-saturated calls to the function
594 OR (b) the function is passed as an arg
595 OR (c) we're in the parallel world and the function has free vars
596 [Reason: in parallel world, we always enter functions
597 with free vars via the closure.]
599 * The function closure
600 Needed iff (a) we have any un-saturated calls to the function
601 OR (b) the function is passed as an arg
602 OR (c) if the function has free vars (ie not top level)
604 Why case (a) here? Because if the arg-satis check fails,
605 UpdatePAP stuffs a pointer to the function closure in the PAP.
606 [Could be changed; UpdatePAP could stuff in a code ptr instead,
607 but doesn't seem worth it.]
609 [NB: these conditions imply that we might need the closure
610 without the slow-entry code. Here's how.
612 f x y = let g w = ...x..y..w...
616 Here we need a closure for g which contains x and y,
617 but since the calls are all saturated we just jump to the
618 fast entry point for g, with R1 pointing to the closure for g.]
621 * Standard info table
622 Needed iff (a) we have any un-saturated calls to the function
623 OR (b) the function is passed as an arg
624 OR (c) the function has free vars (ie not top level)
626 NB. In the sequential world, (c) is only required so that the function closure has
627 an info table to point to, to keep the storage manager happy.
628 If (c) alone is true we could fake up an info table by choosing
629 one of a standard family of info tables, whose entry code just
632 [NB In the parallel world (c) is needed regardless because
633 we enter functions with free vars via the closure.]
635 If (c) is retained, then we'll sometimes generate an info table
636 (for storage mgr purposes) without slow-entry code. Then we need
637 to use an error label in the info table to substitute for the absent
641 staticClosureRequired
646 staticClosureRequired binder bndr_info
647 (LFReEntrant top_level _ _ _) -- It's a function
648 = ASSERT( isTopLevel top_level )
649 -- Assumption: it's a top-level, no-free-var binding
650 not (satCallsOnly bndr_info)
652 staticClosureRequired binder other_binder_info other_lf_info = True
655 -----------------------------------------------------------------------------
656 -- Data types for closure information}
657 -----------------------------------------------------------------------------
660 {- Information about a closure, from the code generator's point of view.
662 A ClosureInfo decribes the info pointer of a closure. It has
664 a) to construct the info table itself
665 b) to allocate a closure containing that info pointer (i.e.
666 it knows the info table label)
668 We make a ClosureInfo for
669 - each let binding (both top level and not)
670 - each data constructor (for its shared static and
676 closureName :: !Name, -- The thing bound to this closure
677 closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon (see below)
678 closureSMRep :: !SMRep, -- representation used by storage mgr
679 closureSRT :: !C_SRT, -- What SRT applies to this closure
680 closureType :: !Type, -- Type of closure (ToDo: remove)
681 closureDescr :: !String, -- closure description (for profiling)
682 closureCafs :: !CafInfo -- whether the closure may have CAFs
685 -- Constructor closures don't have a unique info table label (they use
686 -- the constructor's info table), and they don't have an SRT.
688 closureCon :: !DataCon,
689 closureSMRep :: !SMRep
692 {- XXX temp imported from old ClosureInfo
693 -- C_SRT is what StgSyn.SRT gets translated to...
694 -- we add a label for the table, and expect only the 'offset/length' form
697 | C_SRT !CLabel !WordOff !StgHalfWord {-bitmap or escape-}
700 instance Outputable C_SRT where
701 ppr (NoC_SRT) = ptext SLIT("_no_srt_")
702 ppr (C_SRT label off bitmap) = parens (ppr label <> comma <> ppr off <> comma <> text (show bitmap))
705 needsSRT :: C_SRT -> Bool
706 needsSRT NoC_SRT = False
707 needsSRT (C_SRT _ _ _) = True
710 --------------------------------------
711 -- Building ClosureInfos
712 --------------------------------------
714 mkClosureInfo :: Bool -- Is static
717 -> Int -> Int -- Total and pointer words
719 -> String -- String descriptor
721 mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr
722 = ClosureInfo { closureName = name,
723 closureLFInfo = lf_info,
724 closureSMRep = sm_rep,
725 closureSRT = srt_info,
726 closureType = idType id,
727 closureDescr = descr,
728 closureCafs = idCafInfo id }
731 sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds
733 mkConInfo :: Bool -- Is static
735 -> Int -> Int -- Total and pointer words
737 mkConInfo is_static data_con tot_wds ptr_wds
738 = ConInfo { closureSMRep = sm_rep,
739 closureCon = data_con }
741 sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds
744 -- We need a black-hole closure info to pass to @allocDynClosure@ when we
745 -- want to allocate the black hole on entry to a CAF. These are the only
746 -- ways to build an LFBlackHole, maintaining the invariant that it really
747 -- is a black hole and not something else.
749 cafBlackHoleClosureInfo :: ClosureInfo -> ClosureInfo
750 cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
752 closureCafs = cafs })
753 = ClosureInfo { closureName = nm,
754 closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel,
755 closureSMRep = BlackHoleRep,
756 closureSRT = NoC_SRT,
760 cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
762 seCafBlackHoleClosureInfo :: ClosureInfo -> ClosureInfo
763 seCafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
765 closureCafs = cafs })
766 = ClosureInfo { closureName = nm,
767 closureLFInfo = LFBlackHole mkSECAFBlackHoleInfoTableLabel,
768 closureSMRep = BlackHoleRep,
769 closureSRT = NoC_SRT,
773 seCafBlackHoleClosureInfo _ = panic "seCafBlackHoleClosureInfo"
775 --------------------------------------
776 -- Extracting ClosureTypeInfo
777 --------------------------------------
779 -- JD: I've added the continuation arguments not for fun but because
780 -- I don't want to pipe the monad in here (circular module dependencies),
781 -- and I don't want to pull this code out of this module, which would
782 -- require us to expose a bunch of abstract types.
785 ClosureInfo -> ((ConstrDescription -> ClosureTypeInfo) -> DataCon -> CLabel -> a) ->
786 (ClosureTypeInfo -> a) -> a
787 closureTypeInfo cl_info k_with_con_name k_simple
789 ConInfo { closureCon = con }
790 -> k_with_con_name (ConstrInfo (ptrs, nptrs)
791 (fromIntegral (dataConTagZ con))) con info_lbl
793 --con_name = panic "closureTypeInfo"
795 -- cstr <- mkByteStringCLit $ dataConIdentity con
796 -- con_name = makeRelativeRefTo info_lbl cstr
798 ClosureInfo { closureName = name,
799 closureLFInfo = LFReEntrant _ arity _ arg_descr,
801 -> k_simple $ FunInfo (ptrs, nptrs)
805 (CmmLabel (mkSlowEntryLabel name (clHasCafRefs cl_info)))
807 ClosureInfo { closureLFInfo = LFThunk _ _ _ (SelectorThunk offset) _,
809 -> k_simple $ ThunkSelectorInfo (fromIntegral offset) srt
811 ClosureInfo { closureLFInfo = LFThunk {},
813 -> k_simple $ ThunkInfo (ptrs, nptrs) srt
815 _ -> panic "unexpected lambda form in mkCmmInfo"
817 info_lbl = infoTableLabelFromCI cl_info
818 ptrs = fromIntegral $ closurePtrsSize cl_info
819 size = fromIntegral $ closureNonHdrSize cl_info
822 --------------------------------------
823 -- Functions about closure *sizes*
824 --------------------------------------
826 closureSize :: ClosureInfo -> WordOff
827 closureSize cl_info = hdr_size + closureNonHdrSize cl_info
828 where hdr_size | closureIsThunk cl_info = thunkHdrSize
829 | otherwise = fixedHdrSize
830 -- All thunks use thunkHdrSize, even if they are non-updatable.
831 -- this is because we don't have separate closure types for
832 -- updatable vs. non-updatable thunks, so the GC can't tell the
833 -- difference. If we ever have significant numbers of non-
834 -- updatable thunks, it might be worth fixing this.
836 closureNonHdrSize :: ClosureInfo -> WordOff
837 closureNonHdrSize cl_info
838 = tot_wds + computeSlopSize tot_wds cl_info
840 tot_wds = closureGoodStuffSize cl_info
842 closureGoodStuffSize :: ClosureInfo -> WordOff
843 closureGoodStuffSize cl_info
844 = let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info)
847 closurePtrsSize :: ClosureInfo -> WordOff
848 closurePtrsSize cl_info
849 = let (ptrs, _) = sizes_from_SMRep (closureSMRep cl_info)
853 sizes_from_SMRep :: SMRep -> (WordOff,WordOff)
854 sizes_from_SMRep (GenericRep _ ptrs nonptrs _) = (ptrs, nonptrs)
855 sizes_from_SMRep BlackHoleRep = (0, 0)
857 -- Computing slop size. WARNING: this looks dodgy --- it has deep
858 -- knowledge of what the storage manager does with the various
859 -- representations...
861 -- Slop Requirements: every thunk gets an extra padding word in the
862 -- header, which takes the the updated value.
864 slopSize :: ClosureInfo -> WordOff
865 slopSize cl_info = computeSlopSize payload_size cl_info
866 where payload_size = closureGoodStuffSize cl_info
868 computeSlopSize :: WordOff -> ClosureInfo -> WordOff
869 computeSlopSize payload_size cl_info
870 = max 0 (minPayloadSize smrep updatable - payload_size)
872 smrep = closureSMRep cl_info
873 updatable = closureNeedsUpdSpace cl_info
875 closureNeedsUpdSpace :: ClosureInfo -> Bool
876 -- We leave space for an update if either (a) the closure is updatable
877 -- or (b) it is a static thunk. This is because a static thunk needs
878 -- a static link field in a predictable place (after the slop), regardless
879 -- of whether it is updatable or not.
880 closureNeedsUpdSpace (ClosureInfo { closureLFInfo =
881 LFThunk TopLevel _ _ _ _ }) = True
882 closureNeedsUpdSpace cl_info = closureUpdReqd cl_info
884 minPayloadSize :: SMRep -> Bool -> WordOff
885 minPayloadSize smrep updatable
887 BlackHoleRep -> min_upd_size
888 GenericRep _ _ _ _ | updatable -> min_upd_size
889 GenericRep True _ _ _ -> 0 -- static
890 GenericRep False _ _ _ -> mIN_PAYLOAD_SIZE
894 ASSERT(mIN_PAYLOAD_SIZE <= sIZEOF_StgSMPThunkHeader)
895 0 -- check that we already have enough
896 -- room for mIN_SIZE_NonUpdHeapObject,
897 -- due to the extra header word in SMP
899 --------------------------------------
900 -- Other functions over ClosureInfo
901 --------------------------------------
903 blackHoleOnEntry :: ClosureInfo -> Bool
904 -- Static closures are never themselves black-holed.
905 -- Updatable ones will be overwritten with a CAFList cell, which points to a
907 -- Single-entry ones have no fvs to plug, and we trust they don't form part
910 blackHoleOnEntry ConInfo{} = False
911 blackHoleOnEntry (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
913 = False -- Never black-hole a static closure
917 LFReEntrant _ _ _ _ -> False
918 LFLetNoEscape -> False
919 LFThunk _ no_fvs updatable _ _
921 then not opt_OmitBlackHoling
922 else opt_DoTickyProfiling || not no_fvs
923 -- the former to catch double entry,
924 -- and the latter to plug space-leaks. KSW/SDM 1999-04.
926 _other -> panic "blackHoleOnEntry" -- Should never happen
929 staticClosureNeedsLink :: ClosureInfo -> Bool
930 -- A static closure needs a link field to aid the GC when traversing
931 -- the static closure graph. But it only needs such a field if either
933 -- b) it's a constructor with one or more pointer fields
934 -- In case (b), the constructor's fields themselves play the role
936 staticClosureNeedsLink (ClosureInfo { closureSRT = srt })
938 staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })
939 = not (isNullaryRepDataCon con) && not_nocaf_constr
943 GenericRep _ _ _ ConstrNoCaf -> False
946 isStaticClosure :: ClosureInfo -> Bool
947 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
949 closureUpdReqd :: ClosureInfo -> Bool
950 closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info
951 closureUpdReqd ConInfo{} = False
953 lfUpdatable :: LambdaFormInfo -> Bool
954 lfUpdatable (LFThunk _ _ upd _ _) = upd
955 lfUpdatable (LFBlackHole _) = True
956 -- Black-hole closures are allocated to receive the results of an
957 -- alg case with a named default... so they need to be updated.
958 lfUpdatable _ = False
960 closureIsThunk :: ClosureInfo -> Bool
961 closureIsThunk ClosureInfo{ closureLFInfo = lf_info } = isLFThunk lf_info
962 closureIsThunk ConInfo{} = False
964 closureSingleEntry :: ClosureInfo -> Bool
965 closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
966 closureSingleEntry _ = False
968 closureReEntrant :: ClosureInfo -> Bool
969 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
970 closureReEntrant _ = False
972 isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon
973 isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con
974 isConstrClosure_maybe _ = Nothing
976 closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
977 closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info
978 closureFunInfo _ = Nothing
980 lfFunInfo :: LambdaFormInfo -> Maybe (Int, ArgDescr)
981 lfFunInfo (LFReEntrant _ arity _ arg_desc) = Just (arity, arg_desc)
982 lfFunInfo _ = Nothing
984 funTag :: ClosureInfo -> DynTag
985 funTag (ClosureInfo { closureLFInfo = lf_info }) = lfDynTag lf_info
986 funTag (ConInfo {}) = panic "funTag"
988 isToplevClosure :: ClosureInfo -> Bool
989 isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
991 LFReEntrant TopLevel _ _ _ -> True
992 LFThunk TopLevel _ _ _ _ -> True
994 isToplevClosure _ = False
996 --------------------------------------
998 --------------------------------------
1000 infoTableLabelFromCI :: ClosureInfo -> CLabel
1001 infoTableLabelFromCI cl@(ClosureInfo { closureName = name,
1002 closureLFInfo = lf_info })
1004 LFBlackHole info -> info
1006 LFThunk _ _ upd_flag (SelectorThunk offset) _ ->
1007 mkSelectorInfoLabel upd_flag offset
1009 LFThunk _ _ upd_flag (ApThunk arity) _ ->
1010 mkApInfoTableLabel upd_flag arity
1012 LFThunk{} -> mkLocalInfoTableLabel name $ clHasCafRefs cl
1014 LFReEntrant _ _ _ _ -> mkLocalInfoTableLabel name $ clHasCafRefs cl
1016 _other -> panic "infoTableLabelFromCI"
1018 infoTableLabelFromCI cl@(ConInfo { closureCon = con, closureSMRep = rep })
1019 | isStaticRep rep = mkStaticInfoTableLabel name $ clHasCafRefs cl
1020 | otherwise = mkConInfoTableLabel name $ clHasCafRefs cl
1022 name = dataConName con
1024 -- ClosureInfo for a closure (as opposed to a constructor) is always local
1025 closureLabelFromCI :: ClosureInfo -> CLabel
1026 closureLabelFromCI cl@(ClosureInfo { closureName = nm }) =
1027 mkLocalClosureLabel nm $ clHasCafRefs cl
1028 closureLabelFromCI _ = panic "closureLabelFromCI"
1030 thunkEntryLabel :: Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel
1031 -- thunkEntryLabel is a local help function, not exported. It's used from both
1032 -- entryLabelFromCI and getCallMethod.
1033 thunkEntryLabel _thunk_id _ (ApThunk arity) upd_flag
1034 = enterApLabel upd_flag arity
1035 thunkEntryLabel _thunk_id _ (SelectorThunk offset) upd_flag
1036 = enterSelectorLabel upd_flag offset
1037 thunkEntryLabel thunk_id c _ _
1038 = enterIdLabel thunk_id c
1040 enterApLabel :: Bool -> Arity -> CLabel
1041 enterApLabel is_updatable arity
1042 | tablesNextToCode = mkApInfoTableLabel is_updatable arity
1043 | otherwise = mkApEntryLabel is_updatable arity
1045 enterSelectorLabel :: Bool -> WordOff -> CLabel
1046 enterSelectorLabel upd_flag offset
1047 | tablesNextToCode = mkSelectorInfoLabel upd_flag offset
1048 | otherwise = mkSelectorEntryLabel upd_flag offset
1050 enterIdLabel :: Name -> CafInfo -> CLabel
1052 | tablesNextToCode = mkInfoTableLabel id c
1053 | otherwise = mkEntryLabel id c
1055 enterLocalIdLabel :: Name -> CafInfo -> CLabel
1056 enterLocalIdLabel id c
1057 | tablesNextToCode = mkLocalInfoTableLabel id c
1058 | otherwise = mkLocalEntryLabel id c
1061 --------------------------------------
1063 --------------------------------------
1065 -- Profiling requires two pieces of information to be determined for
1066 -- each closure's info table --- description and type.
1068 -- The description is stored directly in the @CClosureInfoTable@ when the
1069 -- info table is built.
1071 -- The type is determined from the type information stored with the @Id@
1072 -- in the closure info using @closureTypeDescr@.
1074 closureValDescr, closureTypeDescr :: ClosureInfo -> String
1075 closureValDescr (ClosureInfo {closureDescr = descr})
1077 closureValDescr (ConInfo {closureCon = con})
1078 = occNameString (getOccName con)
1080 closureTypeDescr (ClosureInfo { closureType = ty })
1081 = getTyDescription ty
1082 closureTypeDescr (ConInfo { closureCon = data_con })
1083 = occNameString (getOccName (dataConTyCon data_con))
1085 getTyDescription :: Type -> String
1087 = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
1090 AppTy fun _ -> getTyDescription fun
1091 FunTy _ res -> '-' : '>' : fun_result res
1092 TyConApp tycon _ -> getOccString tycon
1093 PredTy sty -> getPredTyDescription sty
1094 ForAllTy _ ty -> getTyDescription ty
1097 fun_result (FunTy _ res) = '>' : fun_result res
1098 fun_result other = getTyDescription other
1100 getPredTyDescription :: PredType -> String
1101 getPredTyDescription (ClassP cl _) = getOccString cl
1102 getPredTyDescription (IParam ip _) = getOccString (ipNameName ip)
1103 getPredTyDescription (EqPred ty1 _ty2) = getTyDescription ty1 -- Urk?
1106 --------------------------------------
1108 --------------------------------------
1110 -- We need to know whether a closure may have CAFs.
1111 clHasCafRefs :: ClosureInfo -> CafInfo
1112 clHasCafRefs (ClosureInfo {closureCafs = cafs}) = cafs
1113 clHasCafRefs (ConInfo {}) = NoCafRefs