X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FX86%2FRegs.hs;h=87564b860c7e5098baee09b3b3224c25b20e1d1e;hb=b04a210e26ca57242fd052f2aa91011a80b76299;hp=3432090ff73975d591c60269b90660560ff18450;hpb=9de520b7194c9d759147db98deb3cd8d47d0de76;p=ghc-hetmet.git diff --git a/compiler/nativeGen/X86/Regs.hs b/compiler/nativeGen/X86/Regs.hs index 3432090..87564b8 100644 --- a/compiler/nativeGen/X86/Regs.hs +++ b/compiler/nativeGen/X86/Regs.hs @@ -1,15 +1,4 @@ module X86.Regs ( - - -- sizes - Size(..), - intSize, - floatSize, - isFloatSize, - wordSize, - cmmTypeSize, - sizeToWidth, - mkVReg, - -- immediates Imm(..), strImmLit, @@ -31,27 +20,24 @@ 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, - globalRegMaybe + globalRegMaybe, + + get_GlobalReg_reg_or_addr, + allocatableRegs ) where @@ -66,88 +52,21 @@ where #include "../includes/MachRegs.h" -import RegsBase +import Reg +import RegClass +import CgUtils ( get_GlobalReg_addr ) import BlockId import Cmm import CLabel ( CLabel ) import Pretty -import Outputable ( Outputable(..), pprPanic, panic ) +import Outputable ( panic ) import qualified Outputable -import Unique import FastBool --- ----------------------------------------------------------------------------- --- Sizes on this architecture --- --- A Size is usually a combination of width and class - --- It looks very like the old MachRep, but it's now of purely local --- significance, here in the native code generator. You can change it --- without global consequences. --- --- A major use is as an opcode qualifier; thus the opcode --- mov.l a b --- might be encoded --- MOV II32 a b --- where the Size field encodes the ".l" part. - --- ToDo: it's not clear to me that we need separate signed-vs-unsigned sizes --- here. I've removed them from the x86 version, we'll see what happens --SDM - --- ToDo: quite a few occurrences of Size could usefully be replaced by Width - -data Size - = II8 | II16 | II32 | II64 | FF32 | FF64 | FF80 - deriving Eq - -intSize, floatSize :: Width -> Size -intSize W8 = II8 -intSize W16 = II16 -intSize W32 = II32 -intSize W64 = II64 -intSize other = pprPanic "MachInstrs.intSize" (ppr other) - - -floatSize W32 = FF32 -floatSize W64 = FF64 -floatSize other = pprPanic "MachInstrs.intSize" (ppr other) - - -isFloatSize :: Size -> Bool -isFloatSize FF32 = True -isFloatSize FF64 = True -isFloatSize FF80 = True -isFloatSize _ = False - - -wordSize :: Size -wordSize = intSize wordWidth - - -cmmTypeSize :: CmmType -> Size -cmmTypeSize ty | isFloatType ty = floatSize (typeWidth ty) - | otherwise = intSize (typeWidth ty) - - -sizeToWidth :: Size -> Width -sizeToWidth II8 = W8 -sizeToWidth II16 = W16 -sizeToWidth II32 = W32 -sizeToWidth II64 = W64 -sizeToWidth FF32 = W32 -sizeToWidth FF64 = W64 -sizeToWidth _ = panic "MachInstrs.sizeToWidth" - - -mkVReg :: Unique -> Size -> Reg -mkVReg u size - | not (isFloatSize size) = VirtualRegI u - | otherwise - = case size of - FF32 -> VirtualRegD u - FF64 -> VirtualRegD u - _ -> panic "mkVReg" +#if defined(i386_TARGET_ARCH) || defined(x86_64_TARGET_ARCH) +import Constants +#endif -- ----------------------------------------------------------------------------- @@ -253,38 +172,6 @@ argRegs _ = panic "MachRegs.argRegs(x86): should not be used!" --- -allArgRegs :: [Reg] - -#if i386_TARGET_ARCH -allArgRegs = panic "X86.Regs.allArgRegs: should not be used!" - -#elif x86_64_TARGET_ARCH -allArgRegs = map RealReg [rdi,rsi,rdx,rcx,r8,r9] - -#else -allArgRegs = panic "X86.Regs.allArgRegs: not defined for this architecture" -#endif - - --- | these are the regs which we cannot assume stay alive over a C call. -callClobberedRegs :: [Reg] - -#if i386_TARGET_ARCH --- caller-saves registers -callClobberedRegs - = map RealReg [eax,ecx,edx,fake0,fake1,fake2,fake3,fake4,fake5] - -#elif x86_64_TARGET_ARCH --- all xmm regs are caller-saves --- caller-saves registers -callClobberedRegs - = map RealReg ([rax,rcx,rdx,rsi,rdi,r8,r9,r10,r11] ++ [16..31]) - -#else -callClobberedRegs - = panic "X86.Regs.callClobberedRegs: not defined for this architecture" -#endif -- | The complete set of machine registers. @@ -312,11 +199,10 @@ regClass :: Reg -> RegClass -- However, we can get away without this at the moment because the -- only allocatable integer regs are also 8-bit compatible (1, 3, 4). regClass (RealReg i) = if i < 8 then RcInteger else RcDouble -regClass (VirtualRegI u) = RcInteger -regClass (VirtualRegHi u) = RcInteger -regClass (VirtualRegD u) = RcDouble -regClass (VirtualRegF u) = pprPanic "regClass(x86):VirtualRegF" - (ppr (VirtualRegF u)) +regClass (VirtualRegI _) = RcInteger +regClass (VirtualRegHi _) = RcInteger +regClass (VirtualRegD _) = RcDouble +regClass (VirtualRegF u) = pprPanic ("regClass(x86):VirtualRegF") (ppr u) #elif x86_64_TARGET_ARCH -- On x86, we might want to have an 8-bit RegClass, which would @@ -324,11 +210,10 @@ regClass (VirtualRegF u) = pprPanic "regClass(x86):VirtualRegF" -- However, we can get away without this at the moment because the -- only allocatable integer regs are also 8-bit compatible (1, 3, 4). regClass (RealReg i) = if i < 16 then RcInteger else RcDouble -regClass (VirtualRegI u) = RcInteger -regClass (VirtualRegHi u) = RcInteger -regClass (VirtualRegD u) = RcDouble -regClass (VirtualRegF u) = pprPanic "regClass(x86_64):VirtualRegF" - (ppr (VirtualRegF u)) +regClass (VirtualRegI _) = RcInteger +regClass (VirtualRegHi _) = RcInteger +regClass (VirtualRegD _) = RcDouble +regClass (VirtualRegF u) = pprPanic "regClass(x86_64):VirtualRegF" (ppr u) #else regClass _ = panic "X86.Regs.regClass: not defined for this architecture" @@ -345,6 +230,7 @@ showReg n then regNames !! n else "%unknown_x86_real_reg_" ++ show n +regNames :: [String] regNames = ["%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "%ebp", "%esp", "%fake0", "%fake1", "%fake2", "%fake3", "%fake4", "%fake5", "%fake6"] @@ -355,6 +241,7 @@ showReg n | n >= 8 = "%r" ++ show n | otherwise = regNames !! n +regNames :: [String] regNames = ["%rax", "%rbx", "%rcx", "%rdx", "%rsi", "%rdi", "%rbp", "%rsp" ] @@ -384,9 +271,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 +289,6 @@ fake3 = RealReg 11 fake4 = RealReg 12 fake5 = RealReg 13 -#endif {- @@ -413,13 +299,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 +337,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,16 +354,19 @@ esi = rsi edi = rdi ebp = rbp esp = rsp +-} +xmm :: RegNo -> Reg xmm n = RealReg (16+n) -#endif -- horror show ----------------------------------------------------------------- -freeReg :: RegNo -> FastBool -globalRegMaybe :: GlobalReg -> Maybe Reg +freeReg :: RegNo -> FastBool +globalRegMaybe :: GlobalReg -> Maybe Reg +allArgRegs :: [Reg] +callClobberedRegs :: [Reg] #if defined(i386_TARGET_ARCH) || defined(x86_64_TARGET_ARCH) @@ -602,7 +492,7 @@ freeReg REG_Hp = fastBool False #ifdef REG_HpLim freeReg REG_HpLim = fastBool False #endif -freeReg n = fastBool True +freeReg _ = fastBool True -- | Returns 'Nothing' if this global register is not stored @@ -686,9 +576,70 @@ globalRegMaybe CurrentNursery = Just (RealReg REG_CurrentNursery) #endif globalRegMaybe _ = Nothing +-- + +#if i386_TARGET_ARCH +allArgRegs = panic "X86.Regs.allArgRegs: should not be used!" + +#elif x86_64_TARGET_ARCH +allArgRegs = map RealReg [rdi,rsi,rdx,rcx,r8,r9] + +#else +allArgRegs = panic "X86.Regs.allArgRegs: not defined for this architecture" +#endif + + +-- | these are the regs which we cannot assume stay alive over a C call. + +#if i386_TARGET_ARCH +-- caller-saves registers +callClobberedRegs + = map RealReg [eax,ecx,edx,fake0,fake1,fake2,fake3,fake4,fake5] + +#elif x86_64_TARGET_ARCH +-- all xmm regs are caller-saves +-- caller-saves registers +callClobberedRegs + = map RealReg ([rax,rcx,rdx,rsi,rdi,r8,r9,r10,r11] ++ [16..31]) + +#else +callClobberedRegs + = panic "X86.Regs.callClobberedRegs: not defined for this architecture" +#endif + #else /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */ + + freeReg _ = 0# globalRegMaybe _ = panic "X86.Regs.globalRegMaybe: not defined" +allArgRegs = panic "X86.Regs.globalRegMaybe: not defined" +callClobberedRegs = panic "X86.Regs.globalRegMaybe: not defined" + + #endif + +-- We map STG registers onto appropriate CmmExprs. Either they map +-- to real machine registers or stored as offsets from BaseReg. Given +-- a GlobalReg, get_GlobalReg_reg_or_addr produces either the real +-- register it is in, on this platform, or a CmmExpr denoting the +-- address in the register table holding it. +-- (See also get_GlobalReg_addr in CgUtils.) + +get_GlobalReg_reg_or_addr :: GlobalReg -> Either Reg CmmExpr +get_GlobalReg_reg_or_addr mid + = case globalRegMaybe mid of + Just rr -> Left rr + Nothing -> Right (get_GlobalReg_addr mid) + + +-- allocatableRegs is allMachRegNos with the fixed-use regs removed. +-- i.e., these are the regs for which we are prepared to allow the +-- register allocator to attempt to map VRegs to. +allocatableRegs :: [RegNo] +allocatableRegs + = let isFree i = isFastTrue (freeReg i) + in filter isFree allMachRegNos + +