From 67136d3a04b96b043328df9d4716d3da7a24a517 Mon Sep 17 00:00:00 2001 From: "Ben.Lippmeier@anu.edu.au" Date: Wed, 4 Feb 2009 05:51:26 +0000 Subject: [PATCH] NCG: Split RegAllocInfo into arch specific modules --- compiler/ghc.cabal.in | 6 +- compiler/nativeGen/Alpha/RegInfo.hs | 218 +++++++ compiler/nativeGen/PPC/Instr.hs | 3 +- compiler/nativeGen/PPC/RegInfo.hs | 310 +++++++++ compiler/nativeGen/RegAlloc/Linear/Main.hs | 2 +- compiler/nativeGen/RegAllocInfo.hs | 935 +--------------------------- compiler/nativeGen/Regs.hs | 12 +- compiler/nativeGen/SPARC/Instr.hs | 7 +- compiler/nativeGen/SPARC/RegInfo.hs | 339 ++++++++++ compiler/nativeGen/X86/Instr.hs | 3 +- compiler/nativeGen/X86/RegInfo.hs | 489 +++++++++++++++ compiler/nativeGen/X86/Regs.hs | 37 +- 12 files changed, 1408 insertions(+), 953 deletions(-) create mode 100644 compiler/nativeGen/Alpha/RegInfo.hs create mode 100644 compiler/nativeGen/PPC/RegInfo.hs create mode 100644 compiler/nativeGen/SPARC/RegInfo.hs create mode 100644 compiler/nativeGen/X86/RegInfo.hs diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index a6a34a5..041fae3 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -458,18 +458,22 @@ Library Regs RegsBase Instrs + RegAllocInfo Alpha.Regs + Alpha.RegInfo Alpha.Instr X86.Regs + X86.RegInfo X86.Instr PPC.Regs + PPC.RegInfo PPC.Instr SPARC.Regs + SPARC.RegInfo SPARC.Instr NCGMonad PositionIndependentCode PprMach - RegAllocInfo RegAlloc.Liveness RegAlloc.Graph.Main RegAlloc.Graph.Stats diff --git a/compiler/nativeGen/Alpha/RegInfo.hs b/compiler/nativeGen/Alpha/RegInfo.hs new file mode 100644 index 0000000..7fdde4d --- /dev/null +++ b/compiler/nativeGen/Alpha/RegInfo.hs @@ -0,0 +1,218 @@ + +----------------------------------------------------------------------------- +-- +-- (c) The University of Glasgow 1996-2004 +-- +----------------------------------------------------------------------------- + +module Alpha.RegInfo ( +{- + RegUsage(..), + noUsage, + regUsage, + patchRegs, + jumpDests, + isJumpish, + patchJump, + isRegRegMove, + + JumpDest, canShortcut, shortcutJump, shortcutStatic, + + maxSpillSlots, + mkSpillInstr, + mkLoadInstr, + mkRegRegMoveInstr, + mkBranchInstr +-} +) + +where + +{- +#include "nativeGen/NCG.h" +#include "HsVersions.h" + + +import BlockId +import Cmm +import CLabel +import Instrs +import Regs +import Outputable +import Constants ( rESERVED_C_STACK_BYTES ) +import FastBool + +data RegUsage = RU [Reg] [Reg] + +noUsage :: RegUsage +noUsage = RU [] [] + +regUsage :: Instr -> RegUsage + +regUsage instr = case instr of + SPILL reg slot -> usage ([reg], []) + RELOAD slot reg -> usage ([], [reg]) + LD B reg addr -> usage (regAddr addr, [reg, t9]) + LD Bu reg addr -> usage (regAddr addr, [reg, t9]) +-- LD W reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED +-- LD Wu reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED + LD sz reg addr -> usage (regAddr addr, [reg]) + LDA reg addr -> usage (regAddr addr, [reg]) + LDAH reg addr -> usage (regAddr addr, [reg]) + LDGP reg addr -> usage (regAddr addr, [reg]) + LDI sz reg imm -> usage ([], [reg]) + ST B reg addr -> usage (reg : regAddr addr, [t9, t10]) +-- ST W reg addr -> usage (reg : regAddr addr, [t9, t10]) : UNUSED + ST sz reg addr -> usage (reg : regAddr addr, []) + CLR reg -> usage ([], [reg]) + ABS sz ri reg -> usage (regRI ri, [reg]) + NEG sz ov ri reg -> usage (regRI ri, [reg]) + ADD sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2]) + SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2]) + SUB sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2]) + SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2]) + MUL sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2]) + DIV sz un r1 ar r2 -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12]) + REM sz un r1 ar r2 -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12]) + NOT ri reg -> usage (regRI ri, [reg]) + AND r1 ar r2 -> usage (r1 : regRI ar, [r2]) + ANDNOT r1 ar r2 -> usage (r1 : regRI ar, [r2]) + OR r1 ar r2 -> usage (r1 : regRI ar, [r2]) + ORNOT r1 ar r2 -> usage (r1 : regRI ar, [r2]) + XOR r1 ar r2 -> usage (r1 : regRI ar, [r2]) + XORNOT r1 ar r2 -> usage (r1 : regRI ar, [r2]) + SLL r1 ar r2 -> usage (r1 : regRI ar, [r2]) + SRL r1 ar r2 -> usage (r1 : regRI ar, [r2]) + SRA r1 ar r2 -> usage (r1 : regRI ar, [r2]) + ZAP r1 ar r2 -> usage (r1 : regRI ar, [r2]) + ZAPNOT r1 ar r2 -> usage (r1 : regRI ar, [r2]) + CMP co r1 ar r2 -> usage (r1 : regRI ar, [r2]) + FCLR reg -> usage ([], [reg]) + FABS r1 r2 -> usage ([r1], [r2]) + FNEG sz r1 r2 -> usage ([r1], [r2]) + FADD sz r1 r2 r3 -> usage ([r1, r2], [r3]) + FDIV sz r1 r2 r3 -> usage ([r1, r2], [r3]) + FMUL sz r1 r2 r3 -> usage ([r1, r2], [r3]) + FSUB sz r1 r2 r3 -> usage ([r1, r2], [r3]) + CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2]) + FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3]) + FMOV r1 r2 -> usage ([r1], [r2]) + + + -- We assume that all local jumps will be BI/BF/BR. JMP must be out-of-line. + BI cond reg lbl -> usage ([reg], []) + BF cond reg lbl -> usage ([reg], []) + JMP reg addr hint -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet + + BSR _ n -> RU (argRegSet n) callClobberedRegSet + JSR reg addr n -> RU (argRegSet n) callClobberedRegSet + + _ -> noUsage + + where + usage (src, dst) = RU (mkRegSet (filter interesting src)) + (mkRegSet (filter interesting dst)) + + interesting (FixedReg _) = False + interesting _ = True + + regAddr (AddrReg r1) = [r1] + regAddr (AddrRegImm r1 _) = [r1] + regAddr (AddrImm _) = [] + + regRI (RIReg r) = [r] + regRI _ = [] + + +patchRegs :: Instr -> (Reg -> Reg) -> Instr +patchRegs instr env = case instr of + SPILL reg slot -> SPILL (env reg) slot + RELOAD slot reg -> RELOAD slot (env reg) + LD sz reg addr -> LD sz (env reg) (fixAddr addr) + LDA reg addr -> LDA (env reg) (fixAddr addr) + LDAH reg addr -> LDAH (env reg) (fixAddr addr) + LDGP reg addr -> LDGP (env reg) (fixAddr addr) + LDI sz reg imm -> LDI sz (env reg) imm + ST sz reg addr -> ST sz (env reg) (fixAddr addr) + CLR reg -> CLR (env reg) + ABS sz ar reg -> ABS sz (fixRI ar) (env reg) + NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg) + ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2) + SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2) + SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2) + SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2) + MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2) + DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2) + REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2) + NOT ar reg -> NOT (fixRI ar) (env reg) + AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2) + ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2) + OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2) + ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2) + XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2) + XORNOT r1 ar r2 -> XORNOT (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) + ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2) + ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2) + CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2) + FCLR reg -> FCLR (env reg) + FABS r1 r2 -> FABS (env r1) (env r2) + FNEG s r1 r2 -> FNEG s (env r1) (env r2) + FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3) + FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3) + FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3) + FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3) + CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2) + FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3) + FMOV r1 r2 -> FMOV (env r1) (env r2) + BI cond reg lbl -> BI cond (env reg) lbl + BF cond reg lbl -> BF cond (env reg) lbl + JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint + JSR reg addr i -> JSR (env reg) (fixAddr addr) i + _ -> instr + where + fixAddr (AddrReg r1) = AddrReg (env r1) + fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i + fixAddr other = other + + fixRI (RIReg r) = RIReg (env r) + fixRI other = other + + +mkSpillInstr + :: Reg -- register to spill + -> Int -- current stack delta + -> Int -- spill slot to use + -> Instr + +mkSpillInstr reg delta slot + = let off = spillSlotToOffset slot + in + -- Alpha: spill below the stack pointer (?) + ST sz dyn (spRel (- (off `div` 8))) + + +mkLoadInstr + :: Reg -- register to load + -> Int -- current stack delta + -> Int -- spill slot to use + -> Instr +mkLoadInstr reg delta slot + = let off = spillSlotToOffset slot + in + LD sz dyn (spRel (- (off `div` 8))) + + +mkBranchInstr + :: BlockId + -> [Instr] + +mkBranchInstr id = [BR id] + +-} + + + + diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs index a6cc758..85aa494 100644 --- a/compiler/nativeGen/PPC/Instr.hs +++ b/compiler/nativeGen/PPC/Instr.hs @@ -19,7 +19,8 @@ module PPC.Instr ( where import BlockId -import Regs +import PPC.Regs +import RegsBase import Cmm import Outputable import FastString diff --git a/compiler/nativeGen/PPC/RegInfo.hs b/compiler/nativeGen/PPC/RegInfo.hs new file mode 100644 index 0000000..5efda84 --- /dev/null +++ b/compiler/nativeGen/PPC/RegInfo.hs @@ -0,0 +1,310 @@ +----------------------------------------------------------------------------- +-- +-- Machine-specific parts of the register allocator +-- +-- (c) The University of Glasgow 1996-2004 +-- +----------------------------------------------------------------------------- + +module PPC.RegInfo ( + RegUsage(..), + noUsage, + regUsage, + patchRegs, + jumpDests, + isJumpish, + patchJump, + isRegRegMove, + + JumpDest, + canShortcut, + shortcutJump, + + mkSpillInstr, + mkLoadInstr, + mkRegRegMoveInstr, + mkBranchInstr, + + spillSlotSize, + maxSpillSlots, + spillSlotToOffset +) + +where + +#include "nativeGen/NCG.h" +#include "HsVersions.h" + +import BlockId +import Cmm +import CLabel +import RegsBase +import PPC.Regs +import PPC.Instr +import Outputable +import Constants ( rESERVED_C_STACK_BYTES ) +import FastBool + +data RegUsage = RU [Reg] [Reg] + +noUsage :: RegUsage +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]) + 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 + MTCTR reg -> usage ([reg],[]) + BCTR targets -> noUsage + BL imm 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]) + 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]) + DIVWU reg1 reg2 reg3-> usage ([reg2,reg3], [reg1]) + MULLW_MayOflo reg1 reg2 reg3 + -> usage ([reg2,reg3], [reg1]) + 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]) + 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 + -> 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]) + FNEG r1 r2 -> usage ([r2], [r1]) + FCMP r1 r2 -> usage ([r1,r2], []) + FCTIWZ r1 r2 -> usage ([r2], [r1]) + FRSP r1 r2 -> usage ([r2], [r1]) + MFCR reg -> usage ([], [reg]) + MFLR reg -> usage ([], [reg]) + FETCHPC reg -> usage ([], [reg]) + _ -> noUsage + where + usage (src, dst) = RU (filter interesting src) + (filter interesting dst) + regAddr (AddrRegReg r1 r2) = [r1, r2] + regAddr (AddrRegImm r1 _) = [r1] + + regRI (RIReg r) = [r] + regRI _ = [] + +interesting :: Reg -> Bool +interesting (VirtualRegI _) = True +interesting (VirtualRegHi _) = True +interesting (VirtualRegF _) = True +interesting (VirtualRegD _) = True +interesting (RealReg i) = isFastTrue (freeReg i) + + +-- ----------------------------------------------------------------------------- +-- 'patchRegs' function + +-- 'patchRegs' takes an instruction and applies the given mapping to +-- all the register references. + +patchRegs :: Instr -> (Reg -> Reg) -> Instr +patchRegs instr env = case instr of + SPILL reg slot -> SPILL (env reg) slot + RELOAD slot reg -> RELOAD slot (env reg) + + LD sz reg addr -> LD sz (env reg) (fixAddr addr) + LA sz reg addr -> LA sz (env reg) (fixAddr addr) + ST sz reg addr -> ST sz (env reg) (fixAddr addr) + STU sz reg addr -> STU sz (env reg) (fixAddr addr) + LIS reg imm -> LIS (env reg) imm + LI reg imm -> LI (env reg) imm + MR reg1 reg2 -> MR (env reg1) (env reg2) + CMP sz reg ri -> CMP sz (env reg) (fixRI ri) + CMPL sz reg ri -> CMPL sz (env reg) (fixRI ri) + BCC cond lbl -> BCC cond lbl + BCCFAR cond lbl -> BCCFAR cond lbl + MTCTR reg -> MTCTR (env reg) + BCTR targets -> BCTR targets + BL imm argRegs -> BL imm argRegs -- argument regs + BCTRL argRegs -> BCTRL argRegs -- cannot be remapped + ADD reg1 reg2 ri -> ADD (env reg1) (env reg2) (fixRI ri) + ADDC reg1 reg2 reg3-> ADDC (env reg1) (env reg2) (env reg3) + ADDE reg1 reg2 reg3-> ADDE (env reg1) (env reg2) (env reg3) + ADDIS reg1 reg2 imm -> ADDIS (env reg1) (env reg2) imm + SUBF reg1 reg2 reg3-> SUBF (env reg1) (env reg2) (env reg3) + MULLW reg1 reg2 ri -> MULLW (env reg1) (env reg2) (fixRI ri) + DIVW reg1 reg2 reg3-> DIVW (env reg1) (env reg2) (env reg3) + DIVWU reg1 reg2 reg3-> DIVWU (env reg1) (env reg2) (env reg3) + MULLW_MayOflo reg1 reg2 reg3 + -> MULLW_MayOflo (env reg1) (env reg2) (env reg3) + AND reg1 reg2 ri -> AND (env reg1) (env reg2) (fixRI ri) + OR reg1 reg2 ri -> OR (env reg1) (env reg2) (fixRI ri) + XOR reg1 reg2 ri -> XOR (env reg1) (env reg2) (fixRI ri) + XORIS reg1 reg2 imm -> XORIS (env reg1) (env reg2) imm + EXTS sz reg1 reg2 -> EXTS sz (env reg1) (env reg2) + NEG reg1 reg2 -> NEG (env reg1) (env reg2) + NOT reg1 reg2 -> NOT (env reg1) (env reg2) + SLW reg1 reg2 ri -> SLW (env reg1) (env reg2) (fixRI ri) + SRW reg1 reg2 ri -> SRW (env reg1) (env reg2) (fixRI ri) + SRAW reg1 reg2 ri -> SRAW (env reg1) (env reg2) (fixRI ri) + RLWINM reg1 reg2 sh mb me + -> RLWINM (env reg1) (env reg2) sh mb me + FADD sz r1 r2 r3 -> FADD sz (env r1) (env r2) (env r3) + FSUB sz r1 r2 r3 -> FSUB sz (env r1) (env r2) (env r3) + FMUL sz r1 r2 r3 -> FMUL sz (env r1) (env r2) (env r3) + FDIV sz r1 r2 r3 -> FDIV sz (env r1) (env r2) (env r3) + FNEG r1 r2 -> FNEG (env r1) (env r2) + FCMP r1 r2 -> FCMP (env r1) (env r2) + FCTIWZ r1 r2 -> FCTIWZ (env r1) (env r2) + FRSP r1 r2 -> FRSP (env r1) (env r2) + MFCR reg -> MFCR (env reg) + MFLR reg -> MFLR (env reg) + FETCHPC reg -> FETCHPC (env reg) + _ -> instr + where + fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2) + fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i + + fixRI (RIReg r) = RIReg (env r) + fixRI other = other + + + +jumpDests :: Instr -> [BlockId] -> [BlockId] +jumpDests insn acc + = case insn of + BCC _ id -> id : acc + BCCFAR _ id -> id : acc + BCTR targets -> targets ++ acc + _ -> acc + + +-- | Check whether a particular instruction is a jump, branch or call instruction (jumpish) +-- We can't just use jumpDests above because the jump might take its arg, +-- so the instr won't contain a blockid. +-- +isJumpish :: Instr -> Bool +isJumpish instr + = case instr of + BCC{} -> True + BCCFAR{} -> True + JMP{} -> True + + +-- | Change the destination of this jump instruction +-- Used in joinToTargets in the linear allocator, when emitting fixup code +-- for join points. +patchJump :: Instr -> BlockId -> BlockId -> Instr +patchJump insn old new + = case insn of + BCC cc id + | id == old -> BCC cc new + + BCCFAR cc id + | id == old -> BCCFAR cc new + + BCTR targets -> error "Cannot patch BCTR" + + _ -> insn + + +isRegRegMove :: Instr -> Maybe (Reg,Reg) +isRegRegMove (MR dst src) = Just (src,dst) +isRegRegMove _ = Nothing + + +data JumpDest = DestBlockId BlockId | DestImm Imm + +canShortcut :: Instr -> Maybe JumpDest +canShortcut _ = Nothing + +shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr +shortcutJump fn other = other + + + + +-- ----------------------------------------------------------------------------- +-- Generating spill instructions + +mkSpillInstr + :: Reg -- register to spill + -> Int -- current stack delta + -> Int -- spill slot to use + -> Instr +mkSpillInstr reg delta slot + = let off = spillSlotToOffset slot + in + let sz = case regClass reg of + RcInteger -> II32 + RcDouble -> FF64 + in ST sz reg (AddrRegImm sp (ImmInt (off-delta))) + + +mkLoadInstr + :: Reg -- register to load + -> Int -- current stack delta + -> Int -- spill slot to use + -> Instr +mkLoadInstr reg delta slot + = let off = spillSlotToOffset slot + in + let sz = case regClass reg of + RcInteger -> II32 + RcDouble -> FF64 + in LD sz reg (AddrRegImm sp (ImmInt (off-delta))) + + +mkRegRegMoveInstr + :: Reg + -> Reg + -> Instr +mkRegRegMoveInstr src dst + = MR dst src + + +mkBranchInstr + :: BlockId + -> [Instr] + +mkBranchInstr id = [BCC ALWAYS id] + + + +spillSlotSize :: Int +spillSlotSize = 8 + +maxSpillSlots :: Int +maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1 + +-- convert a spill slot number to a *byte* offset, with no sign: +-- decide on a per arch basis whether you are spilling above or below +-- the C stack pointer. +spillSlotToOffset :: Int -> Int +spillSlotToOffset slot + | slot >= 0 && slot < maxSpillSlots + = 64 + spillSlotSize * slot + | otherwise + = pprPanic "spillSlotToOffset:" + ( text "invalid spill location: " <> int slot + $$ text "maxSpillSlots: " <> int maxSpillSlots) diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs index ce28c4e..7f977d1 100644 --- a/compiler/nativeGen/RegAlloc/Linear/Main.hs +++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs @@ -323,7 +323,7 @@ raInsn block_live new_instrs id (Instr instr (Just live)) (uniqSetToList $ liveDieWrite live) -raInsn _ _ id instr +raInsn _ _ _ instr = pprPanic "raInsn" (text "no match for:" <> ppr instr) diff --git a/compiler/nativeGen/RegAllocInfo.hs b/compiler/nativeGen/RegAllocInfo.hs index 4f85a08..f0cb8b5 100644 --- a/compiler/nativeGen/RegAllocInfo.hs +++ b/compiler/nativeGen/RegAllocInfo.hs @@ -13,9 +13,12 @@ -- ----------------------------------------------------------------------------- -#include "nativeGen/NCG.h" module RegAllocInfo ( + -- shared code + shortcutStatic, + + -- machine specific RegUsage(..), noUsage, regUsage, @@ -25,15 +28,20 @@ module RegAllocInfo ( patchJump, isRegRegMove, - JumpDest, canShortcut, shortcutJump, shortcutStatic, + JumpDest, + canShortcut, + shortcutJump, - maxSpillSlots, mkSpillInstr, mkLoadInstr, mkRegRegMoveInstr, - mkBranchInstr + mkBranchInstr, + + maxSpillSlots, + spillSlotToOffset ) where +#include "nativeGen/NCG.h" #include "HsVersions.h" import BlockId @@ -45,469 +53,20 @@ import Outputable import Constants ( rESERVED_C_STACK_BYTES ) import FastBool --- ----------------------------------------------------------------------------- --- RegUsage type - --- @regUsage@ returns the sets of src and destination registers used --- by a particular instruction. Machine registers that are --- pre-allocated to stgRegs are filtered out, because they are --- uninteresting from a register allocation standpoint. (We wouldn't --- want them to end up on the free list!) As far as we are concerned, --- the fixed registers simply don't exist (for allocation purposes, --- anyway). - --- regUsage doesn't need to do any trickery for jumps and such. Just --- state precisely the regs read and written by that insn. The --- consequences of control flow transfers, as far as register --- allocation goes, are taken care of by the register allocator. - -data RegUsage = RU [Reg] [Reg] - -noUsage :: RegUsage -noUsage = RU [] [] - -regUsage :: Instr -> RegUsage - -interesting (VirtualRegI _) = True -interesting (VirtualRegHi _) = True -interesting (VirtualRegF _) = True -interesting (VirtualRegD _) = True -interesting (RealReg i) = isFastTrue (freeReg i) - - -#if alpha_TARGET_ARCH -regUsage instr = case instr of - SPILL reg slot -> usage ([reg], []) - RELOAD slot reg -> usage ([], [reg]) - LD B reg addr -> usage (regAddr addr, [reg, t9]) - LD Bu reg addr -> usage (regAddr addr, [reg, t9]) --- LD W reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED --- LD Wu reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED - LD sz reg addr -> usage (regAddr addr, [reg]) - LDA reg addr -> usage (regAddr addr, [reg]) - LDAH reg addr -> usage (regAddr addr, [reg]) - LDGP reg addr -> usage (regAddr addr, [reg]) - LDI sz reg imm -> usage ([], [reg]) - ST B reg addr -> usage (reg : regAddr addr, [t9, t10]) --- ST W reg addr -> usage (reg : regAddr addr, [t9, t10]) : UNUSED - ST sz reg addr -> usage (reg : regAddr addr, []) - CLR reg -> usage ([], [reg]) - ABS sz ri reg -> usage (regRI ri, [reg]) - NEG sz ov ri reg -> usage (regRI ri, [reg]) - ADD sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SUB sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2]) - MUL sz ov r1 ar r2 -> usage (r1 : regRI ar, [r2]) - DIV sz un r1 ar r2 -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12]) - REM sz un r1 ar r2 -> usage (r1 : regRI ar, [r2, t9, t10, t11, t12]) - NOT ri reg -> usage (regRI ri, [reg]) - AND r1 ar r2 -> usage (r1 : regRI ar, [r2]) - ANDNOT r1 ar r2 -> usage (r1 : regRI ar, [r2]) - OR r1 ar r2 -> usage (r1 : regRI ar, [r2]) - ORNOT r1 ar r2 -> usage (r1 : regRI ar, [r2]) - XOR r1 ar r2 -> usage (r1 : regRI ar, [r2]) - XORNOT r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SLL r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SRL r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SRA r1 ar r2 -> usage (r1 : regRI ar, [r2]) - ZAP r1 ar r2 -> usage (r1 : regRI ar, [r2]) - ZAPNOT r1 ar r2 -> usage (r1 : regRI ar, [r2]) - CMP co r1 ar r2 -> usage (r1 : regRI ar, [r2]) - FCLR reg -> usage ([], [reg]) - FABS r1 r2 -> usage ([r1], [r2]) - FNEG sz r1 r2 -> usage ([r1], [r2]) - FADD sz r1 r2 r3 -> usage ([r1, r2], [r3]) - FDIV sz r1 r2 r3 -> usage ([r1, r2], [r3]) - FMUL sz r1 r2 r3 -> usage ([r1, r2], [r3]) - FSUB sz r1 r2 r3 -> usage ([r1, r2], [r3]) - CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2]) - FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3]) - FMOV r1 r2 -> usage ([r1], [r2]) - - - -- We assume that all local jumps will be BI/BF/BR. JMP must be out-of-line. - BI cond reg lbl -> usage ([reg], []) - BF cond reg lbl -> usage ([reg], []) - JMP reg addr hint -> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet - - BSR _ n -> RU (argRegSet n) callClobberedRegSet - JSR reg addr n -> RU (argRegSet n) callClobberedRegSet - - _ -> noUsage - - where - usage (src, dst) = RU (mkRegSet (filter interesting src)) - (mkRegSet (filter interesting dst)) - - interesting (FixedReg _) = False - interesting _ = True - - regAddr (AddrReg r1) = [r1] - regAddr (AddrRegImm r1 _) = [r1] - regAddr (AddrImm _) = [] - - regRI (RIReg r) = [r] - regRI _ = [] - -#endif /* alpha_TARGET_ARCH */ --- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#if i386_TARGET_ARCH || x86_64_TARGET_ARCH - -regUsage instr = case instr of - MOV sz src dst -> usageRW src dst - MOVZxL sz src dst -> usageRW src dst - MOVSxL sz src dst -> usageRW src dst - LEA sz src dst -> usageRW src dst - ADD sz src dst -> usageRM src dst - ADC sz src dst -> usageRM src dst - SUB sz src dst -> usageRM src dst - IMUL sz src dst -> usageRM src dst - IMUL2 sz src -> mkRU (eax:use_R src) [eax,edx] - MUL sz src dst -> usageRM src dst - DIV sz op -> mkRU (eax:edx:use_R op) [eax,edx] - IDIV sz op -> mkRU (eax:edx:use_R op) [eax,edx] - AND sz src dst -> usageRM src dst - OR sz src dst -> usageRM src dst - XOR sz (OpReg src) (OpReg dst) - | src == dst -> mkRU [] [dst] - XOR sz src dst -> usageRM src dst - NOT sz op -> usageM op - NEGI sz op -> usageM op - SHL sz imm dst -> usageRM imm dst - SAR sz imm dst -> usageRM imm dst - SHR sz imm dst -> usageRM imm dst - BT sz imm src -> mkRUR (use_R src) - - PUSH sz op -> mkRUR (use_R op) - POP sz op -> mkRU [] (def_W op) - TEST sz src dst -> mkRUR (use_R src ++ use_R dst) - CMP sz src dst -> mkRUR (use_R src ++ use_R dst) - SETCC cond op -> mkRU [] (def_W op) - JXX cond lbl -> mkRU [] [] - JXX_GBL cond lbl -> mkRU [] [] - JMP op -> mkRUR (use_R op) - JMP_TBL op ids -> mkRUR (use_R op) - CALL (Left imm) params -> mkRU params callClobberedRegs - CALL (Right reg) params -> mkRU (reg:params) callClobberedRegs - CLTD sz -> mkRU [eax] [edx] - NOP -> mkRU [] [] - -#if i386_TARGET_ARCH - GMOV src dst -> mkRU [src] [dst] - GLD sz src dst -> mkRU (use_EA src) [dst] - GST sz src dst -> mkRUR (src : use_EA dst) - - GLDZ dst -> mkRU [] [dst] - GLD1 dst -> mkRU [] [dst] - - GFTOI src dst -> mkRU [src] [dst] - GDTOI src dst -> mkRU [src] [dst] - - GITOF src dst -> mkRU [src] [dst] - GITOD src dst -> mkRU [src] [dst] - - GADD sz s1 s2 dst -> mkRU [s1,s2] [dst] - GSUB sz s1 s2 dst -> mkRU [s1,s2] [dst] - GMUL sz s1 s2 dst -> mkRU [s1,s2] [dst] - GDIV sz s1 s2 dst -> mkRU [s1,s2] [dst] - - GCMP sz src1 src2 -> mkRUR [src1,src2] - GABS sz src dst -> mkRU [src] [dst] - GNEG sz src dst -> mkRU [src] [dst] - GSQRT sz src dst -> mkRU [src] [dst] - GSIN sz _ _ src dst -> mkRU [src] [dst] - GCOS sz _ _ src dst -> mkRU [src] [dst] - GTAN sz _ _ src dst -> mkRU [src] [dst] -#endif - -#if x86_64_TARGET_ARCH - CVTSS2SD src dst -> mkRU [src] [dst] - CVTSD2SS src dst -> mkRU [src] [dst] - CVTTSS2SIQ src dst -> mkRU (use_R src) [dst] - CVTTSD2SIQ src dst -> mkRU (use_R src) [dst] - CVTSI2SS src dst -> mkRU (use_R src) [dst] - CVTSI2SD src dst -> mkRU (use_R src) [dst] - FDIV sz src dst -> usageRM src dst -#endif - - FETCHGOT reg -> mkRU [] [reg] - FETCHPC reg -> mkRU [] [reg] - - COMMENT _ -> noUsage - DELTA _ -> noUsage - SPILL reg slot -> mkRU [reg] [] - RELOAD slot reg -> mkRU [] [reg] +#if alpha_TARGET_ARCH +import Alpha.RegInfo - _other -> panic "regUsage: unrecognised instr" +#elif i386_TARGET_ARCH || x86_64_TARGET_ARCH +import X86.RegInfo - where - -- 2 operand form; first operand Read; second Written - usageRW :: Operand -> Operand -> RegUsage - usageRW op (OpReg reg) = mkRU (use_R op) [reg] - usageRW op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea) - - -- 2 operand form; first operand Read; second Modified - usageRM :: Operand -> Operand -> RegUsage - usageRM op (OpReg reg) = mkRU (use_R op ++ [reg]) [reg] - usageRM op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea) - - -- 1 operand form; operand Modified - usageM :: Operand -> RegUsage - usageM (OpReg reg) = mkRU [reg] [reg] - usageM (OpAddr ea) = mkRUR (use_EA ea) - - -- Registers defd when an operand is written. - def_W (OpReg reg) = [reg] - def_W (OpAddr ea) = [] - - -- Registers used when an operand is read. - use_R (OpReg reg) = [reg] - use_R (OpImm imm) = [] - use_R (OpAddr ea) = use_EA ea - - -- Registers used to compute an effective address. - use_EA (ImmAddr _ _) = [] - use_EA (AddrBaseIndex base index _) = - use_base base $! use_index index - where use_base (EABaseReg r) x = r : x - use_base _ x = x - use_index EAIndexNone = [] - use_index (EAIndex i _) = [i] - - mkRUR src = src' `seq` RU src' [] - where src' = filter interesting src - - mkRU src dst = src' `seq` dst' `seq` RU src' dst' - where src' = filter interesting src - dst' = filter interesting dst - -#endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */ --- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#if sparc_TARGET_ARCH - -regUsage instr = case instr of - SPILL reg slot -> usage ([reg], []) - RELOAD slot reg -> usage ([], [reg]) - - LD sz addr reg -> usage (regAddr addr, [reg]) - ST sz reg addr -> usage (reg : regAddr addr, []) - ADD x cc r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SUB x cc r1 ar r2 -> usage (r1 : regRI ar, [r2]) - UMUL cc r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SMUL cc r1 ar r2 -> usage (r1 : regRI ar, [r2]) - UDIV cc r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SDIV cc r1 ar r2 -> usage (r1 : regRI ar, [r2]) - RDY rd -> usage ([], [rd]) - WRY r1 r2 -> usage ([r1, r2], []) - AND b r1 ar r2 -> usage (r1 : regRI ar, [r2]) - ANDN b r1 ar r2 -> usage (r1 : regRI ar, [r2]) - OR b r1 ar r2 -> usage (r1 : regRI ar, [r2]) - ORN b r1 ar r2 -> usage (r1 : regRI ar, [r2]) - XOR b r1 ar r2 -> usage (r1 : regRI ar, [r2]) - XNOR b r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SLL r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SRL r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SRA r1 ar r2 -> usage (r1 : regRI ar, [r2]) - SETHI imm reg -> usage ([], [reg]) - FABS s r1 r2 -> usage ([r1], [r2]) - FADD s r1 r2 r3 -> usage ([r1, r2], [r3]) - FCMP e s r1 r2 -> usage ([r1, r2], []) - FDIV s r1 r2 r3 -> usage ([r1, r2], [r3]) - FMOV s r1 r2 -> usage ([r1], [r2]) - FMUL s r1 r2 r3 -> usage ([r1, r2], [r3]) - FNEG s r1 r2 -> usage ([r1], [r2]) - FSQRT s r1 r2 -> usage ([r1], [r2]) - FSUB s r1 r2 r3 -> usage ([r1, r2], [r3]) - FxTOy s1 s2 r1 r2 -> usage ([r1], [r2]) - - JMP addr -> usage (regAddr addr, []) - JMP_TBL addr ids -> usage (regAddr addr, []) - - CALL (Left imm) n True -> noUsage - CALL (Left imm) n False -> usage (argRegs n, callClobberedRegs) - CALL (Right reg) n True -> usage ([reg], []) - CALL (Right reg) n False -> usage (reg : (argRegs n), callClobberedRegs) - - _ -> noUsage - where - usage (src, dst) = RU (filter interesting src) - (filter interesting dst) - - regAddr (AddrRegReg r1 r2) = [r1, r2] - regAddr (AddrRegImm r1 _) = [r1] - - regRI (RIReg r) = [r] - regRI _ = [] - -#endif /* sparc_TARGET_ARCH */ --- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#if powerpc_TARGET_ARCH - -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]) - 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 - MTCTR reg -> usage ([reg],[]) - BCTR targets -> noUsage - BL imm 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]) - 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]) - DIVWU reg1 reg2 reg3-> usage ([reg2,reg3], [reg1]) - MULLW_MayOflo reg1 reg2 reg3 - -> usage ([reg2,reg3], [reg1]) - 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]) - 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 - -> 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]) - FNEG r1 r2 -> usage ([r2], [r1]) - FCMP r1 r2 -> usage ([r1,r2], []) - FCTIWZ r1 r2 -> usage ([r2], [r1]) - FRSP r1 r2 -> usage ([r2], [r1]) - MFCR reg -> usage ([], [reg]) - MFLR reg -> usage ([], [reg]) - FETCHPC reg -> usage ([], [reg]) - _ -> noUsage - where - usage (src, dst) = RU (filter interesting src) - (filter interesting dst) - regAddr (AddrRegReg r1 r2) = [r1, r2] - regAddr (AddrRegImm r1 _) = [r1] - - regRI (RIReg r) = [r] - regRI _ = [] -#endif /* powerpc_TARGET_ARCH */ - - --- ----------------------------------------------------------------------------- --- Determine the possible destinations from the current instruction. - --- (we always assume that the next instruction is also a valid destination; --- if this isn't the case then the jump should be at the end of the basic --- block). - -jumpDests :: Instr -> [BlockId] -> [BlockId] -jumpDests insn acc - = case insn of -#if i386_TARGET_ARCH || x86_64_TARGET_ARCH - JXX _ id -> id : acc - JMP_TBL _ ids -> ids ++ acc #elif powerpc_TARGET_ARCH - BCC _ id -> id : acc - BCCFAR _ id -> id : acc - BCTR targets -> targets ++ acc -#elif sparc_TARGET_ARCH - BI _ _ id -> id : acc - BF _ _ id -> id : acc - JMP_TBL _ ids -> ids ++ acc -#else -#error "RegAllocInfo.jumpDests not finished" -#endif - _other -> acc +import PPC.RegInfo - --- | Check whether a particular instruction is a jump, branch or call instruction (jumpish) --- We can't just use jumpDests above because the jump might take its arg, --- so the instr won't contain a blockid. --- -isJumpish :: Instr -> Bool -isJumpish instr - = case instr of -#if i386_TARGET_ARCH || x86_64_TARGET_ARCH - JMP{} -> True - JXX{} -> True - JXX_GBL{} -> True - JMP_TBL{} -> True - CALL{} -> True - -#elif powerpc_TARGET_ARCH - BCC{} -> True - BCCFAR{} -> True - JMP{} -> True - -#elif sparc_TARGET_ARCH - BI{} -> True - BF{} -> True - JMP{} -> True - JMP_TBL{} -> True - CALL{} -> True -#else -#error "RegAllocInfo.isJumpish: not implemented for this architecture" -#endif - _ -> False - - --- | Change the destination of this jump instruction --- Used in joinToTargets in the linear allocator, when emitting fixup code --- for join points. -patchJump :: Instr -> BlockId -> BlockId -> Instr -patchJump insn old new - = case insn of -#if i386_TARGET_ARCH || x86_64_TARGET_ARCH - JXX cc id | id == old -> JXX cc new - JMP_TBL op ids -> error "Cannot patch JMP_TBL" -#elif powerpc_TARGET_ARCH - BCC cc id | id == old -> BCC cc new - BCCFAR cc id | id == old -> BCCFAR cc new - BCTR targets -> error "Cannot patch BCTR" #elif sparc_TARGET_ARCH - BI cc annul id - | id == old -> BI cc annul new - - BF cc annul id - | id == old -> BF cc annul new -#else -#error "RegAllocInfo.patchJump not finished" -#endif - _other -> insn - -data JumpDest = DestBlockId BlockId | DestImm Imm +import SPARC.RegInfo -canShortcut :: Instr -> Maybe JumpDest -#if i386_TARGET_ARCH || x86_64_TARGET_ARCH -canShortcut (JXX ALWAYS id) = Just (DestBlockId id) -canShortcut (JMP (OpImm imm)) = Just (DestImm imm) #endif -canShortcut _ = Nothing -shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr -#if i386_TARGET_ARCH || x86_64_TARGET_ARCH -shortcutJump fn insn@(JXX cc id) = - case fn id of - Nothing -> insn - Just (DestBlockId id') -> shortcutJump fn (JXX cc id') - Just (DestImm imm) -> shortcutJump fn (JXX_GBL cc imm) -#endif -shortcutJump fn other = other -- Here because it knows about JumpDest shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic @@ -529,465 +88,7 @@ shortBlockId fn blockid@(BlockId uq) = Just (DestImm (ImmCLbl lbl)) -> lbl _other -> panic "shortBlockId" --- ----------------------------------------------------------------------------- --- 'patchRegs' function - --- 'patchRegs' takes an instruction and applies the given mapping to --- all the register references. - -patchRegs :: Instr -> (Reg -> Reg) -> Instr - -#if alpha_TARGET_ARCH - -patchRegs instr env = case instr of - SPILL reg slot -> SPILL (env reg) slot - RELOAD slot reg -> RELOAD slot (env reg) - LD sz reg addr -> LD sz (env reg) (fixAddr addr) - LDA reg addr -> LDA (env reg) (fixAddr addr) - LDAH reg addr -> LDAH (env reg) (fixAddr addr) - LDGP reg addr -> LDGP (env reg) (fixAddr addr) - LDI sz reg imm -> LDI sz (env reg) imm - ST sz reg addr -> ST sz (env reg) (fixAddr addr) - CLR reg -> CLR (env reg) - ABS sz ar reg -> ABS sz (fixRI ar) (env reg) - NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg) - ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2) - SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2) - SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2) - SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2) - MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2) - DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2) - REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2) - NOT ar reg -> NOT (fixRI ar) (env reg) - AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2) - ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2) - OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2) - ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2) - XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2) - XORNOT r1 ar r2 -> XORNOT (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) - ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2) - ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2) - CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2) - FCLR reg -> FCLR (env reg) - FABS r1 r2 -> FABS (env r1) (env r2) - FNEG s r1 r2 -> FNEG s (env r1) (env r2) - FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3) - FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3) - FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3) - FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3) - CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2) - FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3) - FMOV r1 r2 -> FMOV (env r1) (env r2) - BI cond reg lbl -> BI cond (env reg) lbl - BF cond reg lbl -> BF cond (env reg) lbl - JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint - JSR reg addr i -> JSR (env reg) (fixAddr addr) i - _ -> instr - where - fixAddr (AddrReg r1) = AddrReg (env r1) - fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i - fixAddr other = other - - fixRI (RIReg r) = RIReg (env r) - fixRI other = other - -#endif /* alpha_TARGET_ARCH */ --- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#if i386_TARGET_ARCH || x86_64_TARGET_ARCH - -patchRegs instr env = case instr of - MOV sz src dst -> patch2 (MOV sz) src dst - MOVZxL sz src dst -> patch2 (MOVZxL sz) src dst - MOVSxL sz src dst -> patch2 (MOVSxL sz) src dst - LEA sz src dst -> patch2 (LEA sz) src dst - ADD sz src dst -> patch2 (ADD sz) src dst - ADC sz src dst -> patch2 (ADC sz) src dst - SUB sz src dst -> patch2 (SUB sz) src dst - IMUL sz src dst -> patch2 (IMUL sz) src dst - IMUL2 sz src -> patch1 (IMUL2 sz) src - MUL sz src dst -> patch2 (MUL sz) src dst - IDIV sz op -> patch1 (IDIV sz) op - DIV sz op -> patch1 (DIV sz) op - AND sz src dst -> patch2 (AND sz) src dst - OR sz src dst -> patch2 (OR sz) src dst - XOR sz src dst -> patch2 (XOR sz) src dst - NOT sz op -> patch1 (NOT sz) op - NEGI sz op -> patch1 (NEGI sz) op - SHL sz imm dst -> patch1 (SHL sz imm) dst - SAR sz imm dst -> patch1 (SAR sz imm) dst - SHR sz imm dst -> patch1 (SHR sz imm) dst - BT sz imm src -> patch1 (BT sz imm) src - TEST sz src dst -> patch2 (TEST sz) src dst - CMP sz src dst -> patch2 (CMP sz) src dst - PUSH sz op -> patch1 (PUSH sz) op - POP sz op -> patch1 (POP sz) op - SETCC cond op -> patch1 (SETCC cond) op - JMP op -> patch1 JMP op - JMP_TBL op ids -> patch1 JMP_TBL op $ ids - -#if i386_TARGET_ARCH - GMOV src dst -> GMOV (env src) (env dst) - GLD sz src dst -> GLD sz (lookupAddr src) (env dst) - GST sz src dst -> GST sz (env src) (lookupAddr dst) - - GLDZ dst -> GLDZ (env dst) - GLD1 dst -> GLD1 (env dst) - - GFTOI src dst -> GFTOI (env src) (env dst) - GDTOI src dst -> GDTOI (env src) (env dst) - - GITOF src dst -> GITOF (env src) (env dst) - GITOD src dst -> GITOD (env src) (env dst) - - GADD sz s1 s2 dst -> GADD sz (env s1) (env s2) (env dst) - GSUB sz s1 s2 dst -> GSUB sz (env s1) (env s2) (env dst) - GMUL sz s1 s2 dst -> GMUL sz (env s1) (env s2) (env dst) - GDIV sz s1 s2 dst -> GDIV sz (env s1) (env s2) (env dst) - - GCMP sz src1 src2 -> GCMP sz (env src1) (env src2) - GABS sz src dst -> GABS sz (env src) (env dst) - GNEG sz src dst -> GNEG sz (env src) (env dst) - GSQRT sz src dst -> GSQRT sz (env src) (env dst) - GSIN sz l1 l2 src dst -> GSIN sz l1 l2 (env src) (env dst) - GCOS sz l1 l2 src dst -> GCOS sz l1 l2 (env src) (env dst) - GTAN sz l1 l2 src dst -> GTAN sz l1 l2 (env src) (env dst) -#endif - -#if x86_64_TARGET_ARCH - CVTSS2SD src dst -> CVTSS2SD (env src) (env dst) - CVTSD2SS src dst -> CVTSD2SS (env src) (env dst) - CVTTSS2SIQ src dst -> CVTTSS2SIQ (patchOp src) (env dst) - CVTTSD2SIQ src dst -> CVTTSD2SIQ (patchOp src) (env dst) - CVTSI2SS src dst -> CVTSI2SS (patchOp src) (env dst) - CVTSI2SD src dst -> CVTSI2SD (patchOp src) (env dst) - FDIV sz src dst -> FDIV sz (patchOp src) (patchOp dst) -#endif - - CALL (Left imm) _ -> instr - CALL (Right reg) p -> CALL (Right (env reg)) p - - FETCHGOT reg -> FETCHGOT (env reg) - FETCHPC reg -> FETCHPC (env reg) - - NOP -> instr - COMMENT _ -> instr - DELTA _ -> instr - SPILL reg slot -> SPILL (env reg) slot - RELOAD slot reg -> RELOAD slot (env reg) - - JXX _ _ -> instr - JXX_GBL _ _ -> instr - CLTD _ -> instr - - _other -> panic "patchRegs: unrecognised instr" - - where - patch1 insn op = insn $! patchOp op - patch2 insn src dst = (insn $! patchOp src) $! patchOp dst - - patchOp (OpReg reg) = OpReg $! env reg - patchOp (OpImm imm) = OpImm imm - patchOp (OpAddr ea) = OpAddr $! lookupAddr ea - - lookupAddr (ImmAddr imm off) = ImmAddr imm off - lookupAddr (AddrBaseIndex base index disp) - = ((AddrBaseIndex $! lookupBase base) $! lookupIndex index) disp - where - lookupBase EABaseNone = EABaseNone - lookupBase EABaseRip = EABaseRip - lookupBase (EABaseReg r) = EABaseReg (env r) - - lookupIndex EAIndexNone = EAIndexNone - lookupIndex (EAIndex r i) = EAIndex (env r) i - -#endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH*/ --- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#if sparc_TARGET_ARCH - -patchRegs instr env = case instr of - SPILL reg slot -> SPILL (env reg) slot - RELOAD slot reg -> RELOAD slot (env reg) - 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) - UMUL cc r1 ar r2 -> UMUL cc (env r1) (fixRI ar) (env r2) - SMUL cc r1 ar r2 -> SMUL cc (env r1) (fixRI ar) (env r2) - UDIV cc r1 ar r2 -> UDIV cc (env r1) (fixRI ar) (env r2) - SDIV cc r1 ar r2 -> SDIV cc (env r1) (fixRI ar) (env r2) - RDY rd -> RDY (env rd) - WRY r1 r2 -> WRY (env r1) (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) - JMP_TBL addr ids -> JMP_TBL (fixAddr addr) ids - - CALL (Left i) n t -> CALL (Left i) n t - CALL (Right r) n t -> CALL (Right (env r)) n t - _ -> instr - where - fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2) - fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i - - fixRI (RIReg r) = RIReg (env r) - fixRI other = other - -#endif /* sparc_TARGET_ARCH */ --- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#if powerpc_TARGET_ARCH - -patchRegs instr env = case instr of - SPILL reg slot -> SPILL (env reg) slot - RELOAD slot reg -> RELOAD slot (env reg) - - LD sz reg addr -> LD sz (env reg) (fixAddr addr) - LA sz reg addr -> LA sz (env reg) (fixAddr addr) - ST sz reg addr -> ST sz (env reg) (fixAddr addr) - STU sz reg addr -> STU sz (env reg) (fixAddr addr) - LIS reg imm -> LIS (env reg) imm - LI reg imm -> LI (env reg) imm - MR reg1 reg2 -> MR (env reg1) (env reg2) - CMP sz reg ri -> CMP sz (env reg) (fixRI ri) - CMPL sz reg ri -> CMPL sz (env reg) (fixRI ri) - BCC cond lbl -> BCC cond lbl - BCCFAR cond lbl -> BCCFAR cond lbl - MTCTR reg -> MTCTR (env reg) - BCTR targets -> BCTR targets - BL imm argRegs -> BL imm argRegs -- argument regs - BCTRL argRegs -> BCTRL argRegs -- cannot be remapped - ADD reg1 reg2 ri -> ADD (env reg1) (env reg2) (fixRI ri) - ADDC reg1 reg2 reg3-> ADDC (env reg1) (env reg2) (env reg3) - ADDE reg1 reg2 reg3-> ADDE (env reg1) (env reg2) (env reg3) - ADDIS reg1 reg2 imm -> ADDIS (env reg1) (env reg2) imm - SUBF reg1 reg2 reg3-> SUBF (env reg1) (env reg2) (env reg3) - MULLW reg1 reg2 ri -> MULLW (env reg1) (env reg2) (fixRI ri) - DIVW reg1 reg2 reg3-> DIVW (env reg1) (env reg2) (env reg3) - DIVWU reg1 reg2 reg3-> DIVWU (env reg1) (env reg2) (env reg3) - MULLW_MayOflo reg1 reg2 reg3 - -> MULLW_MayOflo (env reg1) (env reg2) (env reg3) - AND reg1 reg2 ri -> AND (env reg1) (env reg2) (fixRI ri) - OR reg1 reg2 ri -> OR (env reg1) (env reg2) (fixRI ri) - XOR reg1 reg2 ri -> XOR (env reg1) (env reg2) (fixRI ri) - XORIS reg1 reg2 imm -> XORIS (env reg1) (env reg2) imm - EXTS sz reg1 reg2 -> EXTS sz (env reg1) (env reg2) - NEG reg1 reg2 -> NEG (env reg1) (env reg2) - NOT reg1 reg2 -> NOT (env reg1) (env reg2) - SLW reg1 reg2 ri -> SLW (env reg1) (env reg2) (fixRI ri) - SRW reg1 reg2 ri -> SRW (env reg1) (env reg2) (fixRI ri) - SRAW reg1 reg2 ri -> SRAW (env reg1) (env reg2) (fixRI ri) - RLWINM reg1 reg2 sh mb me - -> RLWINM (env reg1) (env reg2) sh mb me - FADD sz r1 r2 r3 -> FADD sz (env r1) (env r2) (env r3) - FSUB sz r1 r2 r3 -> FSUB sz (env r1) (env r2) (env r3) - FMUL sz r1 r2 r3 -> FMUL sz (env r1) (env r2) (env r3) - FDIV sz r1 r2 r3 -> FDIV sz (env r1) (env r2) (env r3) - FNEG r1 r2 -> FNEG (env r1) (env r2) - FCMP r1 r2 -> FCMP (env r1) (env r2) - FCTIWZ r1 r2 -> FCTIWZ (env r1) (env r2) - FRSP r1 r2 -> FRSP (env r1) (env r2) - MFCR reg -> MFCR (env reg) - MFLR reg -> MFLR (env reg) - FETCHPC reg -> FETCHPC (env reg) - _ -> instr - where - fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2) - fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i - - fixRI (RIReg r) = RIReg (env r) - fixRI other = other -#endif /* powerpc_TARGET_ARCH */ - --- ----------------------------------------------------------------------------- --- Detecting reg->reg moves - --- The register allocator attempts to eliminate reg->reg moves whenever it can, --- by assigning the src and dest temporaries to the same real register. - -isRegRegMove :: Instr -> Maybe (Reg,Reg) - -#if i386_TARGET_ARCH || x86_64_TARGET_ARCH --- TMP: -isRegRegMove (MOV _ (OpReg r1) (OpReg r2)) = Just (r1,r2) - -#elif powerpc_TARGET_ARCH -isRegRegMove (MR dst src) = Just (src,dst) - -#elif sparc_TARGET_ARCH -isRegRegMove instr - = case instr of - ADD False False src (RIReg src2) dst - | g0 == src2 -> Just (src, dst) - - FMOV FF64 src dst -> Just (src, dst) - FMOV FF32 src dst -> Just (src, dst) - _ -> Nothing -#endif -isRegRegMove _ = Nothing - --- ----------------------------------------------------------------------------- --- Generating spill instructions - -mkSpillInstr - :: Reg -- register to spill - -> Int -- current stack delta - -> Int -- spill slot to use - -> Instr -mkSpillInstr reg delta slot - = let off = spillSlotToOffset slot - in -#ifdef alpha_TARGET_ARCH - {-Alpha: spill below the stack pointer (?)-} - ST sz dyn (spRel (- (off `div` 8))) -#endif -#ifdef i386_TARGET_ARCH - let off_w = (off-delta) `div` 4 - in case regClass reg of - RcInteger -> MOV II32 (OpReg reg) (OpAddr (spRel off_w)) - _ -> GST FF80 reg (spRel off_w) {- RcFloat/RcDouble -} -#endif -#ifdef x86_64_TARGET_ARCH - let off_w = (off-delta) `div` 8 - in case regClass reg of - RcInteger -> MOV II64 (OpReg reg) (OpAddr (spRel off_w)) - RcDouble -> MOV FF64 (OpReg reg) (OpAddr (spRel off_w)) - -- ToDo: will it work to always spill as a double? - -- does that cause a stall if the data was a float? -#endif -#ifdef sparc_TARGET_ARCH - {-SPARC: spill below frame pointer leaving 2 words/spill-} - let{off_w = 1 + (off `div` 4); - sz = case regClass reg of { - RcInteger -> II32; - RcFloat -> FF32; - RcDouble -> FF64;}} - in ST sz reg (fpRel (negate off_w)) -#endif -#ifdef powerpc_TARGET_ARCH - let sz = case regClass reg of - RcInteger -> II32 - RcDouble -> FF64 - in ST sz reg (AddrRegImm sp (ImmInt (off-delta))) -#endif - - -mkLoadInstr - :: Reg -- register to load - -> Int -- current stack delta - -> Int -- spill slot to use - -> Instr -mkLoadInstr reg delta slot - = let off = spillSlotToOffset slot - in -#if alpha_TARGET_ARCH - LD sz dyn (spRel (- (off `div` 8))) -#endif -#if i386_TARGET_ARCH - let off_w = (off-delta) `div` 4 - in case regClass reg of { - RcInteger -> MOV II32 (OpAddr (spRel off_w)) (OpReg reg); - _ -> GLD FF80 (spRel off_w) reg} {- RcFloat/RcDouble -} -#endif -#if x86_64_TARGET_ARCH - let off_w = (off-delta) `div` 8 - in case regClass reg of - RcInteger -> MOV II64 (OpAddr (spRel off_w)) (OpReg reg) - _ -> MOV FF64 (OpAddr (spRel off_w)) (OpReg reg) -#endif -#if sparc_TARGET_ARCH - let{off_w = 1 + (off `div` 4); - sz = case regClass reg of { - RcInteger -> II32; - RcFloat -> FF32; - RcDouble -> FF64}} - in LD sz (fpRel (- off_w)) reg -#endif -#if powerpc_TARGET_ARCH - let sz = case regClass reg of - RcInteger -> II32 - RcDouble -> FF64 - in LD sz reg (AddrRegImm sp (ImmInt (off-delta))) -#endif - -mkRegRegMoveInstr - :: Reg - -> Reg - -> Instr -mkRegRegMoveInstr src dst -#if i386_TARGET_ARCH || x86_64_TARGET_ARCH - = case regClass src of - RcInteger -> MOV wordSize (OpReg src) (OpReg dst) -#if i386_TARGET_ARCH - RcDouble -> GMOV src dst -#else - RcDouble -> MOV FF64 (OpReg src) (OpReg dst) -#endif -#elif powerpc_TARGET_ARCH - = MR dst src -#elif sparc_TARGET_ARCH - = case regClass src of - RcInteger -> ADD False False src (RIReg g0) dst - RcDouble -> FMOV FF64 src dst - RcFloat -> FMOV FF32 src dst -#else -#error ToDo: mkRegRegMoveInstr -#endif - -mkBranchInstr - :: BlockId - -> [Instr] -#if alpha_TARGET_ARCH -mkBranchInstr id = [BR id] -#endif - -#if i386_TARGET_ARCH || x86_64_TARGET_ARCH -mkBranchInstr id = [JXX ALWAYS id] -#endif - -#if sparc_TARGET_ARCH -mkBranchInstr id = [BI ALWAYS False id, NOP] -#endif - -#if powerpc_TARGET_ARCH -mkBranchInstr id = [BCC ALWAYS id] -#endif -spillSlotSize :: Int -spillSlotSize = IF_ARCH_i386(12, 8) -maxSpillSlots :: Int -maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1 --- convert a spill slot number to a *byte* offset, with no sign: --- decide on a per arch basis whether you are spilling above or below --- the C stack pointer. -spillSlotToOffset :: Int -> Int -spillSlotToOffset slot - | slot >= 0 && slot < maxSpillSlots - = 64 + spillSlotSize * slot - | otherwise - = pprPanic "spillSlotToOffset:" - ( text "invalid spill location: " <> int slot - $$ text "maxSpillSlots: " <> int maxSpillSlots) diff --git a/compiler/nativeGen/Regs.hs b/compiler/nativeGen/Regs.hs index 97ecee6..76a9752 100644 --- a/compiler/nativeGen/Regs.hs +++ b/compiler/nativeGen/Regs.hs @@ -61,18 +61,11 @@ module Regs ( freg, sp, r3, r4, r27, r28, f1, f20, f21, -#elif i386_TARGET_ARCH +#elif i386_TARGET_ARCH || i386_64_TARGET_ARCH EABase(..), EAIndex(..), addrModeRegs, eax, ebx, ecx, edx, esi, edi, ebp, esp, fake0, fake1, fake2, fake3, fake4, fake5, - -#elif i386_64_TARGET_ARCH - EABase(..), EAIndex(..), addrModeRegs, - - ripRel, - allFPArgRegs, - rax, rbx, rcx, rdx, rsi, rdi, rbp, rsp, eax, ebx, ecx, edx, esi, edi, ebp, esp, r8, r9, r10, r11, r12, r13, r14, r15, @@ -80,6 +73,9 @@ module Regs ( xmm8, xmm9, xmm10, xmm11, xmm12, xmm13, xmm14, xmm15, xmm, + ripRel, + allFPArgRegs, + #elif sparc_TARGET_ARCH fpRel, fits13Bits, diff --git a/compiler/nativeGen/SPARC/Instr.hs b/compiler/nativeGen/SPARC/Instr.hs index 5cbf2fe..12e5649 100644 --- a/compiler/nativeGen/SPARC/Instr.hs +++ b/compiler/nativeGen/SPARC/Instr.hs @@ -22,7 +22,8 @@ module SPARC.Instr ( where import BlockId -import Regs +import RegsBase +import SPARC.Regs import Cmm import Outputable import Constants ( wORD_SIZE ) @@ -183,6 +184,6 @@ fPair (RealReg n) fPair (VirtualRegD u) = Just (VirtualRegHi u) -fPair other - = trace ("MachInstrs.fPair: can't get high half of supposed double reg " ++ show other) +fPair _ + = trace ("MachInstrs.fPair: can't get high half of supposed double reg ") Nothing diff --git a/compiler/nativeGen/SPARC/RegInfo.hs b/compiler/nativeGen/SPARC/RegInfo.hs new file mode 100644 index 0000000..3d9614d --- /dev/null +++ b/compiler/nativeGen/SPARC/RegInfo.hs @@ -0,0 +1,339 @@ + +----------------------------------------------------------------------------- +-- +-- Machine-specific parts of the register allocator +-- +-- (c) The University of Glasgow 1996-2004 +-- +----------------------------------------------------------------------------- + +module SPARC.RegInfo ( + -- machine specific + RegUsage(..), + noUsage, + regUsage, + patchRegs, + jumpDests, + isJumpish, + patchJump, + isRegRegMove, + + JumpDest(..), + canShortcut, + shortcutJump, + + mkSpillInstr, + mkLoadInstr, + mkRegRegMoveInstr, + mkBranchInstr, + + spillSlotSize, + maxSpillSlots, + spillSlotToOffset +) + +where + + +#include "nativeGen/NCG.h" +#include "HsVersions.h" + +import BlockId +import Instrs +import Regs +import Outputable +import Constants ( rESERVED_C_STACK_BYTES ) +import FastBool + + +-- ----------------------------------------------------------------------------- +-- RegUsage type + +-- @regUsage@ returns the sets of src and destination registers used +-- by a particular instruction. Machine registers that are +-- pre-allocated to stgRegs are filtered out, because they are +-- uninteresting from a register allocation standpoint. (We wouldn't +-- want them to end up on the free list!) As far as we are concerned, +-- the fixed registers simply don't exist (for allocation purposes, +-- anyway). + +-- regUsage doesn't need to do any trickery for jumps and such. Just +-- state precisely the regs read and written by that insn. The +-- consequences of control flow transfers, as far as register +-- allocation goes, are taken care of by the register allocator. + +data RegUsage = RU [Reg] [Reg] + +noUsage :: RegUsage +noUsage = RU [] [] + +regUsage :: Instr -> RegUsage + +regUsage instr = case instr of + SPILL reg _ -> usage ([reg], []) + RELOAD _ reg -> usage ([], [reg]) + + LD _ addr reg -> usage (regAddr addr, [reg]) + ST _ reg addr -> usage (reg : regAddr addr, []) + ADD _ _ r1 ar r2 -> usage (r1 : regRI ar, [r2]) + SUB _ _ r1 ar r2 -> usage (r1 : regRI ar, [r2]) + UMUL _ r1 ar r2 -> usage (r1 : regRI ar, [r2]) + SMUL _ r1 ar r2 -> usage (r1 : regRI ar, [r2]) + UDIV _ r1 ar r2 -> usage (r1 : regRI ar, [r2]) + SDIV _ r1 ar r2 -> usage (r1 : regRI ar, [r2]) + RDY rd -> usage ([], [rd]) + WRY r1 r2 -> usage ([r1, r2], []) + AND _ r1 ar r2 -> usage (r1 : regRI ar, [r2]) + ANDN _ r1 ar r2 -> usage (r1 : regRI ar, [r2]) + OR _ r1 ar r2 -> usage (r1 : regRI ar, [r2]) + ORN _ r1 ar r2 -> usage (r1 : regRI ar, [r2]) + XOR _ r1 ar r2 -> usage (r1 : regRI ar, [r2]) + XNOR _ r1 ar r2 -> usage (r1 : regRI ar, [r2]) + SLL r1 ar r2 -> usage (r1 : regRI ar, [r2]) + SRL r1 ar r2 -> usage (r1 : regRI ar, [r2]) + SRA r1 ar r2 -> usage (r1 : regRI ar, [r2]) + SETHI _ reg -> usage ([], [reg]) + FABS _ r1 r2 -> usage ([r1], [r2]) + FADD _ r1 r2 r3 -> usage ([r1, r2], [r3]) + FCMP _ _ r1 r2 -> usage ([r1, r2], []) + FDIV _ r1 r2 r3 -> usage ([r1, r2], [r3]) + FMOV _ r1 r2 -> usage ([r1], [r2]) + FMUL _ r1 r2 r3 -> usage ([r1, r2], [r3]) + FNEG _ r1 r2 -> usage ([r1], [r2]) + FSQRT _ r1 r2 -> usage ([r1], [r2]) + FSUB _ r1 r2 r3 -> usage ([r1, r2], [r3]) + FxTOy _ _ r1 r2 -> usage ([r1], [r2]) + + JMP addr -> usage (regAddr addr, []) + JMP_TBL addr _ -> usage (regAddr addr, []) + + CALL (Left _ ) _ True -> noUsage + CALL (Left _ ) n False -> usage (argRegs n, callClobberedRegs) + CALL (Right reg) _ True -> usage ([reg], []) + CALL (Right reg) n False -> usage (reg : (argRegs n), callClobberedRegs) + + _ -> noUsage + where + usage (src, dst) = RU (filter interesting src) + (filter interesting dst) + + regAddr (AddrRegReg r1 r2) = [r1, r2] + regAddr (AddrRegImm r1 _) = [r1] + + regRI (RIReg r) = [r] + regRI _ = [] + + +interesting :: Reg -> Bool +interesting (VirtualRegI _) = True +interesting (VirtualRegHi _) = True +interesting (VirtualRegF _) = True +interesting (VirtualRegD _) = True +interesting (RealReg i) = isFastTrue (freeReg i) + + +-- ----------------------------------------------------------------------------- +-- 'patchRegs' function + +-- 'patchRegs' takes an instruction and applies the given mapping to +-- all the register references. + +patchRegs :: Instr -> (Reg -> Reg) -> Instr + +patchRegs instr env = case instr of + SPILL reg slot -> SPILL (env reg) slot + RELOAD slot reg -> RELOAD slot (env reg) + 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) + UMUL cc r1 ar r2 -> UMUL cc (env r1) (fixRI ar) (env r2) + SMUL cc r1 ar r2 -> SMUL cc (env r1) (fixRI ar) (env r2) + UDIV cc r1 ar r2 -> UDIV cc (env r1) (fixRI ar) (env r2) + SDIV cc r1 ar r2 -> SDIV cc (env r1) (fixRI ar) (env r2) + RDY rd -> RDY (env rd) + WRY r1 r2 -> WRY (env r1) (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) + JMP_TBL addr ids -> JMP_TBL (fixAddr addr) ids + + CALL (Left i) n t -> CALL (Left i) n t + CALL (Right r) n t -> CALL (Right (env r)) n t + _ -> instr + where + fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2) + fixAddr (AddrRegImm r1 i) = AddrRegImm (env r1) i + + fixRI (RIReg r) = RIReg (env r) + fixRI other = other + + +-- ----------------------------------------------------------------------------- +-- Determine the possible destinations from the current instruction. + +-- (we always assume that the next instruction is also a valid destination; +-- if this isn't the case then the jump should be at the end of the basic +-- block). + +jumpDests :: Instr -> [BlockId] -> [BlockId] +jumpDests insn acc + = case insn of + BI _ _ id -> id : acc + BF _ _ id -> id : acc + JMP_TBL _ ids -> ids ++ acc + _other -> acc + + +-- | Check whether a particular instruction is a jump, branch or call instruction (jumpish) +-- We can't just use jumpDests above because the jump might take its arg, +-- so the instr won't contain a blockid. +-- +isJumpish :: Instr -> Bool +isJumpish instr + = case instr of + BI{} -> True + BF{} -> True + JMP{} -> True + JMP_TBL{} -> True + CALL{} -> True + _ -> False + + +-- | Change the destination of this jump instruction +-- Used in joinToTargets in the linear allocator, when emitting fixup code +-- for join points. +patchJump :: Instr -> BlockId -> BlockId -> Instr +patchJump insn old new + = case insn of + BI cc annul id + | id == old -> BI cc annul new + + BF cc annul id + | id == old -> BF cc annul new + + _other -> insn + + +-- ----------------------------------------------------------------------------- +-- Detecting reg->reg moves + +-- The register allocator attempts to eliminate reg->reg moves whenever it can, +-- by assigning the src and dest temporaries to the same real register. + +isRegRegMove :: Instr -> Maybe (Reg,Reg) +isRegRegMove instr + = case instr of + ADD False False src (RIReg src2) dst + | g0 == src2 -> Just (src, dst) + + FMOV FF64 src dst -> Just (src, dst) + FMOV FF32 src dst -> Just (src, dst) + _ -> Nothing + + +data JumpDest = DestBlockId BlockId | DestImm Imm + +canShortcut :: Instr -> Maybe JumpDest +canShortcut _ = Nothing + +shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr +shortcutJump _ other = other + + + + +-- ----------------------------------------------------------------------------- +-- Generating spill instructions + +-- SPARC: spill below frame pointer leaving 2 words/spill +mkSpillInstr + :: Reg -- register to spill + -> Int -- current stack delta + -> Int -- spill slot to use + -> Instr + +mkSpillInstr reg _ slot + = let off = spillSlotToOffset slot + off_w = 1 + (off `div` 4) + sz = case regClass reg of + RcInteger -> II32 + RcFloat -> FF32 + RcDouble -> FF64 + + in ST sz reg (fpRel (negate off_w)) + + +mkLoadInstr + :: Reg -- register to load + -> Int -- current stack delta + -> Int -- spill slot to use + -> Instr + +mkLoadInstr reg _ slot + = let off = spillSlotToOffset slot + in let{off_w = 1 + (off `div` 4); + sz = case regClass reg of { + RcInteger -> II32; + RcFloat -> FF32; + RcDouble -> FF64}} + in LD sz (fpRel (- off_w)) reg + + +mkRegRegMoveInstr + :: Reg + -> Reg + -> Instr +mkRegRegMoveInstr src dst + = case regClass src of + RcInteger -> ADD False False src (RIReg g0) dst + RcDouble -> FMOV FF64 src dst + RcFloat -> FMOV FF32 src dst + + +mkBranchInstr + :: BlockId + -> [Instr] + +mkBranchInstr id = [BI ALWAYS False id, NOP] + + +spillSlotSize :: Int +spillSlotSize = 8 + +maxSpillSlots :: Int +maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1 + + +-- convert a spill slot number to a *byte* offset, with no sign: +-- decide on a per arch basis whether you are spilling above or below +-- the C stack pointer. +spillSlotToOffset :: Int -> Int +spillSlotToOffset slot + | slot >= 0 && slot < maxSpillSlots + = 64 + spillSlotSize * slot + + | otherwise + = pprPanic "spillSlotToOffset:" + ( text "invalid spill location: " <> int slot + $$ text "maxSpillSlots: " <> int maxSpillSlots) + diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index 544dc6b..68462d0 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -13,7 +13,8 @@ module X86.Instr where import BlockId -import Regs +import X86.Regs +import RegsBase import Cmm import FastString diff --git a/compiler/nativeGen/X86/RegInfo.hs b/compiler/nativeGen/X86/RegInfo.hs new file mode 100644 index 0000000..e47cc63 --- /dev/null +++ b/compiler/nativeGen/X86/RegInfo.hs @@ -0,0 +1,489 @@ + +module X86.RegInfo ( + RegUsage(..), + noUsage, + regUsage, + patchRegs, + jumpDests, + isJumpish, + patchJump, + isRegRegMove, + + JumpDest, + canShortcut, + shortcutJump, + + mkSpillInstr, + mkLoadInstr, + mkRegRegMoveInstr, + mkBranchInstr, + + spillSlotSize, + maxSpillSlots, + spillSlotToOffset +) + +where + +#include "nativeGen/NCG.h" +#include "HsVersions.h" + +import X86.Instr +import X86.Regs +import RegsBase + +import BlockId +import Outputable +import Constants ( rESERVED_C_STACK_BYTES ) +import FastBool + + +-- ----------------------------------------------------------------------------- +-- RegUsage type + +-- @regUsage@ returns the sets of src and destination registers used +-- by a particular instruction. Machine registers that are +-- pre-allocated to stgRegs are filtered out, because they are +-- uninteresting from a register allocation standpoint. (We wouldn't +-- want them to end up on the free list!) As far as we are concerned, +-- the fixed registers simply don't exist (for allocation purposes, +-- anyway). + +-- regUsage doesn't need to do any trickery for jumps and such. Just +-- state precisely the regs read and written by that insn. The +-- consequences of control flow transfers, as far as register +-- allocation goes, are taken care of by the register allocator. + +data RegUsage = RU [Reg] [Reg] + +noUsage :: RegUsage +noUsage = RU [] [] + + +regUsage :: Instr -> RegUsage +regUsage instr = case instr of + MOV _ src dst -> usageRW src dst + MOVZxL _ src dst -> usageRW src dst + MOVSxL _ src dst -> usageRW src dst + LEA _ src dst -> usageRW src dst + ADD _ src dst -> usageRM src dst + ADC _ src dst -> usageRM src dst + SUB _ src dst -> usageRM src dst + IMUL _ src dst -> usageRM src dst + IMUL2 _ src -> mkRU (eax:use_R src) [eax,edx] + MUL _ src dst -> usageRM src dst + DIV _ op -> mkRU (eax:edx:use_R op) [eax,edx] + IDIV _ op -> mkRU (eax:edx:use_R op) [eax,edx] + AND _ src dst -> usageRM src dst + OR _ src dst -> usageRM src dst + + XOR _ (OpReg src) (OpReg dst) + | src == dst -> mkRU [] [dst] + + XOR _ src dst -> usageRM src dst + NOT _ op -> usageM op + NEGI _ op -> usageM op + SHL _ imm dst -> usageRM imm dst + SAR _ imm dst -> usageRM imm dst + SHR _ imm dst -> usageRM imm dst + BT _ _ src -> mkRUR (use_R src) + + PUSH _ op -> mkRUR (use_R op) + POP _ op -> mkRU [] (def_W op) + TEST _ src dst -> mkRUR (use_R src ++ use_R dst) + CMP _ src dst -> mkRUR (use_R src ++ use_R dst) + SETCC _ op -> mkRU [] (def_W op) + JXX _ _ -> mkRU [] [] + JXX_GBL _ _ -> mkRU [] [] + JMP op -> mkRUR (use_R op) + JMP_TBL op _ -> mkRUR (use_R op) + CALL (Left _) params -> mkRU params callClobberedRegs + CALL (Right reg) params -> mkRU (reg:params) callClobberedRegs + CLTD _ -> mkRU [eax] [edx] + NOP -> mkRU [] [] + +#if i386_TARGET_ARCH + GMOV src dst -> mkRU [src] [dst] + GLD _ src dst -> mkRU (use_EA src) [dst] + GST _ src dst -> mkRUR (src : use_EA dst) + + GLDZ dst -> mkRU [] [dst] + GLD1 dst -> mkRU [] [dst] + + GFTOI src dst -> mkRU [src] [dst] + GDTOI src dst -> mkRU [src] [dst] + + GITOF src dst -> mkRU [src] [dst] + GITOD src dst -> mkRU [src] [dst] + + GADD _ s1 s2 dst -> mkRU [s1,s2] [dst] + GSUB _ s1 s2 dst -> mkRU [s1,s2] [dst] + GMUL _ s1 s2 dst -> mkRU [s1,s2] [dst] + GDIV _ s1 s2 dst -> mkRU [s1,s2] [dst] + + GCMP _ src1 src2 -> mkRUR [src1,src2] + GABS _ src dst -> mkRU [src] [dst] + GNEG _ src dst -> mkRU [src] [dst] + GSQRT _ src dst -> mkRU [src] [dst] + GSIN _ _ _ src dst -> mkRU [src] [dst] + GCOS _ _ _ src dst -> mkRU [src] [dst] + GTAN _ _ _ src dst -> mkRU [src] [dst] +#endif + +#if x86_64_TARGET_ARCH + CVTSS2SD src dst -> mkRU [src] [dst] + CVTSD2SS src dst -> mkRU [src] [dst] + CVTTSS2SIQ src dst -> mkRU (use_R src) [dst] + CVTTSD2SIQ src dst -> mkRU (use_R src) [dst] + CVTSI2SS src dst -> mkRU (use_R src) [dst] + CVTSI2SD src dst -> mkRU (use_R src) [dst] + FDIV _ src dst -> usageRM src dst +#endif + + FETCHGOT reg -> mkRU [] [reg] + FETCHPC reg -> mkRU [] [reg] + + COMMENT _ -> noUsage + DELTA _ -> noUsage + SPILL reg _ -> mkRU [reg] [] + RELOAD _ reg -> mkRU [] [reg] + + _other -> panic "regUsage: unrecognised instr" + + where + -- 2 operand form; first operand Read; second Written + usageRW :: Operand -> Operand -> RegUsage + usageRW op (OpReg reg) = mkRU (use_R op) [reg] + usageRW op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea) + usageRW _ _ = panic "X86.RegInfo.usageRW: no match" + + -- 2 operand form; first operand Read; second Modified + usageRM :: Operand -> Operand -> RegUsage + usageRM op (OpReg reg) = mkRU (use_R op ++ [reg]) [reg] + usageRM op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea) + usageRM _ _ = panic "X86.RegInfo.usageRM: no match" + + -- 1 operand form; operand Modified + usageM :: Operand -> RegUsage + usageM (OpReg reg) = mkRU [reg] [reg] + usageM (OpAddr ea) = mkRUR (use_EA ea) + usageM _ = panic "X86.RegInfo.usageM: no match" + + -- Registers defd when an operand is written. + def_W (OpReg reg) = [reg] + def_W (OpAddr _ ) = [] + def_W _ = panic "X86.RegInfo.def_W: no match" + + -- Registers used when an operand is read. + use_R (OpReg reg) = [reg] + use_R (OpImm _) = [] + use_R (OpAddr ea) = use_EA ea + + -- Registers used to compute an effective address. + use_EA (ImmAddr _ _) = [] + use_EA (AddrBaseIndex base index _) = + use_base base $! use_index index + where use_base (EABaseReg r) x = r : x + use_base _ x = x + use_index EAIndexNone = [] + use_index (EAIndex i _) = [i] + + mkRUR src = src' `seq` RU src' [] + where src' = filter interesting src + + mkRU src dst = src' `seq` dst' `seq` RU src' dst' + where src' = filter interesting src + dst' = filter interesting dst + +interesting :: Reg -> Bool +interesting (VirtualRegI _) = True +interesting (VirtualRegHi _) = True +interesting (VirtualRegF _) = True +interesting (VirtualRegD _) = True +interesting (RealReg i) = isFastTrue (freeReg i) + + + + +-- ----------------------------------------------------------------------------- +-- 'patchRegs' function + +-- 'patchRegs' takes an instruction and applies the given mapping to +-- all the register references. + +patchRegs :: Instr -> (Reg -> Reg) -> Instr +patchRegs instr env = case instr of + MOV sz src dst -> patch2 (MOV sz) src dst + MOVZxL sz src dst -> patch2 (MOVZxL sz) src dst + MOVSxL sz src dst -> patch2 (MOVSxL sz) src dst + LEA sz src dst -> patch2 (LEA sz) src dst + ADD sz src dst -> patch2 (ADD sz) src dst + ADC sz src dst -> patch2 (ADC sz) src dst + SUB sz src dst -> patch2 (SUB sz) src dst + IMUL sz src dst -> patch2 (IMUL sz) src dst + IMUL2 sz src -> patch1 (IMUL2 sz) src + MUL sz src dst -> patch2 (MUL sz) src dst + IDIV sz op -> patch1 (IDIV sz) op + DIV sz op -> patch1 (DIV sz) op + AND sz src dst -> patch2 (AND sz) src dst + OR sz src dst -> patch2 (OR sz) src dst + XOR sz src dst -> patch2 (XOR sz) src dst + NOT sz op -> patch1 (NOT sz) op + NEGI sz op -> patch1 (NEGI sz) op + SHL sz imm dst -> patch1 (SHL sz imm) dst + SAR sz imm dst -> patch1 (SAR sz imm) dst + SHR sz imm dst -> patch1 (SHR sz imm) dst + BT sz imm src -> patch1 (BT sz imm) src + TEST sz src dst -> patch2 (TEST sz) src dst + CMP sz src dst -> patch2 (CMP sz) src dst + PUSH sz op -> patch1 (PUSH sz) op + POP sz op -> patch1 (POP sz) op + SETCC cond op -> patch1 (SETCC cond) op + JMP op -> patch1 JMP op + JMP_TBL op ids -> patch1 JMP_TBL op $ ids + +#if i386_TARGET_ARCH + GMOV src dst -> GMOV (env src) (env dst) + GLD sz src dst -> GLD sz (lookupAddr src) (env dst) + GST sz src dst -> GST sz (env src) (lookupAddr dst) + + GLDZ dst -> GLDZ (env dst) + GLD1 dst -> GLD1 (env dst) + + GFTOI src dst -> GFTOI (env src) (env dst) + GDTOI src dst -> GDTOI (env src) (env dst) + + GITOF src dst -> GITOF (env src) (env dst) + GITOD src dst -> GITOD (env src) (env dst) + + GADD sz s1 s2 dst -> GADD sz (env s1) (env s2) (env dst) + GSUB sz s1 s2 dst -> GSUB sz (env s1) (env s2) (env dst) + GMUL sz s1 s2 dst -> GMUL sz (env s1) (env s2) (env dst) + GDIV sz s1 s2 dst -> GDIV sz (env s1) (env s2) (env dst) + + GCMP sz src1 src2 -> GCMP sz (env src1) (env src2) + GABS sz src dst -> GABS sz (env src) (env dst) + GNEG sz src dst -> GNEG sz (env src) (env dst) + GSQRT sz src dst -> GSQRT sz (env src) (env dst) + GSIN sz l1 l2 src dst -> GSIN sz l1 l2 (env src) (env dst) + GCOS sz l1 l2 src dst -> GCOS sz l1 l2 (env src) (env dst) + GTAN sz l1 l2 src dst -> GTAN sz l1 l2 (env src) (env dst) +#endif + +#if x86_64_TARGET_ARCH + CVTSS2SD src dst -> CVTSS2SD (env src) (env dst) + CVTSD2SS src dst -> CVTSD2SS (env src) (env dst) + CVTTSS2SIQ src dst -> CVTTSS2SIQ (patchOp src) (env dst) + CVTTSD2SIQ src dst -> CVTTSD2SIQ (patchOp src) (env dst) + CVTSI2SS src dst -> CVTSI2SS (patchOp src) (env dst) + CVTSI2SD src dst -> CVTSI2SD (patchOp src) (env dst) + FDIV sz src dst -> FDIV sz (patchOp src) (patchOp dst) +#endif + + CALL (Left _) _ -> instr + CALL (Right reg) p -> CALL (Right (env reg)) p + + FETCHGOT reg -> FETCHGOT (env reg) + FETCHPC reg -> FETCHPC (env reg) + + NOP -> instr + COMMENT _ -> instr + DELTA _ -> instr + SPILL reg slot -> SPILL (env reg) slot + RELOAD slot reg -> RELOAD slot (env reg) + + JXX _ _ -> instr + JXX_GBL _ _ -> instr + CLTD _ -> instr + + _other -> panic "patchRegs: unrecognised instr" + + where + patch1 insn op = insn $! patchOp op + patch2 insn src dst = (insn $! patchOp src) $! patchOp dst + + patchOp (OpReg reg) = OpReg $! env reg + patchOp (OpImm imm) = OpImm imm + patchOp (OpAddr ea) = OpAddr $! lookupAddr ea + + lookupAddr (ImmAddr imm off) = ImmAddr imm off + lookupAddr (AddrBaseIndex base index disp) + = ((AddrBaseIndex $! lookupBase base) $! lookupIndex index) disp + where + lookupBase EABaseNone = EABaseNone + lookupBase EABaseRip = EABaseRip + lookupBase (EABaseReg r) = EABaseReg (env r) + + lookupIndex EAIndexNone = EAIndexNone + lookupIndex (EAIndex r i) = EAIndex (env r) i + + +-- ----------------------------------------------------------------------------- +-- Determine the possible destinations from the current instruction. + +-- (we always assume that the next instruction is also a valid destination; +-- if this isn't the case then the jump should be at the end of the basic +-- block). + +jumpDests :: Instr -> [BlockId] -> [BlockId] +jumpDests insn acc + = case insn of + JXX _ id -> id : acc + JMP_TBL _ ids -> ids ++ acc + _ -> acc + + +isJumpish :: Instr -> Bool +isJumpish instr + = case instr of + JMP{} -> True + JXX{} -> True + JXX_GBL{} -> True + JMP_TBL{} -> True + CALL{} -> True + _ -> False + +-- | Change the destination of this jump instruction +-- Used in joinToTargets in the linear allocator, when emitting fixup code +-- for join points. +patchJump :: Instr -> BlockId -> BlockId -> Instr +patchJump insn old new + = case insn of + JXX cc id | id == old -> JXX cc new + JMP_TBL _ _ -> error "Cannot patch JMP_TBL" + _other -> insn + + +-- ----------------------------------------------------------------------------- +-- Detecting reg->reg moves + +-- The register allocator attempts to eliminate reg->reg moves whenever it can, +-- by assigning the src and dest temporaries to the same real register. + +isRegRegMove :: Instr -> Maybe (Reg,Reg) +isRegRegMove (MOV _ (OpReg r1) (OpReg r2)) = Just (r1,r2) +isRegRegMove _ = Nothing + + + +data JumpDest = DestBlockId BlockId | DestImm Imm + + +canShortcut :: Instr -> Maybe JumpDest +canShortcut (JXX ALWAYS id) = Just (DestBlockId id) +canShortcut (JMP (OpImm imm)) = Just (DestImm imm) +canShortcut _ = Nothing + + +shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr +shortcutJump fn insn@(JXX cc id) = + case fn id of + Nothing -> insn + Just (DestBlockId id') -> shortcutJump fn (JXX cc id') + Just (DestImm imm) -> shortcutJump fn (JXX_GBL cc imm) + +shortcutJump _ other = other + + + +-- ----------------------------------------------------------------------------- +-- Generating spill instructions + +mkSpillInstr + :: Reg -- register to spill + -> Int -- current stack delta + -> Int -- spill slot to use + -> Instr + +#if i386_TARGET_ARCH +mkSpillInstr reg delta slot + = let off = spillSlotToOffset slot + in + let off_w = (off-delta) `div` 4 + in case regClass reg of + RcInteger -> MOV II32 (OpReg reg) (OpAddr (spRel off_w)) + _ -> GST FF80 reg (spRel off_w) {- RcFloat/RcDouble -} + +#elif x86_64_TARGET_ARCH +mkSpillInstr reg delta slot + = let off = spillSlotToOffset slot + in + let off_w = (off-delta) `div` 8 + in case regClass reg of + RcInteger -> MOV II64 (OpReg reg) (OpAddr (spRel off_w)) + RcDouble -> MOV FF64 (OpReg reg) (OpAddr (spRel off_w)) + -- ToDo: will it work to always spill as a double? + -- does that cause a stall if the data was a float? +#else +mkSpillInstr _ _ _ + = panic "X86.RegInfo.mkSpillInstr: not defined for this architecture." +#endif + + +mkLoadInstr + :: Reg -- register to load + -> Int -- current stack delta + -> Int -- spill slot to use + -> Instr +#if i386_TARGET_ARCH +mkLoadInstr reg delta slot + = let off = spillSlotToOffset slot + in + let off_w = (off-delta) `div` 4 + in case regClass reg of { + RcInteger -> MOV II32 (OpAddr (spRel off_w)) (OpReg reg); + _ -> GLD FF80 (spRel off_w) reg} {- RcFloat/RcDouble -} +#elif x86_64_TARGET_ARCH +mkLoadInstr reg delta slot + = let off = spillSlotToOffset slot + in + let off_w = (off-delta) `div` 8 + in case regClass reg of + RcInteger -> MOV II64 (OpAddr (spRel off_w)) (OpReg reg) + _ -> MOV FF64 (OpAddr (spRel off_w)) (OpReg reg) +#else +mkLoadInstr _ _ _ + = panic "X86.RegInfo.mkLoadInstr: not defined for this architecture." +#endif + + + +mkRegRegMoveInstr + :: Reg + -> Reg + -> Instr +mkRegRegMoveInstr src dst + = case regClass src of + RcInteger -> MOV wordSize (OpReg src) (OpReg dst) +#if i386_TARGET_ARCH + RcDouble -> GMOV src dst +#else + RcDouble -> MOV FF64 (OpReg src) (OpReg dst) + RcFloat -> panic "X86.RegInfo.mkRegRegMoveInstr: no match" +#endif + + +mkBranchInstr + :: BlockId + -> [Instr] + +mkBranchInstr id = [JXX ALWAYS id] + + +spillSlotSize :: Int +spillSlotSize = IF_ARCH_i386(12, 8) + +maxSpillSlots :: Int +maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1 + +-- convert a spill slot number to a *byte* offset, with no sign: +-- decide on a per arch basis whether you are spilling above or below +-- the C stack pointer. +spillSlotToOffset :: Int -> Int +spillSlotToOffset slot + | slot >= 0 && slot < maxSpillSlots + = 64 + spillSlotSize * slot + | otherwise + = pprPanic "spillSlotToOffset:" + ( text "invalid spill location: " <> int slot + $$ text "maxSpillSlots: " <> int maxSpillSlots) diff --git a/compiler/nativeGen/X86/Regs.hs b/compiler/nativeGen/X86/Regs.hs index 3432090..411801b 100644 --- a/compiler/nativeGen/X86/Regs.hs +++ b/compiler/nativeGen/X86/Regs.hs @@ -31,23 +31,17 @@ module X86.Regs ( -- machine specific EABase(..), EAIndex(..), addrModeRegs, -#if i386_TARGET_ARCH - -- part of address mode. shared for both arches. eax, ebx, ecx, edx, esi, edi, ebp, esp, fake0, fake1, fake2, fake3, fake4, fake5, -#endif -#if x86_64_TARGET_ARCH - -- part of address mode. shared for both arches. - ripRel, - allFPArgRegs, - + rax, rbx, rcx, rdx, rsi, rdi, rbp, rsp, - eax, ebx, ecx, edx, esi, edi, ebp, esp, - r8, r9, r10, r11, r12, r13, r14, r15, + r8, r9, r10, r11, r12, r13, r14, r15, xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7, xmm8, xmm9, xmm10, xmm11, xmm12, xmm13, xmm14, xmm15, xmm, -#endif + + ripRel, + allFPArgRegs, -- horror show freeReg, @@ -384,9 +378,9 @@ regs. @regClass@ barfs if you give it a VirtualRegF, and mkVReg above should never generate them. -} -#if i386_TARGET_ARCH fake0, fake1, fake2, fake3, fake4, fake5, eax, ebx, ecx, edx, esp, ebp, esi, edi :: Reg + eax = RealReg 0 ebx = RealReg 1 ecx = RealReg 2 @@ -402,7 +396,6 @@ fake3 = RealReg 11 fake4 = RealReg 12 fake5 = RealReg 13 -#endif {- @@ -413,13 +406,6 @@ AMD x86_64 architecture: -} -#if x86_64_TARGET_ARCH -allFPArgRegs :: [Reg] -allFPArgRegs = map RealReg [xmm0 .. xmm7] - -ripRel imm = AddrBaseIndex EABaseRip EAIndexNone imm - - rax, rbx, rcx, rdx, rsp, rbp, rsi, rdi, r8, r9, r10, r11, r12, r13, r14, r15, xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7, @@ -458,7 +444,15 @@ xmm13 = RealReg 29 xmm14 = RealReg 30 xmm15 = RealReg 31 +allFPArgRegs :: [Reg] +allFPArgRegs = map RealReg [16 .. 23] + +ripRel :: Displacement -> AddrMode +ripRel imm = AddrBaseIndex EABaseRip EAIndexNone imm + + -- so we can re-use some x86 code: +{- eax = rax ebx = rbx ecx = rcx @@ -467,10 +461,11 @@ esi = rsi edi = rdi ebp = rbp esp = rsp +-} +xmm :: RegNo -> Reg xmm n = RealReg (16+n) -#endif -- 1.7.10.4