Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
GHC
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
4,268
Issues
4,268
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
407
Merge Requests
407
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
b11a5ef6
Commit
b11a5ef6
authored
Aug 02, 2012
by
Simon Marlow
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
comments and refactoring
parent
4200c4a4
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
50 additions
and
31 deletions
+50
-31
compiler/cmm/CmmSink.hs
compiler/cmm/CmmSink.hs
+50
-31
No files found.
compiler/cmm/CmmSink.hs
View file @
b11a5ef6
...
@@ -17,15 +17,17 @@ import Data.List (partition)
...
@@ -17,15 +17,17 @@ import Data.List (partition)
import
qualified
Data.Set
as
Set
import
qualified
Data.Set
as
Set
-- -----------------------------------------------------------------------------
-- -----------------------------------------------------------------------------
-- Sinking
-- Sinking
and inlining
-- This is an optimisation pass that
-- This is an optimisation pass that
-- (a) moves assignments closer to their uses, to reduce register pressure
-- (a) moves assignments closer to their uses, to reduce register pressure
-- (b) pushes assignments into a single branch of a conditional if possible
-- (b) pushes assignments into a single branch of a conditional if possible
-- (c) inlines assignments to registers that are mentioned only once
-- It is particularly helpful in the Cmm generated by the Stg->Cmm
-- (d) discards dead assignments
-- code generator, in which every function starts with a copyIn
--
-- sequence like:
-- This tightens up lots of register-heavy code. It is particularly
-- helpful in the Cmm generated by the Stg->Cmm code generator, in
-- which every function starts with a copyIn sequence like:
--
--
-- x1 = R1
-- x1 = R1
-- x2 = Sp[8]
-- x2 = Sp[8]
...
@@ -37,19 +39,29 @@ import qualified Data.Set as Set
...
@@ -37,19 +39,29 @@ import qualified Data.Set as Set
-- Algorithm:
-- Algorithm:
--
--
-- * Start by doing liveness analysis.
-- * Start by doing liveness analysis.
-- * Keep a list of assignments; earlier ones may refer to later ones
--
-- * Walk forwards through the graph;
-- * Keep a list of assignments A; earlier ones may refer to later ones
-- * At an assignment:
--
-- * pick up the assignment and add it to the list
-- * Walk forwards through the graph, look at each node N:
-- * At a store:
-- * If any assignments in A (1) occur only once in N, and (2) are
-- * drop any assignments that the store refers to
-- not live after N, inline the assignment and remove it
-- * drop any assignments that refer to memory that may be written
-- from A.
-- by the store
-- * If N is an assignment:
-- * If the register is not live after N, discard it
-- * otherwise pick up the assignment and add it to A
-- * If N is a non-assignment node:
-- * remove any assignments from A that conflict with N, and
-- place them before N in the current block. (we call this
-- "dropping" the assignments).
-- * An assignment conflicts with N if it:
-- - assigns to a register mentioned in N
-- - mentions a register assigned by N
-- - reads from memory written by N
-- * do this recursively, dropping dependent assignments
-- * do this recursively, dropping dependent assignments
-- * At a multi-way branch:
-- * At a multi-way branch:
-- * drop any assignments that are live on more than one branch
-- * drop any assignments that are live on more than one branch
-- * if any successor has more than one predecessor
, drop everything
-- * if any successor has more than one predecessor
(a
-- live in that successor
--
join-point), drop everything
live in that successor
--
--
-- As a side-effect we'll delete some dead assignments (transitively,
-- As a side-effect we'll delete some dead assignments (transitively,
-- even). This isn't as good as removeDeadAssignments, but it's much
-- even). This isn't as good as removeDeadAssignments, but it's much
...
@@ -62,6 +74,8 @@ import qualified Data.Set as Set
...
@@ -62,6 +74,8 @@ import qualified Data.Set as Set
-- to re-do it.
-- to re-do it.
type
Assignment
=
(
LocalReg
,
CmmExpr
,
AbsMem
)
type
Assignment
=
(
LocalReg
,
CmmExpr
,
AbsMem
)
-- Assignment caches AbsMem, an abstraction of the memory read by
-- the RHS of the assignment.
cmmSink
::
CmmGraph
->
CmmGraph
cmmSink
::
CmmGraph
->
CmmGraph
cmmSink
graph
=
ofBlockList
(
g_entry
graph
)
$
sink
mapEmpty
$
blocks
cmmSink
graph
=
ofBlockList
(
g_entry
graph
)
$
sink
mapEmpty
$
blocks
...
@@ -198,24 +212,10 @@ walk nodes assigs = go nodes emptyBlock assigs
...
@@ -198,24 +212,10 @@ walk nodes assigs = go nodes emptyBlock assigs
where
where
go
[]
block
as
=
(
block
,
as
)
go
[]
block
as
=
(
block
,
as
)
go
((
live
,
node
)
:
ns
)
block
as
go
((
live
,
node
)
:
ns
)
block
as
|
discard
=
go
ns
block
as
|
shouldDiscard
node
live
=
go
ns
block
as
|
Just
a
<-
shouldSink
node1
=
go
ns
block
(
a
:
as1
)
|
Just
a
<-
shouldSink
node1
=
go
ns
block
(
a
:
as1
)
|
otherwise
=
go
ns
block'
as'
|
otherwise
=
go
ns
block'
as'
where
where
-- discard dead assignments. This doesn't do as good a job as
-- removeDeadAsssignments, because it would need multiple passes
-- to get all the dead code, but it catches the common case of
-- superfluous reloads from the stack that the stack allocator
-- leaves behind.
--
-- Also we catch "r = r" here. You might think it would fall
-- out of inlining, but the inliner will see that r is live
-- after the instruction and choose not to inline r in the rhs.
discard
=
case
node
of
CmmAssign
r
(
CmmReg
r'
)
|
r
==
r'
->
True
CmmAssign
(
CmmLocal
r
)
_
->
not
(
r
`
Set
.
member
`
live
)
_otherwise
->
False
(
node1
,
as1
)
=
tryToInline
live
node
as
(
node1
,
as1
)
=
tryToInline
live
node
as
(
dropped
,
as'
)
=
dropAssignmentsSimple
(`
conflicts
`
node1
)
as1
(
dropped
,
as'
)
=
dropAssignmentsSimple
(`
conflicts
`
node1
)
as1
...
@@ -232,6 +232,25 @@ shouldSink (CmmAssign (CmmLocal r) e) | no_local_regs = Just (r, e, exprMem e)
...
@@ -232,6 +232,25 @@ shouldSink (CmmAssign (CmmLocal r) e) | no_local_regs = Just (r, e, exprMem e)
where
no_local_regs
=
True
-- foldRegsUsed (\_ _ -> False) True e
where
no_local_regs
=
True
-- foldRegsUsed (\_ _ -> False) True e
shouldSink
_other
=
Nothing
shouldSink
_other
=
Nothing
--
-- discard dead assignments. This doesn't do as good a job as
-- removeDeadAsssignments, because it would need multiple passes
-- to get all the dead code, but it catches the common case of
-- superfluous reloads from the stack that the stack allocator
-- leaves behind.
--
-- Also we catch "r = r" here. You might think it would fall
-- out of inlining, but the inliner will see that r is live
-- after the instruction and choose not to inline r in the rhs.
--
shouldDiscard
::
CmmNode
e
x
->
RegSet
->
Bool
shouldDiscard
node
live
=
case
node
of
CmmAssign
r
(
CmmReg
r'
)
|
r
==
r'
->
True
CmmAssign
(
CmmLocal
r
)
_
->
not
(
r
`
Set
.
member
`
live
)
_otherwise
->
False
toNode
::
Assignment
->
CmmNode
O
O
toNode
::
Assignment
->
CmmNode
O
O
toNode
(
r
,
rhs
,
_
)
=
CmmAssign
(
CmmLocal
r
)
rhs
toNode
(
r
,
rhs
,
_
)
=
CmmAssign
(
CmmLocal
r
)
rhs
...
@@ -280,7 +299,7 @@ tryToInline live node assigs = go usages node assigs
...
@@ -280,7 +299,7 @@ tryToInline live node assigs = go usages node assigs
go
usages
node
(
a
@
(
l
,
rhs
,
_
)
:
rest
)
go
usages
node
(
a
@
(
l
,
rhs
,
_
)
:
rest
)
|
occurs_once_in_this_node
=
inline_and_discard
|
occurs_once_in_this_node
=
inline_and_discard
|
False
{- isTiny rhs -}
=
inline_and_keep
|
False
{- isTiny rhs -}
=
inline_and_keep
-- ^^ seems to make things slightly worse
--
^^ seems to make things slightly worse
where
where
inline_and_discard
=
go
usages'
node'
rest
inline_and_discard
=
go
usages'
node'
rest
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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