From 46af8a7cdec59be02d6f9ebea22e19e7d8639c47 Mon Sep 17 00:00:00 2001 From: sewardj Date: Tue, 22 Aug 2000 14:19:19 +0000 Subject: [PATCH] [project @ 2000-08-22 14:19:19 by sewardj] Fix sparc NCG to track recent NCG switch table reg-alloc bug fix. --- ghc/compiler/nativeGen/MachCode.lhs | 14 ++++--- ghc/compiler/nativeGen/MachMisc.lhs | 2 +- ghc/compiler/nativeGen/PprMach.lhs | 2 +- ghc/compiler/nativeGen/RegAllocInfo.lhs | 61 ++++++++++++++++--------------- ghc/compiler/nativeGen/Stix.lhs | 5 ++- 5 files changed, 46 insertions(+), 38 deletions(-) diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs index 0d7dcb8..4406d45 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 116b8f9..213da00 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 2480896..722128c 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 f0e7afe..2364f12 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 1223490..7dcca3e 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)) -- 1.7.10.4