Skip to content
GitLab
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
7ed4f071
Commit
7ed4f071
authored
Sep 07, 2007
by
nr@eecs.harvard.edu
Browse files
wrote an analysis to help in sinking Reload instructions
parent
78e55cb0
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/cmm/CmmExpr.hs
View file @
7ed4f071
...
...
@@ -8,7 +8,7 @@ module CmmExpr
,
GlobalReg
(
..
),
globalRegRep
,
spReg
,
hpReg
,
spLimReg
,
nodeReg
,
node
,
UserOfLocalRegs
,
foldRegsUsed
,
RegSet
,
emptyRegSet
,
elemRegSet
,
extendRegSet
,
deleteFromRegSet
,
mkRegSet
,
plusRegSet
,
minusRegSet
,
plusRegSet
,
minusRegSet
,
timesRegSet
)
where
...
...
@@ -95,7 +95,7 @@ elemRegSet :: LocalReg -> RegSet -> Bool
extendRegSet
::
RegSet
->
LocalReg
->
RegSet
deleteFromRegSet
::
RegSet
->
LocalReg
->
RegSet
mkRegSet
::
[
LocalReg
]
->
RegSet
minusRegSet
,
plusRegSet
::
RegSet
->
RegSet
->
RegSet
minusRegSet
,
plusRegSet
,
timesRegSet
::
RegSet
->
RegSet
->
RegSet
emptyRegSet
=
emptyUniqSet
elemRegSet
=
elementOfUniqSet
...
...
@@ -104,6 +104,7 @@ deleteFromRegSet = delOneFromUniqSet
mkRegSet
=
mkUniqSet
minusRegSet
=
minusUniqSet
plusRegSet
=
unionUniqSets
timesRegSet
=
intersectUniqSets
-----------------------------------------------------------------------------
-- Register-use information for expressions and other types
...
...
@@ -119,6 +120,9 @@ instance UserOfLocalRegs CmmReg where
instance
UserOfLocalRegs
LocalReg
where
foldRegsUsed
f
z
r
=
f
z
r
instance
UserOfLocalRegs
RegSet
where
foldRegsUsed
f
=
foldUniqSet
(
flip
f
)
instance
UserOfLocalRegs
CmmExpr
where
foldRegsUsed
f
z
e
=
expr
z
e
where
expr
z
(
CmmLit
_
)
=
z
...
...
compiler/cmm/CmmLiveZ.hs
View file @
7ed4f071
...
...
@@ -36,7 +36,7 @@ liveLattice = DataflowLattice "live LocalReg's" emptyUniqSet add False
type
BlockEntryLiveness
=
BlockEnv
CmmLive
-----------------------------------------------------------------------------
-- | Calculated liveness info for a
list of 'CmmBasicBlock'
-- | Calculated liveness info for a
CmmGraph
-----------------------------------------------------------------------------
cmmLivenessZ
::
CmmGraph
->
BlockEntryLiveness
cmmLivenessZ
g
=
env
...
...
compiler/cmm/CmmSpillReload.hs
View file @
7ed4f071
...
...
@@ -7,10 +7,13 @@ module CmmSpillReload
,
insertSpillsAndReloads
--- XXX todo check live-in at entry against formals
,
dualLivenessWithInsertion
,
spillAndReloadComments
,
availRegsLattice
,
cmmAvailableReloads
)
where
import
CmmExpr
import
CmmTx
()
import
CmmTx
import
CmmLiveZ
import
DFMonad
import
FastString
...
...
@@ -191,8 +194,6 @@ show_regs s regs = MidComment $ mkFastString $ showSDoc $ ppr_regs s regs
----------------------------------------------------------------
--- sinking reloads
{-
-- The idea is to compute at each point the set of registers such that
-- on every path to the point, the register is defined by a Reload
-- instruction. Then, if a use appears at such a point, we can safely
...
...
@@ -202,21 +203,69 @@ show_regs s regs = MidComment $ mkFastString $ showSDoc $ ppr_regs s regs
data
AvailRegs
=
UniverseMinus
RegSet
|
AvailRegs
RegSet
availRegsLattice
::
DataflowLattice
AvailRegs
availRegsLattice =
DataflowLattice "register gotten from reloads" empty add False
where empty = DualLive emptyRegSet emptyRegSet
availRegsLattice
=
DataflowLattice
"register gotten from reloads"
empty
add
True
where
empty
=
UniverseMinus
emptyRegSet
-- | compute in the Tx monad to track whether anything has changed
add new old = do stack <- add1 (on_stack new) (on_stack old)
regs <- add1 (in_regs new) (in_regs old)
return $ DualLive stack regs
add1 = fact_add_to liveLattice
-}
add
new
old
=
let
join
=
interAvail
new
old
in
if
join
`
smallerAvail
`
old
then
aTx
join
else
noTx
join
interAvail
::
AvailRegs
->
AvailRegs
->
AvailRegs
interAvail
(
UniverseMinus
s
)
(
UniverseMinus
s'
)
=
UniverseMinus
(
s
`
plusRegSet
`
s'
)
interAvail
(
AvailRegs
s
)
(
AvailRegs
s'
)
=
AvailRegs
(
s
`
timesRegSet
`
s'
)
interAvail
(
AvailRegs
s
)
(
UniverseMinus
s'
)
=
AvailRegs
(
s
`
minusRegSet
`
s'
)
interAvail
(
UniverseMinus
s
)
(
AvailRegs
s'
)
=
AvailRegs
(
s'
`
minusRegSet
`
s
)
smallerAvail
::
AvailRegs
->
AvailRegs
->
Bool
smallerAvail
(
AvailRegs
_
)
(
UniverseMinus
_
)
=
True
smallerAvail
(
UniverseMinus
_
)
(
AvailRegs
_
)
=
False
smallerAvail
(
AvailRegs
s
)
(
AvailRegs
s'
)
=
sizeUniqSet
s
<
sizeUniqSet
s'
smallerAvail
(
UniverseMinus
s
)
(
UniverseMinus
s'
)
=
sizeUniqSet
s
>
sizeUniqSet
s'
extendAvail
::
AvailRegs
->
LocalReg
->
AvailRegs
extendAvail
(
UniverseMinus
s
)
r
=
UniverseMinus
(
deleteFromRegSet
s
r
)
extendAvail
(
AvailRegs
s
)
r
=
AvailRegs
(
extendRegSet
s
r
)
deleteFromAvail
::
AvailRegs
->
LocalReg
->
AvailRegs
deleteFromAvail
(
UniverseMinus
s
)
r
=
UniverseMinus
(
extendRegSet
s
r
)
deleteFromAvail
(
AvailRegs
s
)
r
=
AvailRegs
(
deleteFromRegSet
s
r
)
cmmAvailableReloads
::
LGraph
M
Last
->
BlockEnv
AvailRegs
cmmAvailableReloads
g
=
env
where
env
=
runDFA
availRegsLattice
$
do
run_f_anal
transfer
(
fact_bot
availRegsLattice
)
g
allFacts
transfer
::
FAnalysis
M
Last
AvailRegs
transfer
=
FComp
"available-reloads analysis"
first
middle
last
exit
exit
_
=
LastOutFacts
[]
first
avail
_
=
avail
middle
=
flip
middleAvail
last
=
lastAvail
-- | The transfer equations use the traditional 'gen' and 'kill'
-- notations, which should be familiar from the dragon book.
agen
,
akill
::
UserOfLocalRegs
a
=>
a
->
AvailRegs
->
AvailRegs
agen
a
live
=
foldRegsUsed
extendAvail
live
a
akill
a
live
=
foldRegsUsed
deleteFromAvail
live
a
middleAvail
::
M
->
AvailRegs
->
AvailRegs
middleAvail
(
Spill
_
)
=
id
middleAvail
(
Reload
regs
)
=
agen
regs
middleAvail
(
NotSpillOrReload
m
)
=
middle
m
where
middle
(
MidNop
)
=
id
middle
(
MidComment
{})
=
id
middle
(
MidAssign
lhs
_expr
)
=
akill
lhs
middle
(
MidStore
{})
=
id
middle
(
MidUnsafeCall
_tgt
ress
_args
)
=
akill
ress
middle
(
CopyIn
_
formals
_
)
=
akill
formals
middle
(
CopyOut
{})
=
id
lastAvail
::
AvailRegs
->
Last
->
LastOutFacts
AvailRegs
lastAvail
avail
l
=
LastOutFacts
$
map
(
\
id
->
(
id
,
avail
))
$
succs
l
---------------------
...
...
@@ -246,6 +295,10 @@ instance Outputable DualLive where
if
isEmptyUniqSet
stack
then
PP
.
empty
else
(
ppr_regs
"live on stack ="
stack
)]
instance
Outputable
AvailRegs
where
ppr
(
UniverseMinus
s
)
=
ppr_regs
"available = all but"
s
ppr
(
AvailRegs
s
)
=
ppr_regs
"available = "
s
my_trace
::
String
->
SDoc
->
a
->
a
my_trace
=
if
False
then
pprTrace
else
\
_
_
a
->
a
...
...
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