FW: [commit: ghc] master: Implement forward substitution of constants in the Cmm mini-inliner (ea44ead)

[Simon Peyton-Jones]

Edward, Simon

Does this patch affect the new codegen path that Edward has been working on?

If not, do we need something similar in the new path?

If the new path already has something similar (which I'm guessing it might), do we have a regression test that will show up whether or not it's working?

Simon


-----Original Message-----
From: cvs-ghc-bounces at haskell.org [mailto:cvs-ghc-bounces at haskell.org] On Behalf Of Simon Marlow
Sent: 01 June 2011 10:57
To: cvs-ghc at haskell.org
Subject: [commit: ghc] master: Implement forward substitution of constants in the Cmm mini-inliner (ea44ead)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/ea44eadfb9d269d06b889fbfe41286bf0c7a730d

>---------------------------------------------------------------

commit ea44eadfb9d269d06b889fbfe41286bf0c7a730d
Author: Johan Tibell <johan.tibell at gmail.com>
Date:   Fri May 6 14:13:03 2011 +0200

    Implement forward substitution of constants in the Cmm mini-inliner
    
    Currently the mini-inliner would only forward substitute assignments
    to registers that were used exactly once, to not risk duplicating
    computation.  For constants there's no such risk so we always
    substitute.  Prior to the change the Cmm
    
        fn
        {
            bits64 a, b;
    
            a = 1;
            b = a + a;
            RET_N(b);
        }
    
    would be optimized as
    
        fn()    { []
                }
            ca: _cb::I64 = 1;
                R1 = _cb::I64 + _cb::I64;
                jump (I64[Sp + 0]) ();
        }
    
    but after it would be optimized as
    
        fn()    { []
                }
            ca: R1 = 2;
                jump (I64[Sp + 0]) ();
        }
    
    Note that this pass does not deal with the now dead assignment.

>---------------------------------------------------------------

 compiler/cmm/CmmOpt.hs |   52 ++++++++++++++++++++++++++++++++++++++++++++---
 1 files changed, 48 insertions(+), 4 deletions(-)

diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index a2eecd5..1355cd2 100644
--- a/compiler/cmm/CmmOpt.hs
+++ b/compiler/cmm/CmmOpt.hs
@@ -99,11 +99,13 @@ cmmEliminateDeadBlocks blocks@(BasicBlock base_id _:_) =
 -- The mini-inliner
 
 {-
-This pass inlines assignments to temporaries that are used just
-once.  It works as follows:
+This pass inlines assignments to temporaries.  Temporaries that are
+only used once are unconditionally inlined.  Temporaries that are used
+two or more times are only inlined if they are assigned a literal.  It
+works as follows:
 
   - count uses of each temporary
-  - for each temporary that occurs just once:
+  - for each temporary:
 	- attempt to push it forward to the statement that uses it
         - only push forward past assignments to other temporaries
 	  (assumes that temporaries are single-assignment)
@@ -158,7 +160,24 @@ cmmMiniInline blocks = map do_inline blocks
 
 cmmMiniInlineStmts :: UniqFM Int -> [CmmStmt] -> [CmmStmt]
 cmmMiniInlineStmts uses [] = []
-cmmMiniInlineStmts uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr) : stmts)
+cmmMiniInlineStmts uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr@(CmmLit _)) : stmts)
+        -- not used: just discard this assignment
+  | Nothing <- lookupUFM uses u
+  = cmmMiniInlineStmts uses stmts
+
+        -- used: try to inline at all the use sites
+  | Just n <- lookupUFM uses u
+  =
+#ifdef NCG_DEBUG
+     trace ("nativeGen: inlining " ++ showSDoc (pprStmt stmt)) $
+#endif
+     case lookForInlineLit u expr stmts of
+         (m, stmts')
+             | n == m -> cmmMiniInlineStmts (delFromUFM uses u) stmts'
+             | otherwise ->
+                 stmt : cmmMiniInlineStmts (adjustUFM (\x -> x - m) uses u) stmts'
+
+cmmMiniInlineStmts uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr : stmts))
         -- not used at all: just discard this assignment
   | Nothing <- lookupUFM uses u
   = cmmMiniInlineStmts uses stmts
@@ -175,6 +194,31 @@ cmmMiniInlineStmts uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr) : stmts
 cmmMiniInlineStmts uses (stmt:stmts)
   = stmt : cmmMiniInlineStmts uses stmts
 
+-- | Takes a register, a 'CmmLit' expression assigned to that
+-- register, and a list of statements.  Inlines the expression at all
+-- use sites of the register.  Returns the number of substituations
+-- made and the, possibly modified, list of statements.
+lookForInlineLit :: Unique -> CmmExpr -> [CmmStmt] -> (Int, [CmmStmt])
+lookForInlineLit _ _ [] = (0, [])
+lookForInlineLit u expr stmts@(stmt : rest)
+  | Just n <- lookupUFM (countUses stmt) u
+  = case lookForInlineLit u expr rest of
+      (m, stmts) -> let z = n + m
+                    in z `seq` (z, inlineStmt u expr stmt : stmts)
+
+  | ok_to_skip
+  = case lookForInlineLit u expr rest of
+      (n, stmts) -> (n, stmt : stmts)
+
+  | otherwise
+  = (0, stmts)
+  where
+    -- We skip over assignments to registers, unless the register
+    -- being assigned to is the one we're inlining.
+    ok_to_skip = case stmt of
+        CmmAssign (CmmLocal r@(LocalReg u' _)) _ | u' == u -> False
+        _other -> True
+
 lookForInline u expr stmts = lookForInline' u expr regset stmts
     where regset = foldRegsUsed extendRegSet emptyRegSet expr
 



_______________________________________________
Cvs-ghc mailing list
Cvs-ghc at haskell.org
http://www.haskell.org/mailman/listinfo/cvs-ghc