Follow vreg/hreg patch in x86 NCG

parent f20b0d8a
......@@ -317,6 +317,9 @@ graphAddCoalesce (r1, r2) graph
| RegReal _ <- r1
, RegReal _ <- r2
= graph
graphAddCoalesce _ _
= panic "graphAddCoalesce: bogus"
-- | Patch registers in code using the reg -> reg mapping in this graph.
......
......@@ -6,6 +6,7 @@ where
import X86.Regs
import RegClass
import Reg
import Panic
import Data.Word
import Data.Bits
......@@ -17,26 +18,35 @@ type FreeRegs
noFreeRegs :: FreeRegs
noFreeRegs = 0
releaseReg :: RegNo -> FreeRegs -> FreeRegs
releaseReg n f = f .|. (1 `shiftL` n)
releaseReg :: RealReg -> FreeRegs -> FreeRegs
releaseReg (RealRegSingle n) f
= f .|. (1 `shiftL` n)
releaseReg _ _
= panic "RegAlloc.Linear.X86.FreeRegs.realeaseReg: no reg"
initFreeRegs :: FreeRegs
initFreeRegs = foldr releaseReg noFreeRegs allocatableRegs
initFreeRegs
= foldr releaseReg noFreeRegs allocatableRegs
getFreeRegs :: RegClass -> FreeRegs -> [RegNo] -- lazilly
getFreeRegs :: RegClass -> FreeRegs -> [RealReg] -- lazilly
getFreeRegs cls f = go f 0
where go 0 _ = []
go n m
| n .&. 1 /= 0 && regClass (regSingle m) == cls
= m : (go (n `shiftR` 1) $! (m+1))
| n .&. 1 /= 0 && classOfRealReg (RealRegSingle m) == cls
= RealRegSingle m : (go (n `shiftR` 1) $! (m+1))
| otherwise
= go (n `shiftR` 1) $! (m+1)
-- ToDo: there's no point looking through all the integer registers
-- in order to find a floating-point one.
allocateReg :: RegNo -> FreeRegs -> FreeRegs
allocateReg r f = f .&. complement (1 `shiftL` fromIntegral r)
allocateReg :: RealReg -> FreeRegs -> FreeRegs
allocateReg (RealRegSingle r) f
= f .&. complement (1 `shiftL` fromIntegral r)
allocateReg _ _
= panic "RegAlloc.Linear.X86.FreeRegs.allocateReg: no reg"
......@@ -299,7 +299,7 @@ globalRegMaybe _ = Nothing
freeReg :: RegNo -> FastBool
freeReg = error "SPARC.RegPlate.freeReg: not defined"
globalRegMaybe :: GlobalReg -> Maybe Reg
globalRegMaybe :: GlobalReg -> Maybe RealReg
globalRegMaybe = error "SPARC.RegPlate.globalRegMaybe: not defined"
#endif
......@@ -48,64 +48,39 @@ import qualified SPARC.Regs as SPARC
#error "RegAlloc.Graph.TargetReg: not defined"
#endif
targetVirtualRegSqueeze :: RegClass -> VirtualReg -> FastInt
targetRealRegSqueeze :: RegClass -> RealReg -> FastInt
targetClassOfRealReg :: RealReg -> RegClass
targetWordSize :: Size
targetMkVirtualReg :: Unique -> Size -> VirtualReg
targetRegDotColor :: RealReg -> SDoc
-- x86 -------------------------------------------------------------------------
#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
targetRegClasses :: Reg -> [RegClass]
targetRegClasses = X86.regClasses
targetRegSupportsClass :: Reg -> RegClass -> Bool
targetRegSupportsClass = X86.regSupportsClass
targetWordSize :: Size
targetWordSize = intSize wordWidth
targetMkVReg :: Unique -> Size -> Reg
targetMkVReg = X86.mkVReg
targetRegDotColor :: Reg -> SDoc
targetRegDotColor = X86.regDotColor
targetVirtualRegSqueeze = X86.virtualRegSqueeze
targetRealRegSqueeze = X86.realRegSqueeze
targetClassOfRealReg = X86.classOfRealReg
targetWordSize = intSize wordWidth
targetMkVirtualReg = X86.mkVirtualReg
targetRegDotColor = X86.regDotColor
-- ppc -------------------------------------------------------------------------
#elif powerpc_TARGET_ARCH
targetRegClasses :: Reg -> [RegClass]
targetRegClasses = PPC.regClasses
targetRegSupportsClass :: Reg -> RegClass -> Bool
targetRegSupportsClass = PPC.regSupportsClass
targetWordSize :: Size
targetWordSize = intSize wordWidth
targetMkVReg :: Unique -> Size -> Reg
targetMkVReg = PPC.mkVReg
targetRegDotColor :: Reg -> SDoc
targetRegDotColor = PPC.regDotColor
targetVirtualRegSqueeze = PPC.virtualRegSqueeze
targetRealRegSqueeze = PPC.realRegSqueeze
targetClassOfRealReg = PPC.classOfRealReg
targetWordSize = intSize wordWidth
targetMkVirtualReg = PPC.mkVirtualReg
targetRegDotColor = PPC.regDotColor
-- sparc -----------------------------------------------------------------------
#elif sparc_TARGET_ARCH
targetVirtualRegSqueeze :: RegClass -> VirtualReg -> FastInt
targetVirtualRegSqueeze = SPARC.virtualRegSqueeze
targetRealRegSqueeze :: RegClass -> RealReg -> FastInt
targetRealRegSqueeze = SPARC.realRegSqueeze
targetClassOfRealReg :: RealReg -> RegClass
targetClassOfRealReg = SPARC.classOfRealReg
-- | Size of a machine word.
-- This is big enough to hold a pointer.
targetWordSize :: Size
targetWordSize = intSize wordWidth
targetMkVirtualReg :: Unique -> Size -> VirtualReg
targetMkVirtualReg = SPARC.mkVirtualReg
targetRegDotColor :: RealReg -> SDoc
targetRegDotColor = SPARC.regDotColor
targetRealRegSqueeze = SPARC.realRegSqueeze
targetClassOfRealReg = SPARC.classOfRealReg
targetWordSize = intSize wordWidth
targetMkVirtualReg = SPARC.mkVirtualReg
targetRegDotColor = SPARC.regDotColor
--------------------------------------------------------------------------------
#else
......
......@@ -204,11 +204,11 @@ swizzleRegisterRep (Any _ codefn) size = Any size codefn
getRegisterReg :: CmmReg -> Reg
getRegisterReg (CmmLocal (LocalReg u pk))
= mkVReg u (cmmTypeSize pk)
= RegVirtual $ mkVirtualReg u (cmmTypeSize pk)
getRegisterReg (CmmGlobal mid)
= case get_GlobalReg_reg_or_addr mid of
Left reg@(RegReal _) -> reg
Left reg -> RegReal $ reg
_other -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
-- By this stage, the only MagicIds remaining should be the
-- ones which map to a real machine register on this
......@@ -300,7 +300,7 @@ assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock
assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
let
r_dst_lo = mkVReg u_dst II32
r_dst_lo = RegVirtual $ mkVirtualReg u_dst II32
r_dst_hi = getHiVRegFromLo r_dst_lo
r_src_hi = getHiVRegFromLo r_src_lo
mov_lo = MOV II32 (OpReg r_src_lo) (OpReg r_dst_lo)
......@@ -342,7 +342,7 @@ iselExpr64 (CmmLoad addrTree ty) | isWord64 ty = do
)
iselExpr64 (CmmReg (CmmLocal (LocalReg vu ty))) | isWord64 ty
= return (ChildCode64 nilOL (mkVReg vu II32))
= return (ChildCode64 nilOL (RegVirtual $ mkVirtualReg vu II32))
-- we handle addition, but rather badly
iselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)]) = do
......
......@@ -18,6 +18,7 @@ import Instruction
import Size
import RegClass
import Reg
import TargetReg
import BlockId
import Cmm
......@@ -605,7 +606,7 @@ x86_mkSpillInstr reg delta slot
= let off = spillSlotToOffset slot
in
let off_w = (off-delta) `div` 4
in case regClass reg of
in case targetClassOfReg reg of
RcInteger -> MOV II32 (OpReg reg) (OpAddr (spRel off_w))
_ -> GST FF80 reg (spRel off_w) {- RcFloat/RcDouble -}
......@@ -614,7 +615,7 @@ x86_mkSpillInstr reg delta slot
= let off = spillSlotToOffset slot
in
let off_w = (off-delta) `div` 8
in case regClass reg of
in case targetClassOfReg reg of
RcInteger -> MOV II64 (OpReg reg) (OpAddr (spRel off_w))
RcDouble -> MOV FF64 (OpReg reg) (OpAddr (spRel off_w))
_ -> panic "X86.mkSpillInstr: no match"
......@@ -638,7 +639,7 @@ x86_mkLoadInstr reg delta slot
= let off = spillSlotToOffset slot
in
let off_w = (off-delta) `div` 4
in case regClass reg of {
in case targetClassOfReg reg of {
RcInteger -> MOV II32 (OpAddr (spRel off_w)) (OpReg reg);
_ -> GLD FF80 (spRel off_w) reg} {- RcFloat/RcDouble -}
#elif x86_64_TARGET_ARCH
......@@ -646,7 +647,7 @@ x86_mkLoadInstr reg delta slot
= let off = spillSlotToOffset slot
in
let off_w = (off-delta) `div` 8
in case regClass reg of
in case targetClassOfReg reg of
RcInteger -> MOV II64 (OpAddr (spRel off_w)) (OpReg reg)
_ -> MOV FF64 (OpAddr (spRel off_w)) (OpReg reg)
#else
......@@ -710,7 +711,7 @@ x86_mkRegRegMoveInstr
-> Instr
x86_mkRegRegMoveInstr src dst
= case regClass src of
= case targetClassOfReg src of
#if i386_TARGET_ARCH
RcInteger -> MOV II32 (OpReg src) (OpReg dst)
RcDouble -> GMOV src dst
......@@ -793,3 +794,51 @@ is_G_instr instr
GTAN{} -> True
GFREE -> panic "is_G_instr: GFREE (!)"
_ -> False
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
-- The helper ensures that we don't follow cycles.
shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
shortcutJump fn insn = shortcutJump' fn emptyBlockSet insn
where shortcutJump' fn seen insn@(JXX cc id) =
if elemBlockSet id seen then insn
else case fn id of
Nothing -> insn
Just (DestBlockId id') -> shortcutJump' fn seen' (JXX cc id')
Just (DestImm imm) -> shortcutJump' fn seen' (JXX_GBL cc imm)
where seen' = extendBlockSet seen id
shortcutJump' _ _ other = other
-- Here because it knows about JumpDest
shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
shortcutStatic fn (CmmStaticLit (CmmLabel lab))
| Just uq <- maybeAsmTemp lab
= CmmStaticLit (CmmLabel (shortBlockId fn (BlockId uq)))
shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off))
| Just uq <- maybeAsmTemp lbl1
= CmmStaticLit (CmmLabelDiffOff (shortBlockId fn (BlockId uq)) lbl2 off)
-- slightly dodgy, we're ignoring the second label, but this
-- works with the way we use CmmLabelDiffOff for jump tables now.
shortcutStatic _ other_static
= other_static
shortBlockId
:: (BlockId -> Maybe JumpDest)
-> BlockId
-> CLabel
shortBlockId fn blockid@(BlockId uq) =
case fn blockid of
Nothing -> mkAsmTempLabel uq
Just (DestBlockId blockid') -> shortBlockId fn blockid'
Just (DestImm (ImmCLbl lbl)) -> lbl
_other -> panic "shortBlockId"
module X86.RegInfo (
mkVReg,
JumpDest,
canShortcut,
shortcutJump,
shortcutStatic,
mkVirtualReg,
regDotColor
)
......@@ -15,15 +9,10 @@ where
#include "nativeGen/NCG.h"
#include "HsVersions.h"
import X86.Instr
import X86.Cond
import X86.Regs
import Size
import Reg
import Cmm
import CLabel
import BlockId
import Outputable
import Unique
......@@ -32,69 +21,19 @@ import UniqFM
#endif
mkVReg :: Unique -> Size -> Reg
mkVReg u size
| not (isFloatSize size) = RegVirtual (VirtualRegI u)
mkVirtualReg :: Unique -> Size -> VirtualReg
mkVirtualReg u size
| not (isFloatSize size) = VirtualRegI u
| otherwise
= case size of
FF32 -> RegVirtual (VirtualRegD u)
FF64 -> RegVirtual (VirtualRegD u)
_ -> panic "mkVReg"
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
-- The helper ensures that we don't follow cycles.
shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
shortcutJump fn insn = shortcutJump' fn emptyBlockSet insn
where shortcutJump' fn seen insn@(JXX cc id) =
if elemBlockSet id seen then insn
else case fn id of
Nothing -> insn
Just (DestBlockId id') -> shortcutJump' fn seen' (JXX cc id')
Just (DestImm imm) -> shortcutJump' fn seen' (JXX_GBL cc imm)
where seen' = extendBlockSet seen id
shortcutJump' _ _ other = other
-- Here because it knows about JumpDest
shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
shortcutStatic fn (CmmStaticLit (CmmLabel lab))
| Just uq <- maybeAsmTemp lab
= CmmStaticLit (CmmLabel (shortBlockId fn (BlockId uq)))
shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off))
| Just uq <- maybeAsmTemp lbl1
= CmmStaticLit (CmmLabelDiffOff (shortBlockId fn (BlockId uq)) lbl2 off)
-- slightly dodgy, we're ignoring the second label, but this
-- works with the way we use CmmLabelDiffOff for jump tables now.
shortcutStatic _ other_static
= other_static
shortBlockId
:: (BlockId -> Maybe JumpDest)
-> BlockId
-> CLabel
shortBlockId fn blockid@(BlockId uq) =
case fn blockid of
Nothing -> mkAsmTempLabel uq
Just (DestBlockId blockid') -> shortBlockId fn blockid'
Just (DestImm (ImmCLbl lbl)) -> lbl
_other -> panic "shortBlockId"
FF32 -> VirtualRegD u
FF64 -> VirtualRegD u
_ -> panic "mkVirtualReg"
-- reg colors for x86
#if i386_TARGET_ARCH
regDotColor :: Reg -> SDoc
regDotColor :: RealReg -> SDoc
regDotColor reg
= let Just str = lookupUFM regColors reg
in text str
......@@ -117,7 +56,7 @@ regColors
-- reg colors for x86_64
#elif x86_64_TARGET_ARCH
regDotColor :: Reg -> SDoc
regDotColor :: RealReg -> SDoc
regDotColor reg
= let Just str = lookupUFM regColors reg
in text str
......
module X86.Regs (
-- squeese functions for the graph allocator
virtualRegSqueeze,
realRegSqueeze,
-- immediates
Imm(..),
strImmLit,
......@@ -14,7 +18,7 @@ module X86.Regs (
allArgRegs,
callClobberedRegs,
allMachRegNos,
regClass,
classOfRealReg,
showReg,
-- machine specific
......@@ -62,14 +66,117 @@ import CLabel ( CLabel )
import Pretty
import Outputable ( panic )
import qualified Outputable
import FastTypes
import FastBool
#if defined(i386_TARGET_ARCH) || defined(x86_64_TARGET_ARCH)
import Constants
import Outputable (ppr, pprPanic)
#endif
-- | regSqueeze_class reg
-- Calculuate the maximum number of register colors that could be
-- denied to a node of this class due to having this reg
-- as a neighbour.
--
{-# INLINE virtualRegSqueeze #-}
virtualRegSqueeze :: RegClass -> VirtualReg -> FastInt
virtualRegSqueeze cls vr
= case cls of
RcInteger
-> case vr of
VirtualRegI{} -> _ILIT(1)
VirtualRegHi{} -> _ILIT(1)
VirtualRegD{} -> _ILIT(0)
VirtualRegF{} -> _ILIT(0)
-- We don't use floats on this arch, but we can't
-- return error because the return type is unboxed...
RcFloat
-> case vr of
VirtualRegI{} -> _ILIT(0)
VirtualRegHi{} -> _ILIT(0)
VirtualRegD{} -> _ILIT(0)
VirtualRegF{} -> _ILIT(0)
RcDouble
-> case vr of
VirtualRegI{} -> _ILIT(0)
VirtualRegHi{} -> _ILIT(0)
VirtualRegD{} -> _ILIT(1)
VirtualRegF{} -> _ILIT(0)
#if defined(i386_TARGET_ARCH)
{-# INLINE realRegSqueeze #-}
realRegSqueeze :: RegClass -> RealReg -> FastInt
realRegSqueeze cls rr
= case cls of
RcInteger
-> case rr of
RealRegSingle regNo
| regNo < 8 -> _ILIT(1) -- first fp reg is 8
| otherwise -> _ILIT(0)
RealRegPair{} -> _ILIT(0)
-- We don't use floats on this arch, but we can't
-- return error because the return type is unboxed...
RcFloat
-> case rr of
RealRegSingle regNo
| regNo < 8 -> _ILIT(0)
| otherwise -> _ILIT(0)
RealRegPair{} -> _ILIT(0)
RcDouble
-> case rr of
RealRegSingle regNo
| regNo < 8 -> _ILIT(0)
| otherwise -> _ILIT(1)
RealRegPair{} -> _ILIT(0)
#elif defined(x86_64_TARGET_ARCH)
realRegSqueeze cls rr
= case cls of
RcInteger
-> case rr of
RealRegSingle regNo
| regNo < 16 -> _ILIT(1) -- first xmm reg is 16
| otherwise -> _ILIT(0)
RealRegPair{} -> _ILIT(0)
-- We don't use floats on this arch, but we can't
-- return error because the return type is unboxed...
RcFloat
-> case rr of
RealRegSingle regNo
| regNo < 16 -> _ILIT(0)
| otherwise -> _ILIT(0)
RealRegPair{} -> _ILIT(0)
RcDouble
-> case rr of
RealRegSingle regNo
| regNo < 16 -> _ILIT(0)
| otherwise -> _ILIT(1)
RealRegPair{} -> _ILIT(0)
#else
realRegSqueeze = _ILIT(0)
#endif
-- -----------------------------------------------------------------------------
-- Immediates
......@@ -191,33 +298,31 @@ allMachRegNos = panic "X86.Regs.callClobberedRegs: not defined for this architec
-- | Take the class of a register.
{-# INLINE regClass #-}
regClass :: Reg -> RegClass
{-# INLINE classOfRealReg #-}
classOfRealReg :: RealReg -> RegClass
#if i386_TARGET_ARCH
-- On x86, we might want to have an 8-bit RegClass, which would
-- contain just regs 1-4 (the others don't have 8-bit versions).
-- 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 _) = RcInteger
regClass (VirtualRegHi _) = RcInteger
regClass (VirtualRegD _) = RcDouble
regClass (VirtualRegF u) = pprPanic ("regClass(x86):VirtualRegF") (ppr u)
classOfRealReg reg
= case reg of
RealRegSingle i -> if i < 8 then RcInteger else RcDouble
RealRegPair{} -> panic "X86.Regs.classOfRealReg: RegPairs on this arch"
#elif x86_64_TARGET_ARCH
-- On x86, we might want to have an 8-bit RegClass, which would
-- contain just regs 1-4 (the others don't have 8-bit versions).
-- 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 _) = RcInteger
regClass (VirtualRegHi _) = RcInteger
regClass (VirtualRegD _) = RcDouble
regClass (VirtualRegF u) = pprPanic "regClass(x86_64):VirtualRegF" (ppr u)
classOfRealReg reg
= case reg of
RealRegSingle i -> if i < 16 then RcInteger else RcDouble
RealRegPair{} -> panic "X86.Regs.classOfRealReg: RegPairs on this arch"
#else
regClass _ = panic "X86.Regs.regClass: not defined for this architecture"
classOfRealReg _ = panic "X86.Regs.regClass: not defined for this architecture"
#endif
......@@ -365,7 +470,7 @@ xmm n = regSingle (16+n)
-- horror show -----------------------------------------------------------------
freeReg :: RegNo -> FastBool
globalRegMaybe :: GlobalReg -> Maybe Reg
globalRegMaybe :: GlobalReg -> Maybe RealReg
allArgRegs :: [Reg]
callClobberedRegs :: [Reg]
......@@ -501,79 +606,79 @@ freeReg _ = fastBool True
-- reg is the machine register it is stored in.
#ifdef REG_Base
globalRegMaybe BaseReg = Just (regSingle REG_Base)
globalRegMaybe BaseReg = Just (RealRegSingle REG_Base)
#endif
#ifdef REG_R1
globalRegMaybe (VanillaReg 1 _) = Just (regSingle REG_R1)
globalRegMaybe (VanillaReg 1 _) = Just (RealRegSingle REG_R1)
#endif
#ifdef REG_R2
globalRegMaybe (VanillaReg 2 _) = Just (regSingle REG_R2)
globalRegMaybe (VanillaReg 2 _) = Just (RealRegSingle REG_R2)
#endif
#ifdef REG_R3
globalRegMaybe (VanillaReg 3 _) = Just (regSingle REG_R3)
globalRegMaybe (VanillaReg 3 _) = Just (RealRegSingle REG_R3)
#endif
#ifdef REG_R4
globalRegMaybe (VanillaReg 4 _) = Just (regSingle REG_R4)
globalRegMaybe (VanillaReg 4 _) = Just (RealRegSingle REG_R4)
#endif
#ifdef REG_R5
globalRegMaybe (VanillaReg 5 _) = Just (regSingle REG_R5)
globalRegMaybe (VanillaReg 5 _) = Just (RealRegSingle REG_R5)
#endif
#ifdef REG_R6
globalRegMaybe (VanillaReg 6 _) = Just (regSingle REG_R6)
globalRegMaybe (VanillaReg 6 _) = Just (RealRegSingle REG_R6)
#endif
#ifdef REG_R7
globalRegMaybe (VanillaReg 7 _) = Just (regSingle REG_R7)
globalRegMaybe (VanillaReg 7 _) = Just (RealRegSingle REG_R7)
#endif
#ifdef REG_R8
globalRegMaybe (VanillaReg 8 _) = Just (regSingle REG_R8)
globalRegMaybe (VanillaReg 8 _) = Just (RealRegSingle REG_R8)
#endif