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
86f1f4e0
Commit
86f1f4e0
authored
Sep 11, 2007
by
Ben.Lippmeier@anu.edu.au
Browse files
Try and rewrite reloads to reg-reg moves in the spill cleaner
parent
9173913b
Changes
2
Hide whitespace changes
Inline
Side-by-side
compiler/nativeGen/RegLiveness.hs
View file @
86f1f4e0
...
...
@@ -254,8 +254,6 @@ slurpConflicts live
-- If we can arrange that v1 and v2 are allocated to the same hreg it's more likely
-- the spill/reload instrs can be cleaned and replaced by a nop reg-reg move.
--
-- TODO: This only works intra-block at the momement. It's be nice to join up the mappings
-- across blocks also.
--
slurpReloadCoalesce
::
LiveCmmTop
->
Bag
(
Reg
,
Reg
)
slurpReloadCoalesce
live
...
...
@@ -265,32 +263,80 @@ slurpReloadCoalesce live
slurpCmm
cs
(
CmmProc
_
_
_
(
ListGraph
blocks
))
=
foldl'
slurpComp
cs
blocks
slurpComp
cs
(
BasicBlock
_
blocks
)
=
foldl'
slurpBlock
cs
blocks
slurpComp
cs
comp
=
let
(
moveBags
,
_
)
=
runState
(
slurpCompM
comp
)
emptyUFM
in
unionManyBags
(
cs
:
moveBags
)
slurpBlock
cs
(
BasicBlock
_
instrs
)
=
let
(
_
,
mMoves
)
=
mapAccumL
slurpLI
emptyUFM
instrs
in
unionBags
cs
(
listToBag
$
catMaybes
mMoves
)
slurpCompM
(
BasicBlock
_
blocks
)
=
do
-- run the analysis once to record the mapping across jumps.
mapM_
(
slurpBlock
False
)
blocks
-- run it a second time while using the information from the last pass.
-- We /could/ run this many more times to deal with graphical control
-- flow and propagating info across multiple jumps, but it's probably
-- not worth the trouble.
mapM
(
slurpBlock
True
)
blocks
slurpBlock
propagate
(
BasicBlock
blockId
instrs
)
=
do
-- grab the slot map for entry to this block
slotMap
<-
if
propagate
then
getSlotMap
blockId
else
return
emptyUFM
(
_
,
mMoves
)
<-
mapAccumLM
slurpLI
slotMap
instrs
return
$
listToBag
$
catMaybes
mMoves
slurpLI
::
UniqFM
Reg
-- current slotMap
->
LiveInstr
->
State
(
UniqFM
[
UniqFM
Reg
])
-- blockId -> [slot -> reg]
-- for tracking slotMaps across jumps
(
UniqFM
Reg
-- new slotMap
,
Maybe
(
Reg
,
Reg
))
-- maybe a new coalesce edge
slurpLI
::
UniqFM
Reg
->
LiveInstr
->
(
UniqFM
Reg
,
Maybe
(
Reg
,
Reg
))
slurpLI
slotMap
(
Instr
instr
_
)
-- remember what reg was stored into the slot
|
SPILL
reg
slot
<-
instr
,
slotMap'
<-
addToUFM
slotMap
slot
reg
=
(
slotMap'
,
Nothing
)
=
return
(
slotMap'
,
Nothing
)
-- add an edge betwen the this reg and the last one stored into the slot
|
RELOAD
slot
reg
<-
instr
=
case
lookupUFM
slotMap
slot
of
Just
reg2
|
reg
/=
reg2
->
(
slotMap
,
Just
(
reg
,
reg2
))
|
otherwise
->
(
slotMap
,
Nothing
)
|
reg
/=
reg2
->
return
(
slotMap
,
Just
(
reg
,
reg2
))
|
otherwise
->
return
(
slotMap
,
Nothing
)
Nothing
->
return
(
slotMap
,
Nothing
)
Nothing
->
(
slotMap
,
Nothing
)
-- if we hit a jump, remember the current slotMap
|
targets
<-
jumpDests
instr
[]
,
not
$
null
targets
=
do
mapM_
(
accSlotMap
slotMap
)
targets
return
(
slotMap
,
Nothing
)
|
otherwise
=
(
slotMap
,
Nothing
)
=
return
(
slotMap
,
Nothing
)
-- record a slotmap for an in edge to this block
accSlotMap
slotMap
blockId
=
modify
(
\
s
->
addToUFM_C
(
++
)
s
blockId
[
slotMap
])
-- work out the slot map on entry to this block
-- if we have slot maps for multiple in-edges then we need to merge them.
getSlotMap
blockId
=
do
map
<-
get
let
slotMaps
=
fromMaybe
[]
(
lookupUFM
map
blockId
)
return
$
foldr
mergeSlotMaps
emptyUFM
slotMaps
mergeSlotMaps
::
UniqFM
Reg
->
UniqFM
Reg
->
UniqFM
Reg
mergeSlotMaps
map1
map2
=
listToUFM
$
[
(
k
,
r1
)
|
(
k
,
r1
)
<-
ufmToList
map1
,
case
lookupUFM
map2
k
of
Nothing
->
False
Just
r2
->
r1
==
r2
]
-- | Strip away liveness information, yielding NatCmmTop
...
...
compiler/nativeGen/RegSpillClean.hs
View file @
86f1f4e0
...
...
@@ -101,7 +101,7 @@ cleanBlock (BasicBlock id instrs)
Just
assoc
->
assoc
Nothing
->
emptyAssoc
instrs_reload
<-
clean
Reload
assoc
[]
instrs
instrs_reload
<-
clean
Fwd
assoc
[]
instrs
instrs_spill
<-
cleanSpill
emptyUniqSet
[]
instrs_reload
return
$
BasicBlock
id
instrs_spill
...
...
@@ -111,36 +111,36 @@ cleanBlock (BasicBlock id instrs)
-- On a reload, if we know a reg already has the same value as a slot
-- then we don't need to do the reload.
--
clean
Reloa
d
clean
Fw
d
::
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)
clean
Reloa
d
_
acc
[]
clean
Fw
d
_
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
--
clean
Reloa
d
assoc
acc
(
Instr
i1
live1
:
Instr
i2
_
:
instrs
)
clean
Fw
d
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
}
clean
Reloa
d
assoc
acc
clean
Fw
d
assoc
acc
(
Instr
i1
live1
:
Instr
(
mkRegRegMoveInstr
reg1
reg2
)
Nothing
:
instrs
)
clean
Reloa
d
assoc
acc
(
li
@
(
Instr
i1
_
)
:
instrs
)
clean
Fw
d
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
clean
Reloa
d
assoc
acc
instrs
then
clean
Fw
d
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
...
...
@@ -148,43 +148,69 @@ cleanReload assoc acc (li@(Instr i1 _) : instrs)
$
delAssoc
(
SReg
r2
)
$
assoc
clean
Reloa
d
assoc'
(
li
:
acc
)
instrs
clean
Fw
d
assoc'
(
li
:
acc
)
instrs
clean
Reloa
d
assoc
acc
(
li
@
(
Instr
instr
_
)
:
instrs
)
clean
Fw
d
assoc
acc
(
li
@
(
Instr
instr
_
)
:
instrs
)
|
SPILL
reg
slot
<-
instr
=
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
clean
Reloa
d
assoc'
(
li
:
acc
)
instrs
in
clean
Fw
d
assoc'
(
li
:
acc
)
instrs
|
RELOAD
slot
reg
<-
instr
=
if
elemAssoc
(
SSlot
slot
)
(
SReg
reg
)
assoc
-- 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
(
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
-- clean a reload instr
|
RELOAD
{}
<-
instr
=
do
(
assoc'
,
mli
)
<-
cleanReload
assoc
li
case
mli
of
Nothing
->
cleanFwd
assoc'
acc
instrs
Just
li'
->
cleanFwd
assoc'
(
li'
:
acc
)
instrs
-- remember the association over a jump
|
targets
<-
jumpDests
instr
[]
,
not
$
null
targets
=
do
mapM_
(
accJumpValid
assoc
)
targets
clean
Reloa
d
assoc
(
li
:
acc
)
instrs
clean
Fw
d
assoc
(
li
:
acc
)
instrs
-- writing to a reg changes its value.
|
RU
_
written
<-
regUsage
instr
=
let
assoc'
=
foldr
delAssoc
assoc
(
map
SReg
$
nub
written
)
in
cleanReload
assoc'
(
li
:
acc
)
instrs
in
cleanFwd
assoc'
(
li
:
acc
)
instrs
-- | Try and rewrite a reload instruction to something more pleasing
--
cleanReload
::
Assoc
Store
->
LiveInstr
->
CleanM
(
Assoc
Store
,
Maybe
LiveInstr
)
cleanReload
assoc
li
@
(
Instr
(
RELOAD
slot
reg
)
_
)
-- if the reg we're reloading already has the same value as the slot
-- then we can erase the instruction outright
|
elemAssoc
(
SSlot
slot
)
(
SReg
reg
)
assoc
=
do
modify
$
\
s
->
s
{
sCleanedReloadsAcc
=
sCleanedReloadsAcc
s
+
1
}
return
(
assoc
,
Nothing
)
-- if we can find another reg with the same value as this slot then
-- do a move instead of a reload.
|
Just
reg2
<-
findRegOfSlot
assoc
slot
=
do
modify
$
\
s
->
s
{
sCleanedReloadsAcc
=
sCleanedReloadsAcc
s
+
1
}
let
assoc'
=
addAssoc
(
SReg
reg
)
(
SReg
reg2
)
$
delAssoc
(
SReg
reg
)
$
assoc
return
(
assoc'
,
Just
$
Instr
(
mkRegRegMoveInstr
reg2
reg
)
Nothing
)
-- gotta keep this instr
-- update the association
|
otherwise
=
do
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
return
(
assoc'
,
Just
li
)
cleanReload
_
_
=
panic
"RegSpillClean.cleanReload: unhandled instr"
-- | Clean out unneeded spill instructions.
...
...
@@ -240,6 +266,16 @@ intersects [] = emptyAssoc
intersects
assocs
=
foldl1'
intersectAssoc
assocs
-- | See if we have a reg with the same value as this slot in the association table.
findRegOfSlot
::
Assoc
Store
->
Int
->
Maybe
Reg
findRegOfSlot
assoc
slot
|
close
<-
closeAssoc
(
SSlot
slot
)
assoc
,
Just
(
SReg
reg
)
<-
find
isStoreReg
$
uniqSetToList
close
=
Just
reg
|
otherwise
=
Nothing
---------------
type
CleanM
=
State
CleanS
...
...
@@ -288,6 +324,13 @@ data Store
=
SSlot
Int
|
SReg
Reg
-- | Check if this is a reg store
isStoreReg
::
Store
->
Bool
isStoreReg
ss
=
case
ss
of
SSlot
_
->
False
SReg
_
->
True
-- spill cleaning is only done once all virtuals have been allocated to realRegs
--
instance
Uniquable
Store
where
...
...
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