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
23ac7e91
Commit
23ac7e91
authored
Jan 20, 2012
by
Simon Marlow
Browse files
implement RegSet by Set, not UniqSet
parent
6c969e22
Changes
4
Hide whitespace changes
Inline
Side-by-side
compiler/cmm/CmmExpr.hs
View file @
23ac7e91
...
...
@@ -16,7 +16,8 @@ module CmmExpr
,
DefinerOfLocalRegs
,
UserOfLocalRegs
,
foldRegsDefd
,
foldRegsUsed
,
filterRegsUsed
,
DefinerOfSlots
,
UserOfSlots
,
foldSlotsDefd
,
foldSlotsUsed
,
RegSet
,
emptyRegSet
,
elemRegSet
,
extendRegSet
,
deleteFromRegSet
,
mkRegSet
,
plusRegSet
,
minusRegSet
,
timesRegSet
,
plusRegSet
,
minusRegSet
,
timesRegSet
,
sizeRegSet
,
nullRegSet
,
regSetToList
,
regUsedIn
,
regSlot
,
Area
(
..
),
AreaId
(
..
),
SubArea
,
SubAreaSet
,
AreaMap
,
isStackSlotOf
,
module
CmmMachOp
...
...
@@ -31,9 +32,10 @@ import CmmMachOp
import
BlockId
import
CLabel
import
Unique
import
UniqSet
import
Data.Map
(
Map
)
import
Data.Set
(
Set
)
import
qualified
Data.Set
as
Set
-----------------------------------------------------------------------------
-- CmmExpr
...
...
@@ -194,22 +196,35 @@ localRegType (LocalReg _ rep) = rep
-----------------------------------------------------------------------------
-- | Sets of local registers
type
RegSet
=
UniqSet
LocalReg
-- These are used for dataflow facts, and a common operation is taking
-- the union of two RegSets and then asking whether the union is the
-- same as one of the inputs. UniqSet isn't good here, because
-- sizeUniqSet is O(n) whereas Set.size is O(1), so we use ordinary
-- Sets.
type
RegSet
=
Set
LocalReg
emptyRegSet
::
RegSet
nullRegSet
::
RegSet
->
Bool
elemRegSet
::
LocalReg
->
RegSet
->
Bool
extendRegSet
::
RegSet
->
LocalReg
->
RegSet
deleteFromRegSet
::
RegSet
->
LocalReg
->
RegSet
mkRegSet
::
[
LocalReg
]
->
RegSet
minusRegSet
,
plusRegSet
,
timesRegSet
::
RegSet
->
RegSet
->
RegSet
emptyRegSet
=
emptyUniqSet
elemRegSet
=
elementOfUniqSet
extendRegSet
=
addOneToUniqSet
deleteFromRegSet
=
delOneFromUniqSet
mkRegSet
=
mkUniqSet
minusRegSet
=
minusUniqSet
plusRegSet
=
unionUniqSets
timesRegSet
=
intersectUniqSets
sizeRegSet
::
RegSet
->
Int
regSetToList
::
RegSet
->
[
LocalReg
]
emptyRegSet
=
Set
.
empty
nullRegSet
=
Set
.
null
elemRegSet
=
Set
.
member
extendRegSet
=
flip
Set
.
insert
deleteFromRegSet
=
flip
Set
.
delete
mkRegSet
=
Set
.
fromList
minusRegSet
=
Set
.
difference
plusRegSet
=
Set
.
union
timesRegSet
=
Set
.
intersection
sizeRegSet
=
Set
.
size
regSetToList
=
Set
.
toList
class
UserOfLocalRegs
a
where
foldRegsUsed
::
(
b
->
LocalReg
->
b
)
->
b
->
a
->
b
...
...
@@ -237,7 +252,7 @@ instance DefinerOfLocalRegs LocalReg where
foldRegsDefd
f
z
r
=
f
z
r
instance
UserOfLocalRegs
RegSet
where
foldRegsUsed
f
=
fold
UniqSet
(
flip
f
)
foldRegsUsed
f
=
Set
.
fold
(
flip
f
)
instance
UserOfLocalRegs
CmmExpr
where
foldRegsUsed
f
z
e
=
expr
z
e
...
...
compiler/cmm/CmmLive.hs
View file @
23ac7e91
...
...
@@ -33,8 +33,10 @@ type CmmLive = RegSet
-- | The dataflow lattice
liveLattice
::
DataflowLattice
CmmLive
liveLattice
=
DataflowLattice
"live LocalReg's"
emptyRegSet
add
where
add
_
(
OldFact
old
)
(
NewFact
new
)
=
case
unionUniqSets
old
new
of
join
->
(
changeIf
$
sizeUniqSet
join
>
sizeUniqSet
old
,
join
)
where
add
_
(
OldFact
old
)
(
NewFact
new
)
=
(
changeIf
$
sizeRegSet
join
>
sizeRegSet
old
,
join
)
where
!
join
=
plusRegSet
old
new
-- | A mapping from block labels to the variables live on entry
type
BlockEntryLiveness
=
BlockEnv
CmmLive
...
...
@@ -52,7 +54,7 @@ cmmLiveness graph =
-- | On entry to the procedure, there had better not be any LocalReg's live-in.
noLiveOnEntry
::
BlockId
->
CmmLive
->
a
->
a
noLiveOnEntry
bid
in_fact
x
=
if
isEmptyUniq
Set
in_fact
then
x
if
nullReg
Set
in_fact
then
x
else
pprPanic
"LocalReg's live-in to graph"
(
ppr
bid
<+>
ppr
in_fact
)
-- | The transfer equations use the traditional 'gen' and 'kill'
...
...
@@ -60,7 +62,7 @@ noLiveOnEntry bid in_fact x =
gen
::
UserOfLocalRegs
a
=>
a
->
RegSet
->
RegSet
gen
a
live
=
foldRegsUsed
extendRegSet
live
a
kill
::
DefinerOfLocalRegs
a
=>
a
->
RegSet
->
RegSet
kill
a
live
=
foldRegsDefd
del
On
eFrom
Uniq
Set
live
a
kill
a
live
=
foldRegsDefd
del
et
eFrom
Reg
Set
live
a
gen_kill
::
(
DefinerOfLocalRegs
a
,
UserOfLocalRegs
a
)
=>
a
->
CmmLive
->
CmmLive
gen_kill
a
=
gen
a
.
kill
a
...
...
compiler/cmm/CmmProcPoint.hs
View file @
23ac7e91
...
...
@@ -318,7 +318,7 @@ pass_live_vars_as_args _liveness procPoints protos = protos'
Nothing
->
let
live
=
emptyRegSet
--lookupBlockEnv _liveness id `orElse`
--panic ("no liveness at block " ++ show id)
formals
=
uniq
SetToList
live
formals
=
reg
SetToList
live
prot
=
Protocol
Private
formals
$
CallArea
$
Young
id
in
mapInsert
id
prot
protos
...
...
compiler/cmm/CmmSpillReload.hs
View file @
23ac7e91
...
...
@@ -65,8 +65,8 @@ dualLiveLattice = DataflowLattice "variables live in registers and on stack" emp
add
_
(
OldFact
old
)
(
NewFact
new
)
=
(
changeIf
$
change1
||
change2
,
DualLive
stack
regs
)
where
(
change1
,
stack
)
=
add1
(
on_stack
old
)
(
on_stack
new
)
(
change2
,
regs
)
=
add1
(
in_regs
old
)
(
in_regs
new
)
add1
old
new
=
if
size
Uniq
Set
join
>
size
Uniq
Set
old
then
(
True
,
join
)
else
(
False
,
old
)
where
join
=
unionUniq
Set
s
old
new
add1
old
new
=
if
size
Reg
Set
join
>
size
Reg
Set
old
then
(
True
,
join
)
else
(
False
,
old
)
where
join
=
plusReg
Set
old
new
dualLivenessWithInsertion
::
BlockSet
->
CmmGraph
->
FuelUniqSM
CmmGraph
dualLivenessWithInsertion
procPoints
g
=
...
...
@@ -120,16 +120,16 @@ dualLiveTransfers entry procPoints = mkBTransfer3 first middle last
keep_stack_only
k
=
DualLive
(
on_stack
(
lkp
k
))
emptyRegSet
insertSpillsAndReloads
::
CmmGraph
->
BlockSet
->
CmmBwdRewrite
DualLive
insertSpillsAndReloads
graph
procPoints
=
deepBwdRw
3
first
middle
nothing
insertSpillsAndReloads
graph
procPoints
=
mkBRewrite
3
first
middle
nothing
-- Beware: deepBwdRw with one polymorphic function seems more reasonable here,
-- but GHC miscompiles it, see bug #4044.
where
first
::
CmmNode
C
O
->
Fact
O
DualLive
->
CmmReplGraph
C
O
first
e
@
(
CmmEntry
id
)
live
=
return
$
first
e
@
(
CmmEntry
id
)
live
=
if
id
/=
(
g_entry
graph
)
&&
setMember
id
procPoints
then
case
map
reload
(
uniq
SetToList
(
in_regs
live
))
of
[]
->
Nothing
is
->
Just
$
mkFirst
e
<*>
mkMiddles
is
else
Nothing
case
map
reload
(
reg
SetToList
(
in_regs
live
))
of
[]
->
return
Nothing
is
->
return
$
Just
$
mkFirst
e
<*>
mkMiddles
is
else
return
Nothing
-- EZY: There was some dead code for handling the case where
-- we were not splitting procedures. Check Git history if
-- you're interested (circa e26ea0f41).
...
...
@@ -152,15 +152,15 @@ reload r = CmmAssign (CmmLocal r) (CmmLoad (regSlot r) $ localRegType r)
-- prettyprinting
ppr_regs
::
String
->
RegSet
->
SDoc
ppr_regs
s
regs
=
text
s
<+>
commafy
(
map
ppr
$
uniq
SetToList
regs
)
ppr_regs
s
regs
=
text
s
<+>
commafy
(
map
ppr
$
reg
SetToList
regs
)
where
commafy
xs
=
hsep
$
punctuate
comma
xs
instance
Outputable
DualLive
where
ppr
(
DualLive
{
in_regs
=
regs
,
on_stack
=
stack
})
=
if
isEmptyUniq
Set
regs
&&
isEmptyUniq
Set
stack
then
if
nullReg
Set
regs
&&
nullReg
Set
stack
then
text
"<nothing-live>"
else
nest
2
$
fsep
[
if
isEmptyUniq
Set
regs
then
PP
.
empty
nest
2
$
fsep
[
if
nullReg
Set
regs
then
PP
.
empty
else
(
ppr_regs
"live in regs ="
regs
),
if
isEmptyUniq
Set
stack
then
PP
.
empty
if
nullReg
Set
stack
then
PP
.
empty
else
(
ppr_regs
"live on stack ="
stack
)]
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