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

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

diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index 0d7dcb8..4406d45 100644 (file)
--- 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 116b8f9..213da00 100644 (file)
--- 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 2480896..722128c 100644 (file)
--- 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 f0e7afe..2364f12 100644 (file)
--- 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 1223490..7dcca3e 100644 (file)
--- 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))