From 1353826e5159c9a5a81e75e0b7459271f27c08ea Mon Sep 17 00:00:00 2001 From: "Ben.Lippmeier@anu.edu.au" Date: Thu, 5 Feb 2009 08:06:24 +0000 Subject: [PATCH] NCG: Validate fixes --- compiler/nativeGen/PPC/RegInfo.hs | 58 ++++++++++----------- compiler/nativeGen/Regs.hs | 1 - compiler/nativeGen/SPARC/RegInfo.hs | 6 ++- compiler/nativeGen/SPARC/Regs.hs | 21 +++++++- compiler/nativeGen/X86/Instr.hs | 2 +- compiler/nativeGen/X86/RegInfo.hs | 3 +- compiler/nativeGen/X86/Regs.hs | 96 +++++++++++++++++++---------------- rts/Makefile | 3 +- 8 files changed, 110 insertions(+), 80 deletions(-) diff --git a/compiler/nativeGen/PPC/RegInfo.hs b/compiler/nativeGen/PPC/RegInfo.hs index 5efda84..dd74722 100644 --- a/compiler/nativeGen/PPC/RegInfo.hs +++ b/compiler/nativeGen/PPC/RegInfo.hs @@ -16,7 +16,7 @@ module PPC.RegInfo ( patchJump, isRegRegMove, - JumpDest, + JumpDest(..), canShortcut, shortcutJump, @@ -36,8 +36,6 @@ where #include "HsVersions.h" import BlockId -import Cmm -import CLabel import RegsBase import PPC.Regs import PPC.Instr @@ -52,28 +50,28 @@ noUsage = RU [] [] regUsage :: Instr -> RegUsage regUsage instr = case instr of - SPILL reg slot -> usage ([reg], []) - RELOAD slot reg -> usage ([], [reg]) - - LD sz reg addr -> usage (regAddr addr, [reg]) - LA sz reg addr -> usage (regAddr addr, [reg]) - ST sz reg addr -> usage (reg : regAddr addr, []) - STU sz reg addr -> usage (reg : regAddr addr, []) - LIS reg imm -> usage ([], [reg]) - LI reg imm -> usage ([], [reg]) + SPILL reg _ -> usage ([reg], []) + RELOAD _ reg -> usage ([], [reg]) + + LD _ reg addr -> usage (regAddr addr, [reg]) + LA _ reg addr -> usage (regAddr addr, [reg]) + ST _ reg addr -> usage (reg : regAddr addr, []) + STU _ reg addr -> usage (reg : regAddr addr, []) + LIS reg _ -> usage ([], [reg]) + LI reg _ -> usage ([], [reg]) MR reg1 reg2 -> usage ([reg2], [reg1]) - CMP sz reg ri -> usage (reg : regRI ri,[]) - CMPL sz reg ri -> usage (reg : regRI ri,[]) - BCC cond lbl -> noUsage - BCCFAR cond lbl -> noUsage + CMP _ reg ri -> usage (reg : regRI ri,[]) + CMPL _ reg ri -> usage (reg : regRI ri,[]) + BCC _ _ -> noUsage + BCCFAR _ _ -> noUsage MTCTR reg -> usage ([reg],[]) - BCTR targets -> noUsage - BL imm params -> usage (params, callClobberedRegs) + BCTR _ -> noUsage + BL _ params -> usage (params, callClobberedRegs) BCTRL params -> usage (params, callClobberedRegs) ADD reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) ADDC reg1 reg2 reg3-> usage ([reg2,reg3], [reg1]) ADDE reg1 reg2 reg3-> usage ([reg2,reg3], [reg1]) - ADDIS reg1 reg2 imm -> usage ([reg2], [reg1]) + ADDIS reg1 reg2 _ -> usage ([reg2], [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]) @@ -83,19 +81,19 @@ regUsage instr = case instr of AND reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) OR reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) XOR reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) - XORIS reg1 reg2 imm -> usage ([reg2], [reg1]) - EXTS siz reg1 reg2 -> usage ([reg2], [reg1]) + XORIS reg1 reg2 _ -> usage ([reg2], [reg1]) + EXTS _ reg1 reg2 -> usage ([reg2], [reg1]) NEG reg1 reg2 -> usage ([reg2], [reg1]) NOT reg1 reg2 -> usage ([reg2], [reg1]) SLW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) SRW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) SRAW reg1 reg2 ri -> usage (reg2 : regRI ri, [reg1]) - RLWINM reg1 reg2 sh mb me + RLWINM reg1 reg2 _ _ _ -> usage ([reg2], [reg1]) - FADD sz r1 r2 r3 -> usage ([r2,r3], [r1]) - FSUB sz r1 r2 r3 -> usage ([r2,r3], [r1]) - FMUL sz r1 r2 r3 -> usage ([r2,r3], [r1]) - FDIV sz r1 r2 r3 -> usage ([r2,r3], [r1]) + FADD _ r1 r2 r3 -> usage ([r2,r3], [r1]) + FSUB _ r1 r2 r3 -> usage ([r2,r3], [r1]) + FMUL _ r1 r2 r3 -> usage ([r2,r3], [r1]) + FDIV _ r1 r2 r3 -> usage ([r2,r3], [r1]) FNEG r1 r2 -> usage ([r2], [r1]) FCMP r1 r2 -> usage ([r1,r2], []) FCTIWZ r1 r2 -> usage ([r2], [r1]) @@ -209,7 +207,7 @@ isJumpish instr BCC{} -> True BCCFAR{} -> True JMP{} -> True - + _ -> False -- | Change the destination of this jump instruction -- Used in joinToTargets in the linear allocator, when emitting fixup code @@ -223,7 +221,7 @@ patchJump insn old new BCCFAR cc id | id == old -> BCCFAR cc new - BCTR targets -> error "Cannot patch BCTR" + BCTR _ -> error "Cannot patch BCTR" _ -> insn @@ -239,7 +237,7 @@ canShortcut :: Instr -> Maybe JumpDest canShortcut _ = Nothing shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr -shortcutJump fn other = other +shortcutJump _ other = other @@ -258,6 +256,7 @@ mkSpillInstr reg delta slot let sz = case regClass reg of RcInteger -> II32 RcDouble -> FF64 + RcFloat -> panic "PPC.RegInfo.mkSpillInstr: no match" in ST sz reg (AddrRegImm sp (ImmInt (off-delta))) @@ -272,6 +271,7 @@ mkLoadInstr reg delta slot let sz = case regClass reg of RcInteger -> II32 RcDouble -> FF64 + RcFloat -> panic "PPC.RegInfo.mkSpillInstr: no match" in LD sz reg (AddrRegImm sp (ImmInt (off-delta))) diff --git a/compiler/nativeGen/Regs.hs b/compiler/nativeGen/Regs.hs index 76a9752..51eb0f0 100644 --- a/compiler/nativeGen/Regs.hs +++ b/compiler/nativeGen/Regs.hs @@ -67,7 +67,6 @@ module Regs ( eax, ebx, ecx, edx, esi, edi, ebp, esp, fake0, fake1, fake2, fake3, fake4, fake5, rax, rbx, rcx, rdx, rsi, rdi, rbp, rsp, - eax, ebx, ecx, edx, esi, edi, ebp, esp, r8, r9, r10, r11, r12, r13, r14, r15, xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7, xmm8, xmm9, xmm10, xmm11, xmm12, xmm13, xmm14, xmm15, diff --git a/compiler/nativeGen/SPARC/RegInfo.hs b/compiler/nativeGen/SPARC/RegInfo.hs index 3d9614d..b2ca93d 100644 --- a/compiler/nativeGen/SPARC/RegInfo.hs +++ b/compiler/nativeGen/SPARC/RegInfo.hs @@ -38,9 +38,11 @@ where #include "nativeGen/NCG.h" #include "HsVersions.h" +import SPARC.Instr +import SPARC.Regs +import RegsBase + import BlockId -import Instrs -import Regs import Outputable import Constants ( rESERVED_C_STACK_BYTES ) import FastBool diff --git a/compiler/nativeGen/SPARC/Regs.hs b/compiler/nativeGen/SPARC/Regs.hs index 6e88ea9..37dcfc2 100644 --- a/compiler/nativeGen/SPARC/Regs.hs +++ b/compiler/nativeGen/SPARC/Regs.hs @@ -324,12 +324,18 @@ o1 = RealReg (oReg 1) f0 = RealReg (fReg 0) +#if sparc_TARGET_ARCH nCG_FirstFloatReg :: RegNo nCG_FirstFloatReg = unRealReg NCG_FirstFloatReg +#else +nCG_FirstFloatReg :: RegNo +nCG_FirstFloatReg = unRealReg f22 +#endif -- horror show ----------------------------------------------------------------- #if sparc_TARGET_ARCH + #define g0 0 #define g1 1 #define g2 2 @@ -399,6 +405,10 @@ nCG_FirstFloatReg = unRealReg NCG_FirstFloatReg freeReg :: RegNo -> FastBool +globalRegMaybe :: GlobalReg -> Maybe Reg + +#if defined(sparc_TARGET_ARCH) + freeReg g0 = fastBool False -- %g0 is always 0. @@ -492,7 +502,6 @@ freeReg _ = fastBool True -- in a real machine register, otherwise returns @'Just' reg@, where -- reg is the machine register it is stored in. -globalRegMaybe :: GlobalReg -> Maybe Reg #ifdef REG_Base globalRegMaybe BaseReg = Just (RealReg REG_Base) @@ -570,3 +579,13 @@ globalRegMaybe CurrentTSO = Just (RealReg REG_CurrentTSO) globalRegMaybe CurrentNursery = Just (RealReg REG_CurrentNursery) #endif globalRegMaybe _ = Nothing + + +#else + +freeReg _ = 0# +globalRegMaybe = panic "SPARC.Regs.globalRegMaybe: not defined" + +#endif + + diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index 68462d0..23a6e06 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -41,7 +41,7 @@ data Cond | OFLO | PARITY | NOTPARITY - + deriving (Eq) -- ----------------------------------------------------------------------------- diff --git a/compiler/nativeGen/X86/RegInfo.hs b/compiler/nativeGen/X86/RegInfo.hs index e47cc63..d5a6eb5 100644 --- a/compiler/nativeGen/X86/RegInfo.hs +++ b/compiler/nativeGen/X86/RegInfo.hs @@ -9,7 +9,7 @@ module X86.RegInfo ( patchJump, isRegRegMove, - JumpDest, + JumpDest(..), canShortcut, shortcutJump, @@ -457,6 +457,7 @@ mkRegRegMoveInstr src dst RcInteger -> MOV wordSize (OpReg src) (OpReg dst) #if i386_TARGET_ARCH RcDouble -> GMOV src dst + RcFloat -> panic "X86.RegInfo.mkRegRegMoveInstr: no match" #else RcDouble -> MOV FF64 (OpReg src) (OpReg dst) RcFloat -> panic "X86.RegInfo.mkRegRegMoveInstr: no match" diff --git a/compiler/nativeGen/X86/Regs.hs b/compiler/nativeGen/X86/Regs.hs index 411801b..be83ad6 100644 --- a/compiler/nativeGen/X86/Regs.hs +++ b/compiler/nativeGen/X86/Regs.hs @@ -70,6 +70,7 @@ import Outputable ( Outputable(..), pprPanic, panic ) import qualified Outputable import Unique import FastBool +import Constants -- ----------------------------------------------------------------------------- -- Sizes on this architecture @@ -247,38 +248,6 @@ argRegs _ = panic "MachRegs.argRegs(x86): should not be used!" --- -allArgRegs :: [Reg] - -#if i386_TARGET_ARCH -allArgRegs = panic "X86.Regs.allArgRegs: should not be used!" - -#elif x86_64_TARGET_ARCH -allArgRegs = map RealReg [rdi,rsi,rdx,rcx,r8,r9] - -#else -allArgRegs = panic "X86.Regs.allArgRegs: not defined for this architecture" -#endif - - --- | these are the regs which we cannot assume stay alive over a C call. -callClobberedRegs :: [Reg] - -#if i386_TARGET_ARCH --- caller-saves registers -callClobberedRegs - = map RealReg [eax,ecx,edx,fake0,fake1,fake2,fake3,fake4,fake5] - -#elif x86_64_TARGET_ARCH --- all xmm regs are caller-saves --- caller-saves registers -callClobberedRegs - = map RealReg ([rax,rcx,rdx,rsi,rdi,r8,r9,r10,r11] ++ [16..31]) - -#else -callClobberedRegs - = panic "X86.Regs.callClobberedRegs: not defined for this architecture" -#endif -- | The complete set of machine registers. @@ -306,11 +275,10 @@ regClass :: Reg -> RegClass -- However, we can get away without this at the moment because the -- only allocatable integer regs are also 8-bit compatible (1, 3, 4). regClass (RealReg i) = if i < 8 then RcInteger else RcDouble -regClass (VirtualRegI u) = RcInteger -regClass (VirtualRegHi u) = RcInteger -regClass (VirtualRegD u) = RcDouble -regClass (VirtualRegF u) = pprPanic "regClass(x86):VirtualRegF" - (ppr (VirtualRegF u)) +regClass (VirtualRegI _) = RcInteger +regClass (VirtualRegHi _) = RcInteger +regClass (VirtualRegD _) = RcDouble +regClass (VirtualRegF u) = pprPanic ("regClass(x86):VirtualRegF") (ppr u) #elif x86_64_TARGET_ARCH -- On x86, we might want to have an 8-bit RegClass, which would @@ -318,11 +286,10 @@ regClass (VirtualRegF u) = pprPanic "regClass(x86):VirtualRegF" -- However, we can get away without this at the moment because the -- only allocatable integer regs are also 8-bit compatible (1, 3, 4). regClass (RealReg i) = if i < 16 then RcInteger else RcDouble -regClass (VirtualRegI u) = RcInteger -regClass (VirtualRegHi u) = RcInteger -regClass (VirtualRegD u) = RcDouble -regClass (VirtualRegF u) = pprPanic "regClass(x86_64):VirtualRegF" - (ppr (VirtualRegF u)) +regClass (VirtualRegI _) = RcInteger +regClass (VirtualRegHi _) = RcInteger +regClass (VirtualRegD _) = RcDouble +regClass (VirtualRegF u) = pprPanic "regClass(x86_64):VirtualRegF" (ppr u) #else regClass _ = panic "X86.Regs.regClass: not defined for this architecture" @@ -339,6 +306,7 @@ showReg n then regNames !! n else "%unknown_x86_real_reg_" ++ show n +regNames :: [String] regNames = ["%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "%ebp", "%esp", "%fake0", "%fake1", "%fake2", "%fake3", "%fake4", "%fake5", "%fake6"] @@ -349,6 +317,7 @@ showReg n | n >= 8 = "%r" ++ show n | otherwise = regNames !! n +regNames :: [String] regNames = ["%rax", "%rbx", "%rcx", "%rdx", "%rsi", "%rdi", "%rbp", "%rsp" ] @@ -597,7 +566,7 @@ freeReg REG_Hp = fastBool False #ifdef REG_HpLim freeReg REG_HpLim = fastBool False #endif -freeReg n = fastBool True +freeReg _ = fastBool True -- | Returns 'Nothing' if this global register is not stored @@ -681,9 +650,50 @@ globalRegMaybe CurrentNursery = Just (RealReg REG_CurrentNursery) #endif globalRegMaybe _ = Nothing +-- +allArgRegs :: [Reg] + +#if i386_TARGET_ARCH +allArgRegs = panic "X86.Regs.allArgRegs: should not be used!" + +#elif x86_64_TARGET_ARCH +allArgRegs = map RealReg [rdi,rsi,rdx,rcx,r8,r9] + +#else +allArgRegs = panic "X86.Regs.allArgRegs: not defined for this architecture" +#endif + + +-- | these are the regs which we cannot assume stay alive over a C call. +callClobberedRegs :: [Reg] + +#if i386_TARGET_ARCH +-- caller-saves registers +callClobberedRegs + = map RealReg [eax,ecx,edx,fake0,fake1,fake2,fake3,fake4,fake5] + +#elif x86_64_TARGET_ARCH +-- all xmm regs are caller-saves +-- caller-saves registers +callClobberedRegs + = map RealReg ([rax,rcx,rdx,rsi,rdi,r8,r9,r10,r11] ++ [16..31]) + +#else +callClobberedRegs + = panic "X86.Regs.callClobberedRegs: not defined for this architecture" +#endif + #else /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */ + + freeReg _ = 0# globalRegMaybe _ = panic "X86.Regs.globalRegMaybe: not defined" +allArgRegs = panic "X86.Regs.globalRegMaybe: not defined" +callClobberedRegs = panic "X86.Regs.globalRegMaybe: not defined" + + #endif + + diff --git a/rts/Makefile b/rts/Makefile index 719b11c..216d7de 100644 --- a/rts/Makefile +++ b/rts/Makefile @@ -35,8 +35,7 @@ endif # ----------------------------------------------------------------------------- # RTS ways -WAYS= -# $(strip $(GhcLibWays) $(GhcRTSWays)) +WAYS=$(strip $(GhcLibWays) $(GhcRTSWays)) ifneq "$(findstring debug, $(way))" "" GhcRtsHcOpts= -- 1.7.10.4