From: simonmar <unknown>
Date: Mon, 23 Aug 2004 10:11:24 +0000 (+0000)
Subject: [project @ 2004-08-23 10:11:23 by simonmar]
X-Git-Tag: Initial_conversion_from_CVS_complete~1694
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=12cad97e06919e86e5b94559de8ca9900084b5ab;p=ghc-hetmet.git

[project @ 2004-08-23 10:11:23 by simonmar]
Fix an infinite loop in the cmm-optimiser in the native codegen, and
refactor: move isAssociativeMachOp into MachOp.
---

diff --git a/ghc/compiler/cmm/MachOp.hs b/ghc/compiler/cmm/MachOp.hs
index 55aaa3e..2d933e0 100644
--- a/ghc/compiler/cmm/MachOp.hs
+++ b/ghc/compiler/cmm/MachOp.hs
@@ -18,6 +18,7 @@ module MachOp 	(
 	MachOp(..), 
 	pprMachOp,
 	isCommutableMachOp,
+	isAssociativeMachOp,
 	isComparisonMachOp,
 	resultRepOfMachOp,
 	machOpArgReps,
@@ -492,6 +493,27 @@ isCommutableMachOp mop =
 	_other			-> False
 
 -- ----------------------------------------------------------------------------
+-- isAssociativeMachOp
+
+{- |
+Returns 'True' if the MachOp is associative (i.e. @(x+y)+z == x+(y+z)@)
+This is used in the platform-independent Cmm optimisations.
+
+If in doubt, return 'False'.  This generates worse code on the
+native routes, but is otherwise harmless.
+-}
+isAssociativeMachOp :: MachOp -> Bool
+isAssociativeMachOp mop = 
+  case mop of
+	MO_Add r 	-> not (isFloatingRep r)
+	MO_Sub r 	-> not (isFloatingRep r)
+	MO_Mul r	-> not (isFloatingRep r)
+	MO_And _	-> True
+	MO_Or _		-> True
+	MO_Xor _	-> True
+	_other		-> False
+
+-- ----------------------------------------------------------------------------
 -- isComparisonMachOp
 
 {- | 
diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs
index b2fcb6c..8f97d55 100644
--- a/ghc/compiler/nativeGen/AsmCodeGen.lhs
+++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs
@@ -375,7 +375,8 @@ cmmToCmm (CmmProc info lbl params blocks) =
   CmmProc info lbl params (map cmmBlockConFold (cmmPeep blocks))
 
 cmmBlockConFold :: CmmBasicBlock -> CmmBasicBlock
-cmmBlockConFold (BasicBlock id stmts) = BasicBlock id (map cmmStmtConFold stmts)
+cmmBlockConFold (BasicBlock id stmts) = 
+  BasicBlock id (map cmmStmtConFold stmts)
 
 cmmStmtConFold stmt
    = case stmt of
@@ -553,9 +554,6 @@ cmmMachOpFold mop args@[CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
 cmmMachOpFold op [x@(CmmLit _), y]
    | not (isLit y) && isCommutableMachOp op 
    = cmmMachOpFold op [y, x]
-   where 
-    isLit (CmmLit _) = True
-    isLit _          = False
 
 -- Turn (a+b)+c into a+(b+c) where possible.  Because literals are
 -- moved to the right, it is more likely that we will find
@@ -564,16 +562,15 @@ cmmMachOpFold op [x@(CmmLit _), y]
 --
 -- ToDo: this appears to introduce a quadratic behaviour due to the
 -- nested cmmMachOpFold.  Can we fix this?
+--
+-- Why do we check isLit arg1?  If arg1 is a lit, it means that arg2
+-- is also a lit (otherwise arg1 would be on the right).  If we
+-- put arg1 on the left of the rearranged expression, we'll get into a
+-- loop:  (x1+x2)+x3 => x1+(x2+x3)  => (x2+x3)+x1 => x2+(x3+x1) ...
+--
 cmmMachOpFold mop1 [CmmMachOp mop2 [arg1,arg2], arg3]
-   | mop1 == mop2 && isAssociative mop1
+   | mop1 == mop2 && isAssociativeMachOp mop1 && not (isLit arg1)
    = cmmMachOpFold mop1 [arg1, cmmMachOpFold mop2 [arg2,arg3]]
-   where
-	isAssociative (MO_Add _) = True
-	isAssociative (MO_Mul _) = True
-	isAssociative (MO_And _) = True
-	isAssociative (MO_Or  _) = True
-	isAssociative (MO_Xor _) = True
-	isAssociative _          = False
 
 -- Make a RegOff if we can
 cmmMachOpFold (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)]
@@ -813,6 +810,9 @@ inlineExpr u a other_expr = other_expr
 
 bind f x = x $! f
 
+isLit (CmmLit _) = True
+isLit _          = False
+
 isComparisonExpr :: CmmExpr -> Bool
 isComparisonExpr (CmmMachOp op _) = isComparisonMachOp op
 isComparisonExpr _other 	    = False