diff --git a/compiler/cmm/CmmSink.hs b/compiler/cmm/CmmSink.hs index a8ee8a54e1b0391d1eefff81f98c648e94ed6241..2a9ecd36f7bcfe0a332ae1b6be2135549117a912 100644 --- a/compiler/cmm/CmmSink.hs +++ b/compiler/cmm/CmmSink.hs @@ -17,15 +17,17 @@ import Data.List (partition) import qualified Data.Set as Set -- ----------------------------------------------------------------------------- --- Sinking +-- Sinking and inlining -- This is an optimisation pass that -- (a) moves assignments closer to their uses, to reduce register pressure -- (b) pushes assignments into a single branch of a conditional if possible - --- It is particularly helpful in the Cmm generated by the Stg->Cmm --- code generator, in which every function starts with a copyIn --- sequence like: +-- (c) inlines assignments to registers that are mentioned only once +-- (d) discards dead assignments +-- +-- 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 -- x2 = Sp[8] @@ -37,19 +39,29 @@ import qualified Data.Set as Set -- Algorithm: -- -- * Start by doing liveness analysis. --- * Keep a list of assignments; earlier ones may refer to later ones --- * Walk forwards through the graph; --- * At an assignment: --- * pick up the assignment and add it to the list --- * At a store: --- * drop any assignments that the store refers to --- * drop any assignments that refer to memory that may be written --- by the store +-- +-- * Keep a list of assignments A; earlier ones may refer to later ones +-- +-- * Walk forwards through the graph, look at each node N: +-- * If any assignments in A (1) occur only once in N, and (2) are +-- not live after N, inline the assignment and remove it +-- from A. +-- * 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 -- * At a multi-way branch: -- * drop any assignments that are live on more than one branch --- * if any successor has more than one predecessor, drop everything --- live in that successor +-- * if any successor has more than one predecessor (a +-- join-point), drop everything live in that successor -- -- As a side-effect we'll delete some dead assignments (transitively, -- even). This isn't as good as removeDeadAssignments, but it's much @@ -62,6 +74,8 @@ import qualified Data.Set as Set -- to re-do it. type Assignment = (LocalReg, CmmExpr, AbsMem) + -- Assignment caches AbsMem, an abstraction of the memory read by + -- the RHS of the assignment. cmmSink :: CmmGraph -> CmmGraph cmmSink graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks @@ -198,24 +212,10 @@ walk nodes assigs = go nodes emptyBlock assigs where go [] block as = (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) | otherwise = go ns block' as' 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 (dropped, as') = dropAssignmentsSimple (`conflicts` node1) as1 @@ -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 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 (r,rhs,_) = CmmAssign (CmmLocal r) rhs @@ -280,7 +299,7 @@ tryToInline live node assigs = go usages node assigs go usages node (a@(l,rhs,_) : rest) | occurs_once_in_this_node = inline_and_discard | False {- isTiny rhs -} = inline_and_keep - -- ^^ seems to make things slightly worse + -- ^^ seems to make things slightly worse where inline_and_discard = go usages' node' rest