Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
4ebf65ab
Commit
4ebf65ab
authored
Aug 24, 2011
by
Simon Marlow
Browse files
eliminate ConInfo
parent
06447893
Changes
8
Hide whitespace changes
Inline
Side-by-side
compiler/cmm/SMRep.lhs
View file @
4ebf65ab
...
...
@@ -25,7 +25,7 @@ module SMRep (
mkHeapRep, blackHoleRep, mkStackRep, mkRTSRep,
-- ** Predicates
isStaticRep, isConRep, isThunkRep, isStaticNoCafCon,
isStaticRep, isConRep, isThunkRep,
isFunRep,
isStaticNoCafCon,
-- ** Size-related things
heapClosureSize,
...
...
@@ -196,6 +196,10 @@ isThunkRep (HeapRep _ _ _ ThunkSelector{}) = True
isThunkRep (HeapRep _ _ _ BlackHole{}) = True
isThunkRep _ = False
isFunRep :: SMRep -> Bool
isFunRep (HeapRep _ _ _ Fun{}) = True
isFunRep _ = False
isStaticNoCafCon :: SMRep -> Bool
-- This should line up exactly with CONSTR_NOCAF_STATIC above
-- See Note [Static NoCaf constructors]
...
...
compiler/codeGen/StgCmm.hs
View file @
4ebf65ab
...
...
@@ -24,7 +24,6 @@ import StgCmmTicky
import
Cmm
import
CLabel
import
PprCmm
import
StgSyn
import
DynFlags
...
...
compiler/codeGen/StgCmmBind.hs
View file @
4ebf65ab
...
...
@@ -298,7 +298,8 @@ mkRhsClosure bndr cc _ fvs upd_flag srt args body
;
(
use_cc
,
blame_cc
)
<-
chooseDynCostCentres
cc
args
body
;
emit
(
mkComment
$
mkFastString
"calling allocDynClosure"
)
;
let
toVarArg
(
NonVoid
a
,
off
)
=
(
NonVoid
(
StgVarArg
a
),
off
)
;
(
tmp
,
init
)
<-
allocDynClosure
closure_info
use_cc
blame_cc
;
let
info_tbl
=
mkCmmInfo
closure_info
;
(
tmp
,
init
)
<-
allocDynClosure
info_tbl
lf_info
use_cc
blame_cc
(
map
toVarArg
fv_details
)
-- RETURN
...
...
@@ -334,7 +335,9 @@ cgStdThunk bndr cc _bndr_info body lf_info payload
;
(
use_cc
,
blame_cc
)
<-
chooseDynCostCentres
cc
[
{- no args-}
]
body
-- BUILD THE OBJECT
;
(
tmp
,
init
)
<-
allocDynClosure
closure_info
use_cc
blame_cc
payload_w_offsets
;
let
info_tbl
=
mkCmmInfo
closure_info
;
(
tmp
,
init
)
<-
allocDynClosure
info_tbl
lf_info
use_cc
blame_cc
payload_w_offsets
-- RETURN
;
regIdInfo
bndr
lf_info
tmp
init
}
...
...
@@ -555,7 +558,7 @@ setupUpdate closure_info node body
;
if
closureUpdReqd
closure_info
then
do
-- Blackhole the (updatable) CAF:
{
upd_closure
<-
link_caf
closure_info
True
{
upd_closure
<-
link_caf
True
;
pushUpdateFrame
[
CmmReg
(
CmmLocal
upd_closure
),
mkLblExpr
mkUpdInfoLabel
]
body
}
-- XXX black hole
else
do
{
tickyUpdateFrameOmitted
;
body
}
...
...
@@ -611,8 +614,7 @@ pushUpdateFrame es body
-- be closer together, and the compiler wouldn't need to know
-- about off_indirectee etc.
link_caf
::
ClosureInfo
->
Bool
-- True <=> updatable, False <=> single-entry
link_caf
::
Bool
-- True <=> updatable, False <=> single-entry
->
FCode
LocalReg
-- Returns amode for closure to be updated
-- To update a CAF we must allocate a black hole, link the CAF onto the
-- CAF list, then update the CAF to point to the fresh black hole.
...
...
@@ -620,13 +622,14 @@ link_caf :: ClosureInfo
-- updated with the new value when available. The reason for all of this
-- is that we only want to update dynamic heap objects, not static ones,
-- so that generational GC is easier.
link_caf
cl_info
_is_upd
=
do
link_caf
_is_upd
=
do
{
-- Alloc black hole specifying CC_HDR(Node) as the cost centre
;
let
use_cc
=
costCentreFrom
(
CmmReg
nodeReg
)
blame_cc
=
use_cc
tso
=
CmmReg
(
CmmGlobal
CurrentTSO
)
-- XXX ezyang: FIXME
;
(
hp_rel
,
init
)
<-
allocDynClosureCmm
bh_cl_info
use_cc
blame_cc
[(
tso
,
fixedHdrSize
)]
;
(
hp_rel
,
init
)
<-
allocDynClosureCmm
cafBlackHoleInfoTable
mkLFBlackHole
use_cc
blame_cc
[(
tso
,
fixedHdrSize
)]
;
emit
init
-- Call the RTS function newCAF to add the CAF to the CafList
...
...
@@ -646,9 +649,6 @@ link_caf cl_info _is_upd = do
;
return
hp_rel
}
where
bh_cl_info
::
ClosureInfo
bh_cl_info
=
cafBlackHoleClosureInfo
cl_info
ind_static_info
::
CmmExpr
ind_static_info
=
mkLblExpr
mkIndStaticInfoLabel
...
...
compiler/codeGen/StgCmmClosure.hs
View file @
4ebf65ab
...
...
@@ -27,12 +27,13 @@ module StgCmmClosure (
StandardFormInfo
,
-- ...ditto...
mkLFThunk
,
mkLFReEntrant
,
mkConLFInfo
,
mkSelectorLFInfo
,
mkApLFInfo
,
mkLFImported
,
mkLFArgument
,
mkLFLetNoEscape
,
lfDynTag
,
maybeIsLFCon
,
isLFThunk
,
isLFReEntrant
,
mkLFBlackHole
,
lfDynTag
,
maybeIsLFCon
,
isLFThunk
,
isLFReEntrant
,
lfUpdatable
,
-----------------------------------
ClosureInfo
,
mkClosureInfo
,
mkConInfo
,
mkClosureInfo
,
mkCmmInfo
,
closureSize
,
...
...
@@ -40,7 +41,7 @@ module StgCmmClosure (
closureLabelFromCI
,
closureProf
,
closureSRT
,
closureLFInfo
,
closureSMRep
,
closureUpdReqd
,
closureIsThunk
,
closureSingleEntry
,
closureReEntrant
,
isConstrClosure_maybe
,
closureSingleEntry
,
closureReEntrant
,
closureFunInfo
,
isStandardFormThunk
,
isKnownFun
,
funTag
,
tagForArity
,
...
...
@@ -53,11 +54,11 @@ module StgCmmClosure (
isToplevClosure
,
isStaticClosure
,
cafBlackHoleClosureInfo
,
staticClosureNeedsLink
,
clHasCafRefs
,
clProfInfo
,
staticClosureNeedsLink
,
clHasCafRefs
,
mkDataConInfoTable
,
cafBlackHoleInfoTable
)
where
#
include
"../includes/MachDeps.h"
...
...
@@ -152,6 +153,9 @@ data LambdaFormInfo
-- of a CAF. We want the target of the update frame to
-- be in the heap, so we make a black hole to hold it.
-- XXX we can very nearly get rid of this, but
-- allocDynClosure needs a LambdaFormInfo
-------------------------
-- An ArgDsecr describes the argument pattern of a function
...
...
@@ -286,6 +290,10 @@ mkLFImported id
where
arity
=
idArity
id
------------
mkLFBlackHole
::
LambdaFormInfo
mkLFBlackHole
=
LFBlackHole
-----------------------------------------------------
-- Dynamic pointer tagging
-----------------------------------------------------
...
...
@@ -648,10 +656,8 @@ enough information
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)
- each data constructor (for its shared static and
dynamic info tables)
We make a ClosureInfo for each let binding (both top level and not),
but not bindings for data constructors.
Note [Closure CAF info]
~~~~~~~~~~~~~~~~~~~~~~~
...
...
@@ -674,22 +680,10 @@ data ClosureInfo
closureInfLcl
::
Bool
-- Can the info pointer be a local symbol?
}
-- Constructor closures don't have a unique info table label (they use
-- the constructor's info table), and they don't have an SRT.
|
ConInfo
{
closureCon
::
!
DataCon
,
closureSMRep
::
!
SMRep
,
closureCafs
::
!
CafInfo
-- See Note [Closure CAF info]
}
clHasCafRefs
::
ClosureInfo
->
CafInfo
-- Backward compatibility; remove
clHasCafRefs
=
closureCafs
clProfInfo
::
ClosureInfo
->
ProfilingInfo
clProfInfo
ClosureInfo
{
closureProf
=
p
}
=
p
clProfInfo
_
=
NoProfilingInfo
--------------------------------------
-- Building ClosureInfos
--------------------------------------
...
...
@@ -719,32 +713,6 @@ mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info val_descr
prof
=
mkProfilingInfo
id
val_descr
nonptr_wds
=
tot_wds
-
ptr_wds
mkConInfo
::
Bool
-- Is static
->
CafInfo
->
DataCon
->
Int
->
Int
-- Total and pointer words
->
ClosureInfo
mkConInfo
is_static
cafs
data_con
tot_wds
ptr_wds
=
ConInfo
{
closureSMRep
=
sm_rep
,
closureCafs
=
cafs
,
closureCon
=
data_con
}
where
sm_rep
=
mkHeapRep
is_static
ptr_wds
nonptr_wds
(
lfClosureType
lf_info
)
lf_info
=
mkConLFInfo
data_con
nonptr_wds
=
tot_wds
-
ptr_wds
-- We need a black-hole closure info to pass to @allocDynClosure@ when we
-- want to allocate the black hole on entry to a CAF. These are the only
-- ways to build an LFBlackHole, maintaining the invariant that it really
-- is a black hole and not something else.
cafBlackHoleClosureInfo
::
ClosureInfo
->
ClosureInfo
cafBlackHoleClosureInfo
cl_info
@
(
ClosureInfo
{})
=
cl_info
{
closureLFInfo
=
LFBlackHole
,
closureSMRep
=
blackHoleRep
,
closureSRT
=
NoC_SRT
,
closureInfLcl
=
False
}
cafBlackHoleClosureInfo
(
ConInfo
{})
=
panic
"cafBlackHoleClosureInfo"
-- Convert from 'ClosureInfo' to 'CmmInfoTable'.
-- Not used for return points.
...
...
@@ -752,7 +720,7 @@ mkCmmInfo :: ClosureInfo -> CmmInfoTable
mkCmmInfo
cl_info
=
CmmInfoTable
{
cit_lbl
=
infoTableLabelFromCI
cl_info
,
cit_rep
=
closureSMRep
cl_info
,
cit_prof
=
clProf
Info
cl_info
,
cit_prof
=
cl
osure
Prof
cl_info
,
cit_srt
=
closureSRT
cl_info
}
...
...
@@ -774,7 +742,6 @@ blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool
-- Single-entry ones have no fvs to plug, and we trust they don't form part
-- of a loop.
blackHoleOnEntry
_
ConInfo
{}
=
False
blackHoleOnEntry
dflags
(
ClosureInfo
{
closureLFInfo
=
lf_info
,
closureSMRep
=
rep
})
|
isStaticRep
rep
=
False
-- Never black-hole a static closure
...
...
@@ -797,7 +764,6 @@ isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
closureUpdReqd
::
ClosureInfo
->
Bool
closureUpdReqd
ClosureInfo
{
closureLFInfo
=
lf_info
}
=
lfUpdatable
lf_info
closureUpdReqd
ConInfo
{}
=
False
lfUpdatable
::
LambdaFormInfo
->
Bool
lfUpdatable
(
LFThunk
_
_
upd
_
_
)
=
upd
...
...
@@ -808,7 +774,6 @@ lfUpdatable _ = False
closureIsThunk
::
ClosureInfo
->
Bool
closureIsThunk
ClosureInfo
{
closureLFInfo
=
lf_info
}
=
isLFThunk
lf_info
closureIsThunk
ConInfo
{}
=
False
closureSingleEntry
::
ClosureInfo
->
Bool
closureSingleEntry
(
ClosureInfo
{
closureLFInfo
=
LFThunk
_
_
upd
_
_
})
=
not
upd
...
...
@@ -818,13 +783,8 @@ closureReEntrant :: ClosureInfo -> Bool
closureReEntrant
(
ClosureInfo
{
closureLFInfo
=
LFReEntrant
_
_
_
_
})
=
True
closureReEntrant
_
=
False
isConstrClosure_maybe
::
ClosureInfo
->
Maybe
DataCon
isConstrClosure_maybe
(
ConInfo
{
closureCon
=
data_con
})
=
Just
data_con
isConstrClosure_maybe
_
=
Nothing
closureFunInfo
::
ClosureInfo
->
Maybe
(
Int
,
ArgDescr
)
closureFunInfo
(
ClosureInfo
{
closureLFInfo
=
lf_info
})
=
lfFunInfo
lf_info
closureFunInfo
_
=
Nothing
lfFunInfo
::
LambdaFormInfo
->
Maybe
(
Int
,
ArgDescr
)
lfFunInfo
(
LFReEntrant
_
arity
_
arg_desc
)
=
Just
(
arity
,
arg_desc
)
...
...
@@ -832,7 +792,6 @@ lfFunInfo _ = Nothing
funTag
::
ClosureInfo
->
DynTag
funTag
(
ClosureInfo
{
closureLFInfo
=
lf_info
})
=
lfDynTag
lf_info
funTag
(
ConInfo
{})
=
panic
"funTag"
isToplevClosure
::
ClosureInfo
->
Bool
isToplevClosure
(
ClosureInfo
{
closureLFInfo
=
lf_info
})
...
...
@@ -840,7 +799,6 @@ isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
LFReEntrant
TopLevel
_
_
_
->
True
LFThunk
TopLevel
_
_
_
_
->
True
_other
->
False
isToplevClosure
_
=
False
--------------------------------------
-- Label generation
...
...
@@ -871,14 +829,6 @@ infoTableLabelFromCI (ClosureInfo { closureName = name,
std_mk_lbl
|
is_lcl
=
mkLocalInfoTableLabel
|
otherwise
=
mkInfoTableLabel
infoTableLabelFromCI
(
ConInfo
{
closureCon
=
con
,
closureSMRep
=
rep
,
closureCafs
=
cafs
})
|
isStaticRep
rep
=
mkStaticInfoTableLabel
name
cafs
|
otherwise
=
mkConInfoTableLabel
name
cafs
where
name
=
dataConName
con
-- ClosureInfo for a closure (as opposed to a constructor) is always local
closureLabelFromCI
::
ClosureInfo
->
CLabel
closureLabelFromCI
cl
@
(
ClosureInfo
{
closureName
=
nm
})
=
...
...
@@ -984,6 +934,15 @@ mkDataConInfoTable data_con is_static ptr_wds nonptr_wds
ty_descr
=
stringToWord8s
$
occNameString
$
getOccName
$
dataConTyCon
data_con
val_descr
=
stringToWord8s
$
occNameString
$
getOccName
data_con
-- We need a black-hole closure info to pass to @allocDynClosure@ when we
-- want to allocate the black hole on entry to a CAF.
cafBlackHoleInfoTable
::
CmmInfoTable
cafBlackHoleInfoTable
=
CmmInfoTable
{
cit_lbl
=
mkCAFBlackHoleInfoTableLabel
,
cit_rep
=
blackHoleRep
,
cit_prof
=
NoProfilingInfo
,
cit_srt
=
NoC_SRT
}
staticClosureNeedsLink
::
CmmInfoTable
->
Bool
-- A static closure needs a link field to aid the GC when traversing
...
...
@@ -996,3 +955,4 @@ staticClosureNeedsLink info_tbl@CmmInfoTable{ cit_rep = smrep }
|
isConRep
smrep
=
not
(
isStaticNoCafCon
smrep
)
|
otherwise
=
needsSRT
(
cit_srt
info_tbl
)
staticClosureNeedsLink
_
=
False
compiler/codeGen/StgCmmCon.hs
View file @
4ebf65ab
...
...
@@ -34,7 +34,6 @@ import Module
import
Constants
import
DataCon
import
FastString
import
IdInfo
(
CafInfo
(
..
)
)
import
Id
import
Literal
import
PrelInfo
...
...
@@ -202,8 +201,10 @@ buildDynCon binder ccs con args
=
do
{
let
(
tot_wds
,
ptr_wds
,
args_w_offsets
)
=
mkVirtConstrOffsets
(
addArgReps
args
)
-- No void args in args_w_offsets
cl_info
=
mkConInfo
False
NoCafRefs
con
tot_wds
ptr_wds
;
(
tmp
,
init
)
<-
allocDynClosure
cl_info
use_cc
blame_cc
args_w_offsets
nonptr_wds
=
tot_wds
-
ptr_wds
info_tbl
=
mkDataConInfoTable
con
False
ptr_wds
nonptr_wds
;
(
tmp
,
init
)
<-
allocDynClosure
info_tbl
lf_info
use_cc
blame_cc
args_w_offsets
;
regIdInfo
binder
lf_info
tmp
init
}
where
lf_info
=
mkConLFInfo
con
...
...
compiler/codeGen/StgCmmHeap.hs
View file @
4ebf65ab
...
...
@@ -49,7 +49,8 @@ import Constants
-----------------------------------------------------------
allocDynClosure
::
ClosureInfo
::
CmmInfoTable
->
LambdaFormInfo
->
CmmExpr
-- Cost Centre to stick in the object
->
CmmExpr
-- Cost Centre to blame for this alloc
-- (usually the same; sometimes "OVERHEAD")
...
...
@@ -60,7 +61,7 @@ allocDynClosure
->
FCode
(
LocalReg
,
CmmAGraph
)
allocDynClosureCmm
::
C
losure
Info
->
CmmExpr
->
CmmExpr
::
C
mmInfoTable
->
LambdaForm
Info
->
CmmExpr
->
CmmExpr
->
[(
CmmExpr
,
VirtualHpOffset
)]
->
FCode
(
LocalReg
,
CmmAGraph
)
...
...
@@ -81,18 +82,20 @@ allocDynClosureCmm
-- but Hp+8 means something quite different...
allocDynClosure
cl
_info
use_cc
_blame_cc
args_w_offsets
allocDynClosure
info_tbl
lf
_info
use_cc
_blame_cc
args_w_offsets
=
do
{
let
(
args
,
offsets
)
=
unzip
args_w_offsets
;
cmm_args
<-
mapM
getArgAmode
args
-- No void args
;
allocDynClosureCmm
cl_info
use_cc
_blame_cc
(
zip
cmm_args
offsets
)
;
allocDynClosureCmm
info_tbl
lf_info
use_cc
_blame_cc
(
zip
cmm_args
offsets
)
}
allocDynClosureCmm
cl
_info
use_cc
_blame_cc
amodes_w_offsets
allocDynClosureCmm
info_tbl
lf
_info
use_cc
_blame_cc
amodes_w_offsets
=
do
{
virt_hp
<-
getVirtHp
-- SAY WHAT WE ARE ABOUT TO DO
;
tickyDynAlloc
cl_info
;
profDynAlloc
cl_info
use_cc
;
let
rep
=
cit_rep
info_tbl
;
tickyDynAlloc
rep
lf_info
;
profDynAlloc
rep
use_cc
-- ToDo: This is almost certainly wrong
-- We're ignoring blame_cc. But until we've
-- fixed the boxing hack in chooseDynCostCentres etc,
...
...
@@ -106,7 +109,7 @@ allocDynClosureCmm cl_info use_cc _blame_cc amodes_w_offsets
-- Remember, virtHp points to last allocated word,
-- ie 1 *before* the info-ptr word of new object.
info_ptr
=
CmmLit
(
CmmLabel
(
infoTableLabelFromCI
cl_info
))
info_ptr
=
CmmLit
(
CmmLabel
(
cit_lbl
info_tbl
))
-- ALLOCATE THE OBJECT
;
base
<-
getHpRelOffset
info_offset
...
...
@@ -116,7 +119,7 @@ allocDynClosureCmm cl_info use_cc _blame_cc amodes_w_offsets
;
hpStore
base
cmm_args
offsets
-- BUMP THE VIRTUAL HEAP POINTER
;
setVirtHp
(
virt_hp
+
c
losureSize
cl_info
)
;
setVirtHp
(
virt_hp
+
heapC
losureSize
rep
)
-- Assign to a temporary and return
-- Note [Return a LocalReg]
...
...
compiler/codeGen/StgCmmProf.hs
View file @
4ebf65ab
...
...
@@ -156,10 +156,10 @@ restoreCurrentCostCentre (Just local_cc)
-- | Record the allocation of a closure. The CmmExpr is the cost
-- centre stack to which to attribute the allocation.
profDynAlloc
::
ClosureInfo
->
CmmExpr
->
FCode
()
profDynAlloc
cl_info
ccs
profDynAlloc
::
SMRep
->
CmmExpr
->
FCode
()
profDynAlloc
rep
ccs
=
ifProfiling
$
profAlloc
(
CmmLit
(
mkIntCLit
(
c
losureSize
cl_info
)))
ccs
profAlloc
(
CmmLit
(
mkIntCLit
(
heapC
losureSize
rep
)))
ccs
-- | Record the allocation of a closure (size is given by a CmmExpr)
-- The size must be in words, because the allocation counter in a CCS counts
...
...
compiler/codeGen/StgCmmTicky.hs
View file @
4ebf65ab
...
...
@@ -51,6 +51,7 @@ import CmmExpr
import
MkGraph
import
CmmUtils
import
CLabel
import
SMRep
import
Module
import
Name
...
...
@@ -266,25 +267,24 @@ argChar DoubleArg = 'd'
-- -----------------------------------------------------------------------------
-- Ticky allocation
tickyDynAlloc
::
Closure
Info
->
FCode
()
tickyDynAlloc
::
SMRep
->
LambdaForm
Info
->
FCode
()
-- Called when doing a dynamic heap allocation
tickyDynAlloc
cl_info
-- LambdaFormInfo only needed to distinguish between updatable/non-updatable thunks
tickyDynAlloc
rep
lf
=
ifTicky
$
case
()
of
_
|
Just
_
<-
maybeIsLFCon
lf
->
tick_alloc_con
|
isLFThunk
lf
->
tick_alloc_thk
|
is
LFReEntrant
lf
->
tick_alloc_fun
|
otherwise
->
return
()
_
|
isConRep
rep
->
tick_alloc_con
|
isThunkRep
rep
->
tick_alloc_thk
|
is
FunRep
rep
->
tick_alloc_fun
|
otherwise
->
return
()
where
lf
=
closureLFInfo
cl_info
-- will be needed when we fill in stubs
_cl_size
=
closureSize
cl_info
-- will be needed when we fill in stubs
_cl_size
=
heapClosureSize
rep
-- _slop_size = slopSize cl_info
tick_alloc_thk
|
closureUpdReqd
cl_info
=
tick_alloc_up_thk
|
otherwise
=
tick_alloc_se_thk
|
lfUpdatable
lf
=
tick_alloc_up_thk
|
otherwise
=
tick_alloc_se_thk
-- krc: changed from panic to return ()
-- just to get something working
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment