Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
1c2f8953
Commit
1c2f8953
authored
Aug 24, 2011
by
Simon Marlow
Browse files
refactoring and fixing the stage 2 compilation
parent
fb127a99
Changes
13
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
(
cvtT
oClosureLbl
l
)
()
s
else
s
add
l
s
=
if
hasCAF
l
then
Map
.
insert
(
t
oClosureLbl
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
(
cvtT
oClosureLbl
top_l
,
->
Just
(
t
oClosureLbl
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
(
s
lowEntry
FromInfoLabe
l
info_lbl
)
slow_entry
=
CmmLabel
(
toS
lowEntry
Lb
l
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 l
f
_info of
= case
closureLFInfo c
l_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
-----------------------------------------------------------------------------
{-
I
nformation about a
closure, from the code generator's point of view.
{-
ClosureInfo: i
nformation 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
{
--
t
he
se
th
ree are for making labels relate
d to this closure
:
closureName
::
!
Name
,
-- The thing bound to this closure
closureCafs
::
!
CafInfo
,
-- used
for
ma
king labels only
closureLocal
::
!
Bool
,
-- make local labels?
-- this tells us about what the closure contains:
closureLFInfo
::
!
LambdaFormInfo
,
-- NOTE: not an LFCon
-- the
se 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
,
--
T
he th
ing boun
d 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 in
forma
tion
-- 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
=
closureInfo
TableLabel
cl_info
,
cit_rep
=
closureSMRep
cl_info
,
cit_prof
=
closureProf
cl_info
,
cit_srt
=
closureSRT
cl_info
}
mkCmmInfo
ClosureInfo
{
..
}
=
CmmInfoTable
{
cit_lbl
=
closureInfo
Label
,
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
--------------------------------------
--
F
unctions
about closure *sizes*
--
Other f
unctions
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
l
f
_info
of
=
case
closureLFInfo
c
l_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 })