[project @ 2003-05-27 21:14:21 by wolfgang]

Fix two bugs in the PowerPC NCG:
1. it generated a 'subfi' (subtract from with immediate) instruction,
which doesn't exist in the PowerPC architecture.
2. didn't correctly handle switch tables (test case cg048.hs).

MERGE TO STABLE

diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index e88fb83..09fc504 100644 (file)
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -51,6 +51,8 @@ import qualified Outputable
 import CmdLineOpts     ( opt_Static )
 import Stix            ( pprStixStmt )
 
+import Maybe           ( fromMaybe )
+
 -- DEBUGGING ONLY
 import Outputable      ( assertPanic )
 import FastString
@@ -1684,7 +1686,12 @@ getRegister (StMachOp mop [x, y]) -- dyadic PrimOps
       MO_Dbl_Le -> condFltReg LE x y
 
       MO_Nat_Add -> trivialCode ADD x y
-      MO_Nat_Sub -> trivialCode SUBF y x
+      MO_Nat_Sub -> fromMaybe (trivialCode2 SUBF y x) $
+        case y of    -- subfi ('substract from' with immediate) doesn't exist
+          StInt imm -> if fits16Bits imm && imm /= (-32768)
+            then Just $ trivialCode ADD x (StInt (-imm))
+            else Nothing
+          _ -> Nothing
 
       MO_NatS_Mul -> trivialCode MULLW x y
       MO_NatU_Mul -> trivialCode MULLW x y
@@ -2883,7 +2890,8 @@ genJump dsts tree
 
 #if powerpc_TARGET_ARCH
 genJump dsts (StCLbl lbl)
-    = returnNat (toOL [BCC ALWAYS lbl])
+  | hasDestInfo dsts = panic "genJump(powerpc): CLbl and dsts"
+  | otherwise        = returnNat (toOL [BCC ALWAYS lbl])
 
 genJump dsts tree
   = getRegister tree                       `thenNat` \ register ->
@@ -2892,7 +2900,7 @@ genJump dsts tree
        code   = registerCode register tmp
        target = registerName register tmp
     in
-    returnNat (code `snocOL` MTCTR target `snocOL` BCTR)
+    returnNat (code `snocOL` MTCTR target `snocOL` BCTR dsts)
 #endif {- sparc_TARGET_ARCH -}
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -4290,7 +4298,7 @@ remainderCode div x y
        code__2 dst = code1 `appOL` code2 `appOL` toOL [
                div dst src1 src2,
                MULLW dst dst (RIReg src2),
-               SUBF dst dst (RIReg src1)
+               SUBF dst dst src1
            ]
     in
     returnNat (Any IntRep code__2)

diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs
index 1d3c3ac..e9cf788 100644 (file)
--- a/ghc/compiler/nativeGen/MachMisc.lhs
+++ b/ghc/compiler/nativeGen/MachMisc.lhs
@@ -736,12 +736,12 @@ fPair other = pprPanic "fPair(sparc NCG)" (ppr other)
              
              | BCC     Cond CLabel
              | MTCTR   Reg
-             | BCTR
+             | BCTR    DestInfo
              | BL      Imm [Reg]       -- with list of argument regs
              | BCTRL   [Reg]
              
              | ADD     Reg Reg RI -- dst, src1, src2    
-             | SUBF    Reg Reg RI -- dst, src1, src2    
+             | SUBF    Reg Reg Reg -- dst, src1, src2 ; dst = src2 - src1  
              | MULLW   Reg Reg RI
              | DIVW    Reg Reg Reg
              | DIVWU   Reg Reg Reg

diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs
index 3a38756..fae5f6c 100644 (file)
--- a/ghc/compiler/nativeGen/PprMach.lhs
+++ b/ghc/compiler/nativeGen/PprMach.lhs
@@ -1950,7 +1950,7 @@ pprInstr (MTCTR reg) = hcat [
        char '\t',
        pprReg reg
     ]
-pprInstr (BCTR) = hcat [
+pprInstr (BCTR _) = hcat [
        char '\t',
        ptext SLIT("bctr")
     ]
@@ -1965,7 +1965,7 @@ pprInstr (BCTRL _) = hcat [
        ptext SLIT("bctrl")
     ]
 pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
-pprInstr (SUBF reg1 reg2 ri) = pprLogic SLIT("subf") reg1 reg2 ri
+pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
 pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)

diff --git a/ghc/compiler/nativeGen/RegAllocInfo.lhs b/ghc/compiler/nativeGen/RegAllocInfo.lhs
index b54113b..56f4356 100644 (file)
--- a/ghc/compiler/nativeGen/RegAllocInfo.lhs
+++ b/ghc/compiler/nativeGen/RegAllocInfo.lhs
@@ -400,11 +400,11 @@ regUsage instr = case instr of
     CMPL  sz reg ri    -> usage (reg : regRI ri,[])
     BCC          cond lbl      -> noUsage
     MTCTR reg          -> usage ([reg],[])
-    BCTR               -> noUsage
+    BCTR  dsts         -> noUsage
     BL    imm params   -> usage (params, callClobberedRegs)
     BCTRL params       -> usage (params, callClobberedRegs)
     ADD          reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
-    SUBF  reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
+    SUBF  reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
     MULLW reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
     DIVW  reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
     DIVWU reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
@@ -611,7 +611,8 @@ insnFuture insn
     BCC _ clbl             | isAsmTemp clbl -> NextOrBranch clbl
     BCC _ _ -> panic "insnFuture: conditional jump to non-local label"
     
-    BCTR -> NoFuture
+    BCTR (DestInfo dsts) -> MultiFuture dsts
+    BCTR NoDestInfo -> NoFuture
     boring     -> Next
 #endif {- powerpc_TARGET_ARCH -}
 \end{code}
@@ -833,11 +834,11 @@ patchRegs instr env = case instr of
     CMPL  sz reg ri    -> CMPL sz (env reg) (fixRI ri)
     BCC          cond lbl      -> BCC cond lbl
     MTCTR reg          -> MTCTR (env reg)
-    BCTR               -> BCTR
+    BCTR  dsts         -> BCTR dsts
     BL    imm argRegs  -> BL imm argRegs       -- argument regs
     BCTRL argRegs      -> BCTRL argRegs        -- cannot be remapped
     ADD          reg1 reg2 ri  -> ADD (env reg1) (env reg2) (fixRI ri)
-    SUBF  reg1 reg2 ri -> SUBF (env reg1) (env reg2) (fixRI ri)
+    SUBF  reg1 reg2 reg3-> SUBF (env reg1) (env reg2) (env reg3)
     MULLW reg1 reg2 ri -> MULLW (env reg1) (env reg2) (fixRI ri)
     DIVW  reg1 reg2 reg3-> DIVW (env reg1) (env reg2) (env reg3)
     DIVWU reg1 reg2 reg3-> DIVWU (env reg1) (env reg2) (env reg3)