Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
GHC
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
4,321
Issues
4,321
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
362
Merge Requests
362
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
1c2f8953
Commit
1c2f8953
authored
Aug 24, 2011
by
Simon Marlow
2
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
refactoring and fixing the stage 2 compilation
parent
fb127a99
Changes
13
Hide whitespace changes
Inline
Side-by-side
Showing
13 changed files
with
200 additions
and
262 deletions
+200
-262
compiler/cmm/CLabel.hs
compiler/cmm/CLabel.hs
+39
-38
compiler/cmm/CmmBuildInfoTables.hs
compiler/cmm/CmmBuildInfoTables.hs
+2
-2
compiler/cmm/CmmInfo.hs
compiler/cmm/CmmInfo.hs
+1
-1
compiler/codeGen/CgClosure.lhs
compiler/codeGen/CgClosure.lhs
+8
-32
compiler/codeGen/ClosureInfo.lhs
compiler/codeGen/ClosureInfo.lhs
+32
-19
compiler/codeGen/StgCmmBind.hs
compiler/codeGen/StgCmmBind.hs
+5
-25
compiler/codeGen/StgCmmClosure.hs
compiler/codeGen/StgCmmClosure.hs
+107
-138
compiler/codeGen/StgCmmLayout.hs
compiler/codeGen/StgCmmLayout.hs
+1
-1
compiler/ghci/ByteCodeAsm.lhs
compiler/ghci/ByteCodeAsm.lhs
+1
-0
compiler/ghci/ByteCodeGen.lhs
compiler/ghci/ByteCodeGen.lhs
+1
-0
compiler/ghci/ByteCodeInstr.lhs
compiler/ghci/ByteCodeInstr.lhs
+1
-0
compiler/ghci/ByteCodeItbls.lhs
compiler/ghci/ByteCodeItbls.lhs
+1
-1
compiler/main/StaticFlags.hs
compiler/main/StaticFlags.hs
+1
-5
No files found.
compiler/cmm/CLabel.hs
View file @
1c2f8953
...
...
@@ -22,7 +22,7 @@ module CLabel (
mkSRTLabel
,
mkInfoTableLabel
,
mkEntryLabel
,
mkSlowEntryLabel
,
slowEntryFromInfo
Label
,
mkSlowEntry
Label
,
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
(
slowEntryFromInfoLabe
l
info_lbl
)
slow_entry
=
CmmLabel
(
toSlowEntryLb
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
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
-- 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
,
-- 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
=
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
--------------------------------------
--
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 })
-- Label generation
--------------------------------------
closureEntryLabel
::
ClosureInfo
->
CLabel
closureEntryLabel
=
infoLblToEntryLbl
.
closureInfoTableLabel
staticClosureLabel
::
ClosureInfo
->
CLabel
staticClosureLabel
=
cvtToClosureLbl
.
closureInfoTable
Label
staticClosureLabel
=
toClosureLbl
.
closureInfo
Label
closureRednCountsLabel
::
ClosureInfo
->
CLabel
closureRednCountsLabel
ClosureInfo
{
..
}
=
mkRednCountsLabel
closureName
closureCafs
closureRednCountsLabel
=
toRednCountsLbl
.
closureInfoLabel
closureSlowEntryLabel
::
ClosureInfo
->
CLabel
closureSlowEntryLabel
ClosureInfo
{
..
}
=
mkSlowEntryLabel
closureName
closureCafs
closureSlowEntryLabel
=
toSlowEntryLbl
.
closureInfoLabel
closureLocalEntryLabel
::
ClosureInfo
->
CLabel
closureLocalEntryLabel
ClosureInfo
{
..
}
=
enterLocalIdLabel
closureName
closureCafs
closureLocalEntryLabel
|
tablesNextToCode
=
toInfoLbl
.
closureInfoLabel