[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 (file)
--- 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 (file)
--- 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