add -fsimpleopt-before-flatten

[ghc-hetmet.git] / compiler / cmm / CmmOpt.hs

diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index fa25e24..c71f188 100644 (file)
--- a/compiler/cmm/CmmOpt.hs
+++ b/compiler/cmm/CmmOpt.hs
@@ -21,8 +21,7 @@ module CmmOpt (
 
 #include "HsVersions.h"
 
-import Cmm
-import CmmExpr
+import OldCmm
 import CmmUtils
 import CLabel
 import StaticFlags
@@ -116,12 +115,15 @@ cmmMiniInlineStmts uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr) : stmts
 cmmMiniInlineStmts uses (stmt:stmts)
   = stmt : cmmMiniInlineStmts uses stmts
 
-lookForInline u expr (stmt : rest)
+lookForInline u expr stmts = lookForInline' u expr regset stmts
+    where regset = foldRegsUsed extendRegSet emptyRegSet expr
+
+lookForInline' u expr regset (stmt : rest)
   | Just 1 <- lookupUFM (countUses stmt) u, ok_to_inline
   = Just (inlineStmt u expr stmt : rest)
 
   | ok_to_skip
-  = case lookForInline u expr rest of
+  = case lookForInline' u expr regset rest of
            Nothing    -> Nothing
            Just stmts -> Just (stmt:stmts)
 
@@ -138,12 +140,18 @@ lookForInline u expr (stmt : rest)
                     CmmCall{} -> hasNoGlobalRegs expr
                     _ -> True
 
-   -- We can skip over assignments to other tempoararies, because we
-   -- know that expressions aren't side-effecting and temporaries are
-   -- single-assignment.
+   -- Expressions aren't side-effecting.  Temporaries may or may not
+   -- be single-assignment depending on the source (the old code
+   -- generator creates single-assignment code, but hand-written Cmm
+   -- and Cmm from the new code generator is not single-assignment.)
+   -- So we do an extra check to make sure that the register being
+   -- changed is not one we were relying on.  I don't know how much of a
+   -- performance hit this is (we have to create a regset for every
+   -- instruction.) -- EZY
     ok_to_skip = case stmt of
                  CmmNop -> True
-                 CmmAssign (CmmLocal (LocalReg u' _)) rhs | u' /= u -> True
+                 CmmComment{} -> True
+                 CmmAssign (CmmLocal r@(LocalReg u' _)) rhs | u' /= u && not (r `elemRegSet` regset) -> True
                  CmmAssign g@(CmmGlobal _) rhs -> not (g `regUsedIn` expr)
                  _other -> False
 
@@ -307,9 +315,18 @@ cmmMachOpFold op [x@(CmmLit _), y]
 -- PicBaseReg from the corresponding label (or label difference).
 --
 cmmMachOpFold mop1 [CmmMachOp mop2 [arg1,arg2], arg3]
-   | mop1 == mop2 && isAssociativeMachOp mop1
+   | mop2 `associates_with` mop1
      && not (isLit arg1) && not (isPicReg arg1)
-   = cmmMachOpFold mop1 [arg1, cmmMachOpFold mop2 [arg2,arg3]]
+   = cmmMachOpFold mop2 [arg1, cmmMachOpFold mop1 [arg2,arg3]]
+   where
+     MO_Add{} `associates_with` MO_Sub{} = True
+     mop1 `associates_with` mop2 =
+        mop1 == mop2 && isAssociativeMachOp mop1
+
+-- special case: (a - b) + c  ==>  a + (c - b)
+cmmMachOpFold mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], arg3]
+   | not (isLit arg1) && not (isPicReg arg1)
+   = cmmMachOpFold mop1 [arg1, cmmMachOpFold mop2 [arg3,arg2]]
 
 -- Make a RegOff if we can
 cmmMachOpFold (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)]
@@ -432,10 +449,10 @@ cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt n _))]
   = case mop of
        MO_Mul rep
           | Just p <- exactLog2 n ->
-                 CmmMachOp (MO_Shl rep) [x, CmmLit (CmmInt p rep)]
+                 cmmMachOpFold (MO_Shl rep) [x, CmmLit (CmmInt p rep)]
        MO_U_Quot rep
           | Just p <- exactLog2 n ->
-                 CmmMachOp (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]
+                 cmmMachOpFold (MO_U_Shr rep) [x, CmmLit (CmmInt p rep)]
        MO_S_Quot rep
           | Just p <- exactLog2 n, 
             CmmReg _ <- x ->   -- We duplicate x below, hence require
@@ -463,7 +480,7 @@ cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt n _))]
                         CmmMachOp (MO_And rep) [x1, CmmLit (CmmInt (n-1) rep)]
                    x3 = CmmMachOp (MO_Add rep) [x, x2]
                in
-                CmmMachOp (MO_S_Shr rep) [x3, CmmLit (CmmInt p rep)]
+                cmmMachOpFold (MO_S_Shr rep) [x3, CmmLit (CmmInt p rep)]
        other
            -> unchanged
     where
@@ -532,12 +549,12 @@ exactLog2 x_
 -}
 
 cmmLoopifyForC :: RawCmmTop -> RawCmmTop
-cmmLoopifyForC p@(CmmProc info entry_lbl []
+cmmLoopifyForC p@(CmmProc info entry_lbl
                  (ListGraph blocks@(BasicBlock top_id _ : _)))
   | null info = p  -- only if there's an info table, ignore case alts
   | otherwise =  
 --  pprTrace "jump_lbl" (ppr jump_lbl <+> ppr entry_lbl) $
-  CmmProc info entry_lbl [] (ListGraph blocks')
+  CmmProc info entry_lbl (ListGraph blocks')
   where blocks' = [ BasicBlock id (map do_stmt stmts)
                  | BasicBlock id stmts <- blocks ]