Skip to content

GitLab

Commit 1353826e authored by Ben.Lippmeier@anu.edu.au's avatar Ben.Lippmeier@anu.edu.au
Browse files

NCG: Validate fixes

parent 67136d3a
Hide whitespace changes
Inline Side-by-side
compiler/nativeGen/PPC/RegInfo.hs
View file @ 1353826e
......@@ -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)))
......
compiler/nativeGen/Regs.hs
View file @ 1353826e
......@@ -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,
......
compiler/nativeGen/SPARC/RegInfo.hs
View file @ 1353826e
......@@ -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
......
compiler/nativeGen/SPARC/Regs.hs
View file @ 1353826e
......@@ -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
compiler/nativeGen/X86/Instr.hs
View file @ 1353826e
......@@ -41,7 +41,7 @@ data Cond
| OFLO
| PARITY
| NOTPARITY
deriving (Eq)
-- -----------------------------------------------------------------------------
......
compiler/nativeGen/X86/RegInfo.hs
View file @ 1353826e
......@@ -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"
......
compiler/nativeGen/X86/Regs.hs
View file @ 1353826e
......@@ -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
rts/Makefile
View file @ 1353826e
......@@ -35,8 +35,7 @@ endif
# -----------------------------------------------------------------------------
# RTS ways
WAYS=
# $(strip $(GhcLibWays) $(GhcRTSWays))
WAYS=$(strip $(GhcLibWays) $(GhcRTSWays))
ifneq "$(findstring debug, $(way))" ""
GhcRtsHcOpts=
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment