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
a12bf21a
Commit
a12bf21a
authored
Sep 11, 2007
by
Ben.Lippmeier@anu.edu.au
Browse files
Better handling of live range joins via spill slots in spill cleaner
parent
d438785e
Changes
2
Hide whitespace changes
Inline
Side-by-side
compiler/nativeGen/RegAllocColor.hs
View file @
a12bf21a
...
...
@@ -135,7 +135,7 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
let
code_spillclean
=
map
cleanSpills
code_patched
-- strip off liveness information
let
code_nat
=
map
stripLive
code_
patched
let
code_nat
=
map
stripLive
code_
spillclean
-- rewrite SPILL/RELOAD pseudos into real instructions
let
spillNatTop
=
mapGenBlockTop
spillNatBlock
...
...
compiler/nativeGen/RegSpillClean.hs
View file @
a12bf21a
...
...
@@ -36,13 +36,13 @@ import Cmm
import
UniqSet
import
UniqFM
import
Unique
import
State
import
Outputable
import
Data.Maybe
import
Data.List
type
Slot
=
Int
-- | Clean out unneeded spill/reloads from this top level thing.
cleanSpills
::
LiveCmmTop
->
LiveCmmTop
cleanSpills
cmm
...
...
@@ -112,7 +112,7 @@ cleanBlock (BasicBlock id instrs)
-- then we don't need to do the reload.
--
cleanReload
::
Assoc
Reg
Slot
-- ^ a reg and slot
are associated
when
they have the same value
.
::
Assoc
Store
-- ^ two store locations
are associated
if
they have the same value
->
[
LiveInstr
]
-- ^ acc
->
[
LiveInstr
]
-- ^ instrs to clean (in backwards order)
->
CleanM
[
LiveInstr
]
-- ^ cleaned instrs (in forward order)
...
...
@@ -120,31 +120,62 @@ cleanReload
cleanReload
_
acc
[]
=
return
acc
-- write out live range joins via spill slots to just a spill and a reg-reg move
-- hopefully the spill will be also be cleaned in the next pass
--
cleanReload
assoc
acc
(
Instr
i1
live1
:
Instr
i2
_
:
instrs
)
|
SPILL
reg1
slot1
<-
i1
,
RELOAD
slot2
reg2
<-
i2
,
slot1
==
slot2
=
do
modify
$
\
s
->
s
{
sCleanedReloadsAcc
=
sCleanedReloadsAcc
s
+
1
}
cleanReload
assoc
acc
(
Instr
i1
live1
:
Instr
(
mkRegRegMoveInstr
reg1
reg2
)
Nothing
:
instrs
)
cleanReload
assoc
acc
(
li
@
(
Instr
i1
_
)
:
instrs
)
|
Just
(
r1
,
r2
)
<-
isRegRegMove
i1
=
if
r1
==
r2
-- erase any left over nop reg reg moves while we're here
-- this will also catch any nop moves that the "write out live range joins" case above
-- happens to add
then
cleanReload
assoc
acc
instrs
-- if r1 has the same value as some slots and we copy r1 to r2,
-- then r2 is now associated with those slots instead
else
do
let
assoc'
=
addAssoc
(
SReg
r1
)
(
SReg
r2
)
$
delAssoc
(
SReg
r2
)
$
assoc
cleanReload
assoc'
(
li
:
acc
)
instrs
cleanReload
assoc
acc
(
li
@
(
Instr
instr
_
)
:
instrs
)
|
SPILL
reg
slot
<-
instr
=
let
assoc'
=
addAssoc
reg
slot
-- doing the spill makes reg and slot the same value
$
del
eteB
Assoc
slot
-- slot value changes on spill
=
let
assoc'
=
addAssoc
(
SReg
reg
)
(
SSlot
slot
)
-- doing the spill makes reg and slot the same value
$
delAssoc
(
SSlot
slot
)
-- slot value changes on spill
$
assoc
in
cleanReload
assoc'
(
li
:
acc
)
instrs
|
RELOAD
slot
reg
<-
instr
=
if
elemAssoc
reg
slot
assoc
=
if
elemAssoc
(
SSlot
slot
)
(
SReg
reg
)
assoc
-- reg and slot had the same value before reload
-- we don't need the reload.
--
if the
reg and slot had the same value before reload
--
then
we don't need the reload.
then
do
modify
$
\
s
->
s
{
sCleanedReloadsAcc
=
sCleanedReloadsAcc
s
+
1
}
cleanReload
assoc
acc
instrs
-- reg and slot had different values before reload
else
let
assoc'
=
addAssoc
reg
slot
-- doing the reload makes reg and slot the same value
$
del
eteA
Assoc
reg
-- reg value changes on reload
let
assoc'
=
addAssoc
(
SReg
reg
)
(
SSlot
slot
)
-- doing the reload makes reg and slot the same value
$
delAssoc
(
SReg
reg
)
-- reg value changes on reload
$
assoc
in
cleanReload
assoc'
(
li
:
acc
)
instrs
--
on a jump,
remember the
reg/slot
association
.
-- remember the association
over a jump
|
targets
<-
jumpDests
instr
[]
,
not
$
null
targets
=
do
mapM_
(
accJumpValid
assoc
)
targets
...
...
@@ -152,7 +183,7 @@ cleanReload assoc acc (li@(Instr instr _) : instrs)
-- writing to a reg changes its value.
|
RU
_
written
<-
regUsage
instr
=
let
assoc'
=
foldr
del
eteA
Assoc
assoc
written
=
let
assoc'
=
foldr
delAssoc
assoc
(
map
SReg
$
nub
written
)
in
cleanReload
assoc'
(
li
:
acc
)
instrs
...
...
@@ -162,7 +193,7 @@ cleanReload assoc acc (li@(Instr instr _) : instrs)
-- then the slot was never read and we don't need the spill.
cleanSpill
::
UniqSet
Int
-- ^ slots that have been spilled, but not reload from
::
UniqSet
Int
-- ^ slots that have been spilled, but not reload
ed
from
->
[
LiveInstr
]
-- ^ acc
->
[
LiveInstr
]
-- ^ instrs to clean (in forwards order)
->
CleanM
[
LiveInstr
]
-- ^ cleaned instrs (in backwards order)
...
...
@@ -196,8 +227,7 @@ cleanSpill unused acc (li@(Instr instr _) : instrs)
-- collateJoinPoints:
--
-- | Look at information about what regs were valid across jumps and work out
-- whether it's safe to avoid reloads after join points.
-- | combine the associations from all the inward control flow edges.
--
collateJoinPoints
::
CleanM
()
collateJoinPoints
...
...
@@ -205,7 +235,7 @@ collateJoinPoints
{
sJumpValid
=
mapUFM
intersects
(
sJumpValidAcc
s
)
,
sJumpValidAcc
=
emptyUFM
}
intersects
::
[
Assoc
Reg
Slot
]
->
Assoc
Reg
Slot
intersects
::
[
Assoc
Store
]
->
Assoc
Store
intersects
[]
=
emptyAssoc
intersects
assocs
=
foldl1'
intersectAssoc
assocs
...
...
@@ -216,12 +246,12 @@ type CleanM = State CleanS
data
CleanS
=
CleanS
{
-- regs which are valid at the start of each block.
sJumpValid
::
UniqFM
(
Assoc
Reg
Slot
)
sJumpValid
::
UniqFM
(
Assoc
Store
)
-- collecting up what regs were valid across each jump.
-- in the next pass we can collate these and write the results
-- to sJumpValid.
,
sJumpValidAcc
::
UniqFM
[
Assoc
Reg
Slot
]
,
sJumpValidAcc
::
UniqFM
[
Assoc
Store
]
-- spills/reloads cleaned each pass (latest at front)
,
sCleanedCount
::
[(
Int
,
Int
)]
...
...
@@ -242,71 +272,127 @@ initCleanS
,
sCleanedReloadsAcc
=
0
}
-- | Remember th
at these regs were valid before a jump to this block
accJumpValid
::
Assoc
Reg
Slot
->
BlockId
->
CleanM
()
accJumpValid
reg
s
target
-- | Remember th
e associations before a jump
accJumpValid
::
Assoc
Store
->
BlockId
->
CleanM
()
accJumpValid
assoc
s
target
=
modify
$
\
s
->
s
{
sJumpValidAcc
=
addToUFM_C
(
++
)
(
sJumpValidAcc
s
)
target
[
regs
]
}
[
assocs
]
}
--------------
-- A store location can be a stack slot or a register
--
data
Store
=
SSlot
Int
|
SReg
Reg
-- spill cleaning is only done once all virtuals have been allocated to realRegs
--
instance
Uniquable
Store
where
getUnique
(
SReg
r
)
|
RealReg
i
<-
r
=
mkUnique
'R'
i
|
otherwise
=
error
"RegSpillClean.getUnique: found virtual reg during spill clean, only real regs expected."
getUnique
(
SSlot
i
)
=
mkUnique
'S'
i
instance
Outputable
Store
where
ppr
(
SSlot
i
)
=
text
"slot"
<>
int
i
ppr
(
SReg
r
)
=
ppr
r
--------------
-- A
n a
ssociation
table / many to many mapping
.
--
TODO: implement this bett
er t
han a simple association list.
--
two maps of sets, one for each direction would be better
-- Association
graphs
.
--
In the spill clean
er
,
t
wo store locations are associated if they are known
--
to hold the same value.
--
data
Assoc
a
b
=
Assoc
{
aList
::
[(
a
,
b
)]
}
type
Assoc
a
=
UniqFM
(
UniqSet
a
)
-- | an empty association
emptyAssoc
::
Assoc
a
b
emptyAssoc
=
Assoc
{
aList
=
[]
}
emptyAssoc
::
Assoc
a
emptyAssoc
=
emptyUFM
-- | add an association between these two things
addAssoc
::
Uniquable
a
=>
a
->
a
->
Assoc
a
->
Assoc
a
addAssoc
a
b
m
=
let
m1
=
addToUFM_C
unionUniqSets
m
a
(
unitUniqSet
b
)
m2
=
addToUFM_C
unionUniqSets
m1
b
(
unitUniqSet
a
)
in
m2
-- | add an association to the table.
addAssoc
::
(
Eq
a
,
Eq
b
)
=>
a
->
b
->
Assoc
a
b
->
Assoc
a
b
addAssoc
a
b
m
=
m
{
aList
=
(
a
,
b
)
:
aList
m
}
-- | delete all associations to a node
delAssoc
::
(
Outputable
a
,
Uniquable
a
)
=>
a
->
Assoc
a
->
Assoc
a
delAssoc
a
m
|
Just
aSet
<-
lookupUFM
m
a
,
m1
<-
delFromUFM
m
a
=
foldUniqSet
(
\
x
m
->
delAssoc1
x
a
m
)
m1
aSet
|
otherwise
=
m
-- | delete a single association edge (a -> b)
delAssoc1
::
Uniquable
a
=>
a
->
a
->
Assoc
a
->
Assoc
a
delAssoc1
a
b
m
|
Just
aSet
<-
lookupUFM
m
a
=
addToUFM
m
a
(
delOneFromUniqSet
aSet
b
)
|
otherwise
=
m
-- | check if these two things are associated
elemAssoc
::
(
Eq
a
,
Eq
b
)
=>
a
->
b
->
Assoc
a
b
->
Bool
elemAssoc
a
b
m
=
elem
(
a
,
b
)
$
aList
m
elemAssoc
::
(
Outputable
a
,
Uniquable
a
)
=>
a
->
a
->
Assoc
a
->
Bool
elemAssoc
a
b
m
=
elementOfUniqSet
b
(
closeAssoc
a
m
)
-- | find the refl. trans. closure of the association from this point
closeAssoc
::
(
Outputable
a
,
Uniquable
a
)
=>
a
->
Assoc
a
->
UniqSet
a
-- | delete all associations with this A element
deleteAAssoc
::
Eq
a
=>
a
->
Assoc
a
b
->
Assoc
a
b
closeAssoc
a
assoc
=
closeAssoc'
assoc
emptyUniqSet
(
unitUniqSet
a
)
where
closeAssoc'
assoc
visited
toVisit
=
case
uniqSetToList
toVisit
of
deleteAAssoc
x
m
=
m
{
aList
=
[
(
a
,
b
)
|
(
a
,
b
)
<-
aList
m
,
a
/=
x
]
}
-- nothing else to visit, we're done
[]
->
visited
(
x
:
_
)
-- | delete all associations with this B element
deleteBAssoc
::
Eq
b
=>
b
->
Assoc
a
b
->
Assoc
a
b
-- we've already seen this node
|
elementOfUniqSet
x
visited
->
closeAssoc'
assoc
visited
(
delOneFromUniqSet
toVisit
x
)
deleteBAssoc
x
m
=
m
{
aList
=
[
(
a
,
b
)
|
(
a
,
b
)
<-
aList
m
,
b
/=
x
]
}
-- haven't seen this node before,
-- remember to visit all its neighbors
|
otherwise
->
let
neighbors
=
case
lookupUFM
assoc
x
of
Nothing
->
emptyUniqSet
Just
set
->
set
in
closeAssoc'
assoc
(
addOneToUniqSet
visited
x
)
(
unionUniqSets
toVisit
neighbors
)
-- | intersect
two associations
-- | intersect
intersectAssoc
::
(
Eq
a
,
Eq
b
)
=>
Assoc
a
b
->
Assoc
a
b
->
Assoc
a
b
::
Uniquable
a
=>
Assoc
a
->
Assoc
a
->
Assoc
a
intersectAssoc
a1
a2
=
emptyAssoc
{
aList
=
intersect
(
aList
a1
)
(
aList
a2
)
}
intersectAssoc
a
b
=
intersectUFM_C
(
intersectUniqSets
)
a
b
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