[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

4 files changed, 22 insertions, 13 deletions

diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index e88fb83372..09fc504894 100644
--- 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 1d3c3acb05..e9cf788c58 100644
--- 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 3a38756806..fae5f6cbb6 100644
--- 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 b54113b876..56f43561cf 100644
--- 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)