Skip to content

GitLab

Commit 1c2f8953 authored by Simon Marlow's avatar Simon Marlow
Browse files

refactoring and fixing the stage 2 compilation

parent fb127a99
Hide whitespace changes
Inline Side-by-side
compiler/cmm/CLabel.hs
View file @ 1c2f8953
......@@ -22,7 +22,7 @@ module CLabel (
mkSRTLabel,
mkInfoTableLabel,
mkEntryLabel,
mkSlowEntryLabel, slowEntryFromInfoLabel,
mkSlowEntryLabel,
mkConEntryLabel,
mkStaticConEntryLabel,
mkRednCountsLabel,
......@@ -100,11 +100,12 @@ module CLabel (
mkHpcTicksLabel,
hasCAF,
cvtToClosureLbl,
needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
isMathFun,
isCFunctionLabel, isGcPtrLabel, labelDynamic,
infoLblToEntryLbl, entryLblToInfoLbl,
-- * Conversions
toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, toRednCountsLbl,
pprCLabel
) where
......@@ -359,7 +360,6 @@ data DynamicLinkerLabelInfo
-- Constructing IdLabels
-- These are always local:
mkSlowEntryLabel name c = IdLabel name c Slow
slowEntryFromInfoLabel (IdLabel n c _) = IdLabel n c Slow
mkSRTLabel name c = IdLabel name c SRT
mkRednCountsLabel name c = IdLabel name c RednCounts
......@@ -506,39 +506,40 @@ mkPlainModuleInitLabel :: Module -> CLabel
mkPlainModuleInitLabel mod = PlainModuleInitLabel mod
-- -----------------------------------------------------------------------------
-- Brutal method of obtaining a closure label
cvtToClosureLbl (IdLabel n c InfoTable) = IdLabel n c Closure
cvtToClosureLbl (IdLabel n c LocalInfoTable) = IdLabel n c Closure -- XXX?
cvtToClosureLbl (IdLabel n c Entry) = IdLabel n c Closure
cvtToClosureLbl (IdLabel n c LocalEntry) = IdLabel n c Closure -- XXX?
cvtToClosureLbl (IdLabel n c ConEntry) = IdLabel n c Closure
cvtToClosureLbl (IdLabel n c RednCounts) = IdLabel n c Closure
cvtToClosureLbl l@(IdLabel n c Closure) = l
cvtToClosureLbl l
= pprPanic "cvtToClosureLbl" (pprCLabel l)
infoLblToEntryLbl :: CLabel -> CLabel
infoLblToEntryLbl (IdLabel n c LocalInfoTable) = IdLabel n c LocalEntry
infoLblToEntryLbl (IdLabel n c InfoTable) = IdLabel n c Entry
infoLblToEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry
infoLblToEntryLbl (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry
infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
infoLblToEntryLbl (CmmLabel m str CmmInfo) = CmmLabel m str CmmEntry
infoLblToEntryLbl (CmmLabel m str CmmRetInfo) = CmmLabel m str CmmRet
infoLblToEntryLbl _
= panic "CLabel.infoLblToEntryLbl"
entryLblToInfoLbl :: CLabel -> CLabel
entryLblToInfoLbl (IdLabel n c Entry) = IdLabel n c InfoTable
entryLblToInfoLbl (IdLabel n c LocalEntry) = IdLabel n c LocalInfoTable
entryLblToInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable
entryLblToInfoLbl (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable
entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
entryLblToInfoLbl (CmmLabel m str CmmEntry) = CmmLabel m str CmmInfo
entryLblToInfoLbl (CmmLabel m str CmmRet) = CmmLabel m str CmmRetInfo
entryLblToInfoLbl l
= pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
-- Convert between different kinds of label
toClosureLbl :: CLabel -> CLabel
toClosureLbl (IdLabel n c _) = IdLabel n c Closure
toClosureLbl l = pprPanic "toClosureLbl" (pprCLabel l)
toSlowEntryLbl :: CLabel -> CLabel
toSlowEntryLbl (IdLabel n c _) = IdLabel n c Slow
toSlowEntryLbl l = pprPanic "toSlowEntryLbl" (pprCLabel l)
toRednCountsLbl :: CLabel -> CLabel
toRednCountsLbl (IdLabel n c _) = IdLabel n c RednCounts
toRednCountsLbl l = pprPanic "toRednCountsLbl" (pprCLabel l)
toEntryLbl :: CLabel -> CLabel
toEntryLbl (IdLabel n c LocalInfoTable) = IdLabel n c LocalEntry
toEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry
toEntryLbl (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry
toEntryLbl (IdLabel n c _) = IdLabel n c Entry
toEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
toEntryLbl (CmmLabel m str CmmInfo) = CmmLabel m str CmmEntry
toEntryLbl (CmmLabel m str CmmRetInfo) = CmmLabel m str CmmRet
toEntryLbl l = pprPanic "toEntryLbl" (pprCLabel l)
toInfoLbl :: CLabel -> CLabel
toInfoLbl (IdLabel n c Entry) = IdLabel n c InfoTable
toInfoLbl (IdLabel n c LocalEntry) = IdLabel n c LocalInfoTable
toInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable
toInfoLbl (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable
toInfoLbl (IdLabel n c _) = IdLabel n c InfoTable
toInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
toInfoLbl (CmmLabel m str CmmEntry) = CmmLabel m str CmmInfo
toInfoLbl (CmmLabel m str CmmRet) = CmmLabel m str CmmRetInfo
toInfoLbl l = pprPanic "CLabel.toInfoLbl" (pprCLabel l)
-- -----------------------------------------------------------------------------
-- Does a CLabel refer to a CAF?
......
compiler/cmm/CmmBuildInfoTables.hs
View file @ 1c2f8953
......@@ -203,7 +203,7 @@ cafTransfers = mkBTransfer3 first middle last
CmmLit (CmmLabelOff c _) -> add c set
CmmLit (CmmLabelDiffOff c1 c2 _) -> add c1 $ add c2 set
_ -> set
add l s = if hasCAF l then Map.insert (cvtToClosureLbl l) () s else s
add l s = if hasCAF l then Map.insert (toClosureLbl l) () s else s
cafAnal :: CmmGraph -> FuelUniqSM CAFEnv
cafAnal g = liftM snd $ dataflowPassBwd g [] $ analBwd cafLattice cafTransfers
......@@ -341,7 +341,7 @@ localCAFInfo cafEnv (CmmProc top_info top_l (CmmGraph {g_entry=entry})) =
case info_tbl top_info of
CmmInfoTable { cit_rep = rep }
| not (isStaticRep rep)
-> Just (cvtToClosureLbl top_l,
-> Just (toClosureLbl top_l,
expectJust "maybeBindCAFs" $ mapLookup entry cafEnv)
_ -> Nothing
......
compiler/cmm/CmmInfo.hs
View file @ 1c2f8953
......@@ -156,7 +156,7 @@ mkInfoTableContents info@(CmmInfoTable { cit_lbl = info_lbl
, srt_lit, liveness_lit, slow_entry ]
; return (Nothing, Nothing, extra_bits, liveness_data) }
where
slow_entry = CmmLabel (slowEntryFromInfoLabel info_lbl)
slow_entry = CmmLabel (toSlowEntryLbl info_lbl)
srt_lit = case srt_label of
[] -> mkIntCLit 0
(lit:_rest) -> ASSERT( null _rest ) lit
......
compiler/codeGen/CgClosure.lhs
View file @ 1c2f8953
......@@ -449,38 +449,14 @@ blackHoleIt closure_info = emitBlackHoleCode (closureSingleEntry closure_info)
emitBlackHoleCode :: Bool -> Code
emitBlackHoleCode is_single_entry = do
dflags <- getDynFlags
-- If we wanted to do eager blackholing with slop filling,
-- we'd need to do it at the *end* of a basic block, otherwise
-- we overwrite the free variables in the thunk that we still
-- need. We have a patch for this from Andy Cheadle, but not
-- incorporated yet. --SDM [6/2004]
--
-- Profiling needs slop filling (to support LDV profiling), so
-- currently eager blackholing doesn't work with profiling.
--
-- Previously, eager blackholing was enabled when ticky-ticky
-- was on. But it didn't work, and it wasn't strictly necessary
-- to bring back minimal ticky-ticky, so now EAGER_BLACKHOLING
-- is unconditionally disabled. -- krc 1/2007
let eager_blackholing = not opt_SccProfilingOn
&& dopt Opt_EagerBlackHoling dflags
if eager_blackholing
then do
tickyBlackHole (not is_single_entry)
let bh_info = CmmReg (CmmGlobal EagerBlackholeInfo)
stmtsC [
CmmStore (cmmOffsetW (CmmReg nodeReg) fixedHdrSize)
(CmmReg (CmmGlobal CurrentTSO)),
CmmCall (CmmPrim MO_WriteBarrier) [] [] CmmUnsafe CmmMayReturn,
CmmStore (CmmReg nodeReg) bh_info
]
else
nopC
tickyBlackHole (not is_single_entry)
let bh_info = CmmReg (CmmGlobal EagerBlackholeInfo)
stmtsC [
CmmStore (cmmOffsetW (CmmReg nodeReg) fixedHdrSize)
(CmmReg (CmmGlobal CurrentTSO)),
CmmCall (CmmPrim MO_WriteBarrier) [] [] CmmUnsafe CmmMayReturn,
CmmStore (CmmReg nodeReg) bh_info
]
\end{code}
\begin{code}
......
compiler/codeGen/ClosureInfo.lhs
View file @ 1c2f8953
......@@ -33,7 +33,7 @@ module ClosureInfo (
isLFThunk, closureUpdReqd,
closureNeedsUpdSpace, closureIsThunk,
closureSingleEntry, closureReEntrant, isConstrClosure_maybe,
closureFunInfo, isStandardFormThunk, isKnownFun,
closureFunInfo, isKnownFun,
funTag, funTagLFInfo, tagForArity, clHasCafRefs,
enterIdLabel, enterLocalIdLabel, enterReturnPtLabel,
......@@ -118,7 +118,7 @@ data ClosureInfo
closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon (see below)
closureSMRep :: !SMRep, -- representation used by storage mgr
closureSRT :: !C_SRT, -- What SRT applies to this closure
closureType :: !Type, -- Type of closure (ToDo: remove)
closureType :: !Type, -- Type of closure (ToDo: remove)
closureDescr :: !String, -- closure description (for profiling)
closureInfLcl :: Bool -- can the info pointer be a local symbol?
}
......@@ -707,35 +707,48 @@ getCallMethod _ name _ (LFLetNoEscape arity) n_args
| n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity
| otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity)
blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool
-- Eager blackholing is normally disabled, but can be turned on with
-- -feager-blackholing. When it is on, we replace the info pointer of
-- the thunk with stg_EAGER_BLACKHOLE_info on entry.
-- If we wanted to do eager blackholing with slop filling,
-- we'd need to do it at the *end* of a basic block, otherwise
-- we overwrite the free variables in the thunk that we still
-- need. We have a patch for this from Andy Cheadle, but not
-- incorporated yet. --SDM [6/2004]
--
--
-- Previously, eager blackholing was enabled when ticky-ticky
-- was on. But it didn't work, and it wasn't strictly necessary
-- to bring back minimal ticky-ticky, so now EAGER_BLACKHOLING
-- is unconditionally disabled. -- krc 1/2007
-- Static closures are never themselves black-holed.
-- Updatable ones will be overwritten with a CAFList cell, which points to a
-- black hole;
-- Single-entry ones have no fvs to plug, and we trust they don't form part
-- of a loop.
blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool
blackHoleOnEntry _ ConInfo{} = False
blackHoleOnEntry dflags (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
| isStaticRep rep
blackHoleOnEntry dflags cl_info
| isStaticRep (closureSMRep cl_info)
= False -- Never black-hole a static closure
| otherwise
= case lf_info of
= case closureLFInfo cl_info of
LFReEntrant _ _ _ _ -> False
LFLetNoEscape _ -> False
LFLetNoEscape _ -> False
LFThunk _ no_fvs updatable _ _
-> if updatable
then not opt_OmitBlackHoling
else doingTickyProfiling dflags || not no_fvs
| eager_blackholing -> doingTickyProfiling dflags || not no_fvs
-- the former to catch double entry,
-- and the latter to plug space-leaks. KSW/SDM 1999-04.
| otherwise -> False
_ -> panic "blackHoleOnEntry" -- Should never happen
where eager_blackholing = not opt_SccProfilingOn
&& dopt Opt_EagerBlackHoling dflags
-- Profiling needs slop filling (to support
-- LDV profiling), so currently eager
-- blackholing doesn't work with profiling.
isStandardFormThunk :: LambdaFormInfo -> Bool
isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _) = True
isStandardFormThunk _ = False
_other -> panic "blackHoleOnEntry" -- Should never happen
isKnownFun :: LambdaFormInfo -> Bool
isKnownFun (LFReEntrant _ _ _ _) = True
......
compiler/codeGen/StgCmmBind.hs
View file @ 1c2f8953
......@@ -502,34 +502,14 @@ blackHoleIt :: ClosureInfo -> FCode ()
blackHoleIt closure_info = emitBlackHoleCode (closureSingleEntry closure_info)
emitBlackHoleCode :: Bool -> FCode ()
emitBlackHoleCode is_single_entry
| eager_blackholing = do
tickyBlackHole (not is_single_entry)
emit (mkStore (cmmOffsetW (CmmReg nodeReg) fixedHdrSize) (CmmReg (CmmGlobal CurrentTSO)))
emitPrimCall [] MO_WriteBarrier []
emit (mkStore (CmmReg nodeReg) (CmmLit (CmmLabel bh_lbl)))
| otherwise =
nopC
emitBlackHoleCode is_single_entry = do
tickyBlackHole (not is_single_entry)
emit (mkStore (cmmOffsetW (CmmReg nodeReg) fixedHdrSize) (CmmReg (CmmGlobal CurrentTSO)))
emitPrimCall [] MO_WriteBarrier []
emit (mkStore (CmmReg nodeReg) (CmmLit (CmmLabel bh_lbl)))
where
bh_lbl | is_single_entry = mkCmmDataLabel rtsPackageId (fsLit "stg_SE_BLACKHOLE_info")
| otherwise = mkCmmDataLabel rtsPackageId (fsLit "stg_BLACKHOLE_info")
-- If we wanted to do eager blackholing with slop filling,
-- we'd need to do it at the *end* of a basic block, otherwise
-- we overwrite the free variables in the thunk that we still
-- need. We have a patch for this from Andy Cheadle, but not
-- incorporated yet. --SDM [6/2004]
--
-- Profiling needs slop filling (to support LDV profiling), so
-- currently eager blackholing doesn't work with profiling.
--
-- Previously, eager blackholing was enabled when ticky-ticky
-- was on. But it didn't work, and it wasn't strictly necessary
-- to bring back minimal ticky-ticky, so now EAGER_BLACKHOLING
-- is unconditionally disabled. -- krc 1/2007
eager_blackholing = False
setupUpdate :: ClosureInfo -> LocalReg -> FCode () -> FCode ()
-- Nota Bene: this function does not change Node (even if it's a CAF),
-- so that the cost centre in the original closure can still be
......
compiler/codeGen/StgCmmClosure.hs
View file @ 1c2f8953
......@@ -7,8 +7,6 @@
--
-- Nothing monadic in here!
--
-- (c) The University of Glasgow 2004-2006
--
-----------------------------------------------------------------------------
{-# LANGUAGE RecordWildCards #-}
......@@ -19,8 +17,8 @@ module StgCmmClosure (
isVoidRep, isGcPtrRep, addIdReps, addArgReps,
argPrimRep,
-----------------------------------
LambdaFormInfo, -- Abstract
-- * LambdaFormInfo
LambdaFormInfo, -- Abstract
StandardFormInfo, -- ...ditto...
mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,
mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
......@@ -28,33 +26,37 @@ module StgCmmClosure (
lfDynTag,
maybeIsLFCon, isLFThunk, isLFReEntrant, lfUpdatable,
-----------------------------------
nodeMustPointToIt,
CallMethod(..), getCallMethod,
isKnownFun, funTag, tagForArity,
-- * ClosureInfo
ClosureInfo,
mkClosureInfo,
mkCmmInfo,
closureSize, closureName,
-- ** Inspection
closureLFInfo, closureName,
closureEntryLabel, closureInfoTableLabel, staticClosureLabel,
-- ** Labels
-- These just need the info table label
closureInfoLabel, staticClosureLabel,
closureRednCountsLabel, closureSlowEntryLabel, closureLocalEntryLabel,
closureLFInfo,
-- ** Predicates
-- These are really just functions on LambdaFormInfo
closureUpdReqd, closureSingleEntry,
closureReEntrant, closureFunInfo, isStandardFormThunk,
isKnownFun, funTag, tagForArity,
nodeMustPointToIt,
CallMethod(..), getCallMethod,
blackHoleOnEntry,
closureReEntrant, closureFunInfo,
isToplevClosure,
isToplevClosure,
isStaticClosure,
staticClosureNeedsLink,
blackHoleOnEntry, -- Needs LambdaFormInfo and SMRep
isStaticClosure, -- Needs SMPre
-- * InfoTables
mkDataConInfoTable,
cafBlackHoleInfoTable
cafBlackHoleInfoTable,
staticClosureNeedsLink,
) where
#include "../includes/MachDeps.h"
......@@ -85,6 +87,8 @@ import DynFlags
-- Representations
-----------------------------------------------------------------------------
-- Why are these here?
addIdReps :: [Id] -> [(PrimRep, Id)]
addIdReps ids = [(idPrimRep id, id) | id <- ids]
......@@ -153,36 +157,6 @@ data LambdaFormInfo
-- allocDynClosure needs a LambdaFormInfo
-------------------------
-- An ArgDsecr describes the argument pattern of a function
{- XXX -- imported from old ClosureInfo for now
data ArgDescr
= ArgSpec -- Fits one of the standard patterns
!StgHalfWord -- RTS type identifier ARG_P, ARG_N, ...
| ArgGen -- General case
Liveness -- Details about the arguments
-}
{- XXX -- imported from old ClosureInfo for now
-------------------------
-- We represent liveness bitmaps as a Bitmap (whose internal
-- representation really is a bitmap). These are pinned onto case return
-- vectors to indicate the state of the stack for the garbage collector.
--
-- In the compiled program, liveness bitmaps that fit inside a single
-- word (StgWord) are stored as a single word, while larger bitmaps are
-- stored as a pointer to an array of words.
data Liveness
= SmallLiveness -- Liveness info that fits in one word
StgWord -- Here's the bitmap
| BigLiveness -- Liveness info witha a multi-word bitmap
CLabel -- Label for the bitmap
-}
-------------------------
-- StandardFormInfo tells whether this thunk has one of
-- a small number of standard forms
......@@ -543,11 +517,6 @@ getCallMethod _ _name _ LFBlackHole _n_args
getCallMethod _ _name _ LFLetNoEscape _n_args
= JumpToIt
isStandardFormThunk :: LambdaFormInfo -> Bool
isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _) = True
isStandardFormThunk _other_lf_info = False
isKnownFun :: LambdaFormInfo -> Bool
isKnownFun (LFReEntrant _ _ _ _) = True
isKnownFun LFLetNoEscape = True
......@@ -640,53 +609,50 @@ staticClosureRequired binder other_binder_info other_lf_info = True
-}
-----------------------------------------------------------------------------
-- Data types for closure information}
-- Data types for closure information
-----------------------------------------------------------------------------
{- Information about a closure, from the code generator's point of view.
{- ClosureInfo: information about a binding
A ClosureInfo decribes the info pointer of a closure. It has
enough information
a) to construct the info table itself
b) to allocate a closure containing that info pointer (i.e.
it knows the info table label)
We make a ClosureInfo for each let binding (both top level and not),
but not bindings for data constructors: for those we build a CmmInfoTable
directly (see mkDataConInfoTable).
We make a ClosureInfo for each let binding (both top level and not),
but not bindings for data constructors.
Note [Closure CAF info]
~~~~~~~~~~~~~~~~~~~~~~~
The closureCafs field is relevant for *static closures only*. It
records whether a CAF is reachable from the code for the closure It is
initialised simply from the idCafInfo of the Id.
To a first approximation:
ClosureInfo = (LambdaFormInfo, CmmInfoTable)
A ClosureInfo has enough information
a) to construct the info table itself, and build other things
related to the binding (e.g. slow entry points for a function)
b) to allocate a closure containing that info pointer (i.e.
it knows the info table label)
-}
data ClosureInfo
= ClosureInfo {
-- these three are for making labels related to this closure:
closureName :: !Name, -- The thing bound to this closure
closureCafs :: !CafInfo, -- used for making labels only
closureLocal :: !Bool, -- make local labels?
-- this tells us about what the closure contains:
closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon
-- these fields tell us about the representation of the closure,
-- and are used for making an info table:
closureSMRep :: !SMRep, -- representation used by storage mgr
closureSRT :: !C_SRT, -- What SRT applies to this closure
closureProf :: !ProfilingInfo
closureName :: !Name, -- The thing bound to this closure
-- we don't really need this field: it's only used in generating
-- code for ticky and profiling, and we could pass the information
-- around separately, but it doesn't do much harm to keep it here.
closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon
-- this tells us about what the closure contains: it's right-hand-side.
-- the rest is just an unpacked CmmInfoTable.
closureInfoLabel :: !CLabel,
closureSMRep :: !SMRep, -- representation used by storage mgr
closureSRT :: !C_SRT, -- What SRT applies to this closure
closureProf :: !ProfilingInfo
}
-- | Convert from 'ClosureInfo' to 'CmmInfoTable'.
mkCmmInfo :: ClosureInfo -> CmmInfoTable
mkCmmInfo cl_info
= CmmInfoTable { cit_lbl = closureInfoTableLabel cl_info,
cit_rep = closureSMRep cl_info,
cit_prof = closureProf cl_info,
cit_srt = closureSRT cl_info }
mkCmmInfo ClosureInfo {..}
= CmmInfoTable { cit_lbl = closureInfoLabel
, cit_rep = closureSMRep
, cit_prof = closureProf
, cit_srt = closureSRT }
--------------------------------------
......@@ -701,60 +667,64 @@ mkClosureInfo :: Bool -- Is static
-> String -- String descriptor
-> ClosureInfo
mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info val_descr
= ClosureInfo { closureName = name,
closureCafs = cafs,
closureLocal = is_local,
closureLFInfo = lf_info,
closureSMRep = sm_rep, -- These four fields are a
closureSRT = srt_info, -- CmmInfoTable
closureProf = prof } -- ---
= ClosureInfo { closureName = name,
closureLFInfo = lf_info,
closureInfoLabel = info_lbl,
closureSMRep = sm_rep, -- These four fields are a
closureSRT = srt_info, -- CmmInfoTable
closureProf = prof } -- ---
where
name = idName id
sm_rep = mkHeapRep is_static ptr_wds nonptr_wds (lfClosureType lf_info)
prof = mkProfilingInfo id val_descr
nonptr_wds = tot_wds - ptr_wds
cafs = idCafInfo id
is_local = isDataConWorkId id
-- Make the _info pointer for the implicit datacon worker
-- binding local. The reason we can do this is that importing
-- code always either uses the _closure or _con_info. By the
-- invariants in CorePrep anything else gets eta expanded.
info_lbl = mkClosureInfoTableLabel id lf_info
--------------------------------------
-- Functions about closure *sizes*
-- Other functions over ClosureInfo
--------------------------------------
closureSize :: ClosureInfo -> WordOff
closureSize cl_info = heapClosureSize (closureSMRep cl_info)
-- Eager blackholing is normally disabled, but can be turned on with
-- -feager-blackholing. When it is on, we replace the info pointer of
-- the thunk with stg_EAGER_BLACKHOLE_info on entry.
--------------------------------------
-- Other functions over ClosureInfo
--------------------------------------
-- If we wanted to do eager blackholing with slop filling,
-- we'd need to do it at the *end* of a basic block, otherwise
-- we overwrite the free variables in the thunk that we still
-- need. We have a patch for this from Andy Cheadle, but not
-- incorporated yet. --SDM [6/2004]
--
--
-- Previously, eager blackholing was enabled when ticky-ticky
-- was on. But it didn't work, and it wasn't strictly necessary
-- to bring back minimal ticky-ticky, so now EAGER_BLACKHOLING
-- is unconditionally disabled. -- krc 1/2007
blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool
-- Static closures are never themselves black-holed.
-- Updatable ones will be overwritten with a CAFList cell, which points to a
-- black hole;
-- Single-entry ones have no fvs to plug, and we trust they don't form part
-- of a loop.
blackHoleOnEntry dflags (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
| isStaticRep rep
blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool
blackHoleOnEntry dflags cl_info
| isStaticRep (closureSMRep cl_info)
= False -- Never black-hole a static closure
| otherwise
= case lf_info of
= case closureLFInfo cl_info of
LFReEntrant _ _ _ _ -> False
LFLetNoEscape -> False
LFThunk _ no_fvs updatable _ _
-> if updatable
then not opt_OmitBlackHoling
else doingTickyProfiling dflags || not no_fvs
LFThunk _ no_fvs _updatable _ _
| eager_blackholing -> doingTickyProfiling dflags || not no_fvs
-- the former to catch double entry,
-- and the latter to plug space-leaks. KSW/SDM 1999-04.
| otherwise -> False
_other -> panic "blackHoleOnEntry" -- Should never happen
where eager_blackholing = not opt_SccProfilingOn
&& dopt Opt_EagerBlackHoling dflags
-- Profiling needs slop filling (to support
-- LDV profiling), so currently eager
-- blackholing doesn't work with profiling.
_other -> panic "blackHoleOnEntry" -- Should never happen
isStaticClosure :: ClosureInfo -> Bool
isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
......@@ -798,27 +768,22 @@ isToplevClosure (ClosureInfo { closureLFInfo = lf_info })