Commit b11a5ef6 authored by Simon Marlow's avatar Simon Marlow

comments and refactoring

parent 4200c4a4
...@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment