comments and refactoring

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