X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmOpt.hs;h=df0555fe58f027e963e283196e31c64d5830ddf6;hb=c9629e9f5e4957c8665fc2497b5e769b769cb7d3;hp=1125ac14a9ea56ec58cd490b7baef10d9850e95c;hpb=591e1dc91ab7bb1f91b516d1b1ea59c3a8809955;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index 1125ac1..df0555f 100644
--- 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
@@ -153,7 +152,7 @@ inlineStmt u a (CmmAssign r e) = CmmAssign r (inlineExpr u a e)
 inlineStmt u a (CmmStore e1 e2) = CmmStore (inlineExpr u a e1) (inlineExpr u a e2)
 inlineStmt u a (CmmCall target regs es srt ret)
    = CmmCall (infn target) regs es' srt ret
-   where infn (CmmCallee fn cconv) = CmmCallee fn cconv
+   where infn (CmmCallee fn cconv) = CmmCallee (inlineExpr u a fn) cconv
 	 infn (CmmPrim p) = CmmPrim p
 	 es' = [ (CmmHinted (inlineExpr u a e) hint) | (CmmHinted e hint) <- es ]
 inlineStmt u a (CmmCondBranch e d) = CmmCondBranch (inlineExpr u a e) d
@@ -307,9 +306,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,16 +440,16 @@ 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
 				-- it is a reg.  FIXME: remove this restriction.
 		-- shift right is not the same as quot, because it rounds
-		-- to minus infinity, whereasq uot rounds toward zero.
+		-- to minus infinity, whereasq quot rounds toward zero.
 		-- To fix this up, we add one less than the divisor to the
 		-- dividend if it is a negative number.
 		--
@@ -463,7 +471,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 +540,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 ]