[project @ 2000-08-22 14:19:19 by sewardj]

Fix sparc NCG to track recent NCG switch table reg-alloc bug fix.

5 files changed, 46 insertions, 38 deletions

diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index 0d7dcb8c7d..4406d45f45 100644
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -26,7 +26,8 @@ import PrimRep		( isFloatingRep, PrimRep(..) )
 import PrimOp		( PrimOp(..) )
 import CallConv		( cCallConv )
 import Stix		( getNatLabelNCG, StixTree(..),
-			  StixReg(..), CodeSegment(..), DestInfo,
+			  StixReg(..), CodeSegment(..), 
+                          DestInfo, hasDestInfo,
                           pprStixTree, ppStixReg,
                           NatM, thenNat, returnNat, mapNat, 
                           mapAndUnzipNat, mapAccumLNat,
@@ -2037,20 +2038,21 @@ genJump dsts tree
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
 
-genJump (StCLbl lbl)
-  | isAsmTemp lbl = returnNat (toOL [BI ALWAYS False target, NOP])
-  | otherwise     = returnNat (toOL [CALL target 0 True, NOP])
+genJump dsts (StCLbl lbl)
+  | hasDestInfo dsts = panic "genJump(sparc): CLbl and dsts"
+  | isAsmTemp lbl    = returnNat (toOL [BI ALWAYS False target, NOP])
+  | otherwise        = returnNat (toOL [CALL target 0 True, NOP])
   where
     target = ImmCLbl lbl
 
-genJump tree
+genJump dsts tree
   = getRegister tree	    	    	    `thenNat` \ register ->
     getNewRegNCG PtrRep    	    `thenNat` \ tmp ->
     let
     	code   = registerCode register tmp
     	target = registerName register tmp
     in
-    returnNat (code `snocOL` JMP (AddrRegReg target g0) `snocOL` NOP)
+    returnNat (code `snocOL` JMP dsts (AddrRegReg target g0) `snocOL` NOP)
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs
index 116b8f94f0..213da0048d 100644
--- a/ghc/compiler/nativeGen/MachMisc.lhs
+++ b/ghc/compiler/nativeGen/MachMisc.lhs
@@ -633,7 +633,7 @@ is_G_instr instr
 	      | BI	      Cond Bool Imm -- cond, annul?, target
     	      | BF  	      Cond Bool Imm -- cond, annul?, target
 
-	      | JMP	      MachRegsAddr      -- target
+	      | JMP	      DestInfo MachRegsAddr      -- target
 	      | CALL	      Imm Int Bool -- target, args, terminal
 
 data RI = RIReg Reg
diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs
index 24808961ee..722128cab2 100644
--- a/ghc/compiler/nativeGen/PprMach.lhs
+++ b/ghc/compiler/nativeGen/PprMach.lhs
@@ -1539,7 +1539,7 @@ pprInstr (BF cond b lab)
 	pprImm lab
     ]
 
-pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
+pprInstr (JMP dsts addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
 
 pprInstr (CALL imm n _)
   = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
diff --git a/ghc/compiler/nativeGen/RegAllocInfo.lhs b/ghc/compiler/nativeGen/RegAllocInfo.lhs
index f0e7afe407..2364f123f4 100644
--- a/ghc/compiler/nativeGen/RegAllocInfo.lhs
+++ b/ghc/compiler/nativeGen/RegAllocInfo.lhs
@@ -367,7 +367,7 @@ regUsage instr = case instr of
     FxTOy s1 s2 r1 r2 	-> usage ([r1], [r2])
 
     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
-    JMP   addr 	    	-> usage (regAddr addr, [])
+    JMP   dst addr 	-> usage (regAddr addr, [])
 
     CALL  _ n True   	-> noUsage
     CALL  _ n False  	-> usage (argRegs n, callClobberedRegs)
@@ -541,9 +541,12 @@ insnFuture insn
     BF other  _ (ImmCLbl clbl) -> NextOrBranch clbl
     BF other  _ _ -> panic "nativeGen(sparc):insnFuture(BF)"
 
-    -- JMP and CALL(terminal) must be out-of-line.
-    JMP _         -> NoFuture
-    CALL _ _ True -> NoFuture
+    -- CALL(terminal) must be out-of-line.  JMP is not out-of-line
+    -- iff it specifies its destinations.
+    JMP NoDestInfo _      -> NoFuture  -- n.b. NoFuture == MultiFuture []
+    JMP (DestInfo dsts) _ -> MultiFuture dsts
+
+    CALL _ _ True         -> NoFuture
 
     boring -> Next
 
@@ -710,31 +713,31 @@ patchRegs instr env = case instr of
 #if sparc_TARGET_ARCH
 
 patchRegs instr env = case instr of
-    LD sz addr reg -> LD sz (fixAddr addr) (env reg)
-    ST sz reg addr -> ST sz (env reg) (fixAddr addr)
-    ADD x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
-    SUB x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
-    AND b r1 ar r2 -> AND b (env r1) (fixRI ar) (env r2)
-    ANDN b r1 ar r2 -> ANDN b (env r1) (fixRI ar) (env r2)
-    OR b r1 ar r2 -> OR b (env r1) (fixRI ar) (env r2)
-    ORN b r1 ar r2 -> ORN b (env r1) (fixRI ar) (env r2)
-    XOR b r1 ar r2 -> XOR b (env r1) (fixRI ar) (env r2)
-    XNOR b r1 ar r2 -> XNOR b (env r1) (fixRI ar) (env r2)
-    SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
-    SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
-    SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
-    SETHI imm reg -> SETHI imm (env reg)
-    FABS s r1 r2 -> FABS s (env r1) (env r2)
-    FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
-    FCMP e s r1 r2 -> FCMP e s (env r1) (env r2)
-    FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
-    FMOV s r1 r2 -> FMOV s (env r1) (env r2)
-    FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
-    FNEG s r1 r2 -> FNEG s (env r1) (env r2)
-    FSQRT s r1 r2 -> FSQRT s (env r1) (env r2)
-    FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
-    FxTOy s1 s2 r1 r2 -> FxTOy s1 s2 (env r1) (env r2)
-    JMP addr -> JMP (fixAddr addr)
+    LD    sz addr reg   -> LD sz (fixAddr addr) (env reg)
+    ST    sz reg addr   -> ST sz (env reg) (fixAddr addr)
+    ADD   x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
+    SUB   x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
+    AND   b r1 ar r2    -> AND b (env r1) (fixRI ar) (env r2)
+    ANDN  b r1 ar r2    -> ANDN b (env r1) (fixRI ar) (env r2)
+    OR    b r1 ar r2    -> OR b (env r1) (fixRI ar) (env r2)
+    ORN   b r1 ar r2    -> ORN b (env r1) (fixRI ar) (env r2)
+    XOR   b r1 ar r2    -> XOR b (env r1) (fixRI ar) (env r2)
+    XNOR  b r1 ar r2    -> XNOR b (env r1) (fixRI ar) (env r2)
+    SLL   r1 ar r2      -> SLL (env r1) (fixRI ar) (env r2)
+    SRL   r1 ar r2      -> SRL (env r1) (fixRI ar) (env r2)
+    SRA   r1 ar r2      -> SRA (env r1) (fixRI ar) (env r2)
+    SETHI imm reg       -> SETHI imm (env reg)
+    FABS  s r1 r2       -> FABS s (env r1) (env r2)
+    FADD  s r1 r2 r3    -> FADD s (env r1) (env r2) (env r3)
+    FCMP  e s r1 r2     -> FCMP e s (env r1) (env r2)
+    FDIV  s r1 r2 r3    -> FDIV s (env r1) (env r2) (env r3)
+    FMOV  s r1 r2       -> FMOV s (env r1) (env r2)
+    FMUL  s r1 r2 r3    -> FMUL s (env r1) (env r2) (env r3)
+    FNEG  s r1 r2       -> FNEG s (env r1) (env r2)
+    FSQRT s r1 r2       -> FSQRT s (env r1) (env r2)
+    FSUB  s r1 r2 r3    -> FSUB s (env r1) (env r2) (env r3)
+    FxTOy s1 s2 r1 r2   -> FxTOy s1 s2 (env r1) (env r2)
+    JMP   dsts addr     -> JMP dsts (fixAddr addr)
     _ -> instr
   where
     fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
diff --git a/ghc/compiler/nativeGen/Stix.lhs b/ghc/compiler/nativeGen/Stix.lhs
index 1223490855..7dcca3ef8b 100644
--- a/ghc/compiler/nativeGen/Stix.lhs
+++ b/ghc/compiler/nativeGen/Stix.lhs
@@ -7,7 +7,7 @@ module Stix (
 	CodeSegment(..), StixReg(..), StixTree(..), StixTreeList,
 	pprStixTrees, pprStixTree, ppStixReg,
         stixCountTempUses, stixSubst,
-	DestInfo(..),
+	DestInfo(..), hasDestInfo,
 
 	stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, 
         stgHp, stgHpLim, stgTagReg, stgR9, stgR10, 
@@ -131,6 +131,9 @@ data DestInfo
    = NoDestInfo             -- no supplied dests; infer from context
    | DestInfo [CLabel]      -- precisely these dests and no others
 
+hasDestInfo NoDestInfo   = False
+hasDestInfo (DestInfo _) = True
+
 pprDests :: DestInfo -> SDoc
 pprDests NoDestInfo      = text "NoDestInfo"
 pprDests (DestInfo dsts) = brack (hsep (map pprCLabel dsts))