X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FMachRegs.lhs;h=9c80423ff26e45ad5cd887bb2bac4c1c6ba905d3;hb=8480018a7f5f1cd961f3bd8ae758cc01910d5e6a;hp=2205ce0218dae7c76b576400a2fd534a9cf02b76;hpb=5d7e13eab7070d6858f6b8ff572baed572967fe2;p=ghc-hetmet.git diff --git a/compiler/nativeGen/MachRegs.lhs b/compiler/nativeGen/MachRegs.lhs index 2205ce0..9c80423 100644 --- a/compiler/nativeGen/MachRegs.lhs +++ b/compiler/nativeGen/MachRegs.lhs @@ -24,6 +24,10 @@ module MachRegs ( + -- * Sizes + Size(..), intSize, floatSize, isFloatSize, + wordSize, cmmTypeSize, sizeToWidth, + -- * Immediate values Imm(..), strImmLit, litToImm, @@ -70,7 +74,7 @@ module MachRegs ( addrModeRegs, allFPArgRegs, #endif #if sparc_TARGET_ARCH - fits13Bits, + fits13Bits, fpRel, gReg, iReg, lReg, oReg, largeOffsetError, fp, sp, g0, g1, g2, o0, o1, f0, f6, f8, f26, f27, #endif @@ -92,10 +96,9 @@ module MachRegs ( #include "../includes/MachRegs.h" +import BlockId import Cmm -import MachOp ( MachRep(..) ) import CgUtils ( get_GlobalReg_addr ) - import CLabel ( CLabel, mkMainCapabilityLabel ) import Pretty import Outputable ( Outputable(..), pprPanic, panic ) @@ -104,16 +107,144 @@ import Unique import UniqSet import Constants import FastTypes +import FastBool import UniqFM -import GHC.Exts - #if powerpc_TARGET_ARCH import Data.Word ( Word8, Word16, Word32 ) import Data.Int ( Int8, Int16, Int32 ) #endif -- ----------------------------------------------------------------------------- +-- 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 + +#if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH +data Size -- For these three, the "size" also gives the int/float + -- distinction, because the instructions for int/float + -- differ only in their suffices + = 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) + +wordSize :: Size +wordSize = intSize wordWidth + +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" + +cmmTypeSize :: CmmType -> Size +cmmTypeSize ty | isFloatType ty = floatSize (typeWidth ty) + | otherwise = intSize (typeWidth ty) + +isFloatSize :: Size -> Bool +isFloatSize FF32 = True +isFloatSize FF64 = True +isFloatSize FF80 = True +isFloatSize other = False +#endif + +#if alpha_TARGET_ARCH +data Size + = B -- byte + | Bu +-- | W -- word (2 bytes): UNUSED +-- | Wu -- : UNUSED + | L -- longword (4 bytes) + | Q -- quadword (8 bytes) +-- | FF -- VAX F-style floating pt: UNUSED +-- | GF -- VAX G-style floating pt: UNUSED +-- | DF -- VAX D-style floating pt: UNUSED +-- | SF -- IEEE single-precision floating pt: UNUSED + | TF -- IEEE double-precision floating pt + deriving Eq +#endif + +#if sparc_TARGET_ARCH /* || powerpc_TARGET_ARCH */ +data Size + = II8 -- byte (signed) +-- | II8u -- byte (unsigned) + | II16 -- halfword (signed, 2 bytes) +-- | II16u -- halfword (unsigned, 2 bytes) + | II32 -- word (4 bytes) + | II64 -- word (8 bytes) + | FF32 -- IEEE single-precision floating pt + | FF64 -- IEEE single-precision floating pt + deriving Eq + + +intSize, floatSize :: Width -> Size +intSize W8 = II8 +--intSize W16 = II16u +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) + +wordSize :: Size +wordSize = intSize wordWidth + +isFloatSize :: Size -> Bool +isFloatSize FF32 = True +isFloatSize FF64 = True +isFloatSize _ = False + +cmmTypeSize :: CmmType -> Size +cmmTypeSize ty | isFloatType ty = floatSize (typeWidth ty) + | otherwise = intSize (typeWidth ty) + +sizeToWidth :: Size -> Width +sizeToWidth size + = case size of + II8 -> W8 +-- II8u -> W8 + II16 -> W16 +-- II16u -> W16 + II32 -> W32 + II64 -> W64 + FF32 -> W32 + FF64 -> W64 + + +#endif + +-- ----------------------------------------------------------------------------- -- Immediates data Imm @@ -138,15 +269,19 @@ data Imm strImmLit s = ImmLit (text s) litToImm :: CmmLit -> Imm -litToImm (CmmInt i _) = ImmInteger i -litToImm (CmmFloat f F32) = ImmFloat f -litToImm (CmmFloat f F64) = ImmDouble f +litToImm (CmmInt i w) = ImmInteger (narrowS w i) + -- narrow to the width: a CmmInt might be out of + -- range, but we assume that ImmInteger only contains + -- in-range values. A signed value should be fine here. +litToImm (CmmFloat f W32) = ImmFloat f +litToImm (CmmFloat f W64) = ImmDouble f litToImm (CmmLabel l) = ImmCLbl l litToImm (CmmLabelOff l off) = ImmIndex l off litToImm (CmmLabelDiffOff l1 l2 off) = ImmConstantSum (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2)) (ImmInt off) +litToImm (CmmBlock id) = ImmCLbl (infoTblLbl id) -- ----------------------------------------------------------------------------- -- Addressing modes @@ -266,23 +401,22 @@ largeOffsetError i fits16Bits :: Integral a => a -> Bool fits16Bits x = x >= -32768 && x < 32768 -makeImmediate :: Integral a => MachRep -> Bool -> a -> Maybe Imm - +makeImmediate :: Integral a => Width -> Bool -> a -> Maybe Imm makeImmediate rep signed x = fmap ImmInt (toI16 rep signed) where - narrow I32 False = fromIntegral (fromIntegral x :: Word32) - narrow I16 False = fromIntegral (fromIntegral x :: Word16) - narrow I8 False = fromIntegral (fromIntegral x :: Word8) - narrow I32 True = fromIntegral (fromIntegral x :: Int32) - narrow I16 True = fromIntegral (fromIntegral x :: Int16) - narrow I8 True = fromIntegral (fromIntegral x :: Int8) + narrow W32 False = fromIntegral (fromIntegral x :: Word32) + narrow W16 False = fromIntegral (fromIntegral x :: Word16) + narrow W8 False = fromIntegral (fromIntegral x :: Word8) + narrow W32 True = fromIntegral (fromIntegral x :: Int32) + narrow W16 True = fromIntegral (fromIntegral x :: Int16) + narrow W8 True = fromIntegral (fromIntegral x :: Int8) narrowed = narrow rep signed - toI16 I32 True + toI16 W32 True | narrowed >= -32768 && narrowed < 32768 = Just narrowed | otherwise = Nothing - toI16 I32 False + toI16 W32 False | narrowed >= 0 && narrowed < 65536 = Just narrowed | otherwise = Nothing toI16 _ _ = Just narrowed @@ -393,16 +527,19 @@ instance Uniquable Reg where unRealReg (RealReg i) = i unRealReg vreg = pprPanic "unRealReg on VirtualReg" (ppr vreg) -mkVReg :: Unique -> MachRep -> Reg -mkVReg u rep - = case rep of +mkVReg :: Unique -> Size -> Reg +mkVReg u size + | not (isFloatSize size) = VirtualRegI u + | otherwise + = case size of #if sparc_TARGET_ARCH - F32 -> VirtualRegF u + FF32 -> VirtualRegF u + FF64 -> VirtualRegD u #else - F32 -> VirtualRegD u + FF32 -> VirtualRegD u + FF64 -> VirtualRegD u #endif - F64 -> VirtualRegD u - other -> VirtualRegI u + _other -> panic "mkVReg" isVirtualReg :: Reg -> Bool isVirtualReg (RealReg _) = False @@ -503,18 +640,23 @@ worst n classN classC -- Compare MachRegs.freeRegs and MachRegs.h to get these numbers. -- #if i386_TARGET_ARCH -#define ALLOCATABLE_REGS_INTEGER 3# -#define ALLOCATABLE_REGS_DOUBLE 6# -#endif +#define ALLOCATABLE_REGS_INTEGER (_ILIT(3)) +#define ALLOCATABLE_REGS_DOUBLE (_ILIT(6)) -#if x86_64_TARGET_ARCH -#define ALLOCATABLE_REGS_INTEGER 5# -#define ALLOCATABLE_REGS_DOUBLE 2# -#endif +#elif x86_64_TARGET_ARCH +#define ALLOCATABLE_REGS_INTEGER (_ILIT(5)) +#define ALLOCATABLE_REGS_DOUBLE (_ILIT(2)) -#if powerpc_TARGET_ARCH -#define ALLOCATABLE_REGS_INTEGER 16# -#define ALLOCATABLE_REGS_DOUBLE 26# +#elif powerpc_TARGET_ARCH +#define ALLOCATABLE_REGS_INTEGER (_ILIT(16)) +#define ALLOCATABLE_REGS_DOUBLE (_ILIT(26)) + +#elif sparc_TARGET_ARCH +#define ALLOCATABLE_REGS_INTEGER (_ILIT(3)) +#define ALLOCATABLE_REGS_DOUBLE (_ILIT(6)) + +#else +#error ToDo: define ALLOCATABLE_REGS_INTEGER and ALLOCATABLE_REGS_DOUBLE #endif {-# INLINE regClass #-} @@ -522,7 +664,6 @@ trivColorable :: RegClass -> UniqSet Reg -> UniqSet Reg -> Bool trivColorable classN conflicts exclusions = {-# SCC "trivColorable" #-} let - {-# INLINE isSqueesed #-} isSqueesed cI cF ufm = case ufm of NodeUFM _ _ left right @@ -535,17 +676,17 @@ trivColorable classN conflicts exclusions LeafUFM _ reg -> case regClass reg of RcInteger - -> case cI +# 1# of + -> case cI +# _ILIT(1) of cI' -> (# cI' >=# ALLOCATABLE_REGS_INTEGER, cI', cF #) RcDouble - -> case cF +# 1# of + -> case cF +# _ILIT(1) of cF' -> (# cF' >=# ALLOCATABLE_REGS_DOUBLE, cI, cF' #) EmptyUFM -> (# False, cI, cF #) - in case isSqueesed 0# 0# conflicts of + in case isSqueesed (_ILIT(0)) (_ILIT(0)) conflicts of (# False, cI', cF' #) -> case isSqueesed cI' cF' exclusions of (# s, _, _ #) -> not s @@ -1265,6 +1406,7 @@ freeReg rsp = fastBool False -- %rsp is the C stack pointer #if sparc_TARGET_ARCH freeReg g0 = fastBool False -- %g0 is always 0. + freeReg g5 = fastBool False -- %g5 is reserved (ABI). freeReg g6 = fastBool False -- %g6 is reserved (ABI). freeReg g7 = fastBool False -- %g7 is reserved (ABI). @@ -1274,6 +1416,19 @@ freeReg o6 = fastBool False -- %o6 is our stack pointer. freeReg o7 = fastBool False -- %o7 holds ret addrs (???) freeReg f0 = fastBool False -- %f0/%f1 are the C fp return registers. freeReg f1 = fastBool False + +-- TODO: Not sure about these BL 2009/01/10 +-- Used for NCG spill tmps? what is this? + +{- +freeReg g1 = fastBool False -- %g1 is used for NCG spill tmp +freeReg g2 = fastBool False +freeReg f6 = fastBool False +freeReg f8 = fastBool False +freeReg f26 = fastBool False +freeReg f27 = fastBool False +-} + #endif #if powerpc_TARGET_ARCH @@ -1358,34 +1513,34 @@ globalRegMaybe :: GlobalReg -> Maybe Reg globalRegMaybe BaseReg = Just (RealReg REG_Base) #endif #ifdef REG_R1 -globalRegMaybe (VanillaReg 1) = Just (RealReg REG_R1) +globalRegMaybe (VanillaReg 1 _) = Just (RealReg REG_R1) #endif #ifdef REG_R2 -globalRegMaybe (VanillaReg 2) = Just (RealReg REG_R2) +globalRegMaybe (VanillaReg 2 _) = Just (RealReg REG_R2) #endif #ifdef REG_R3 -globalRegMaybe (VanillaReg 3) = Just (RealReg REG_R3) +globalRegMaybe (VanillaReg 3 _) = Just (RealReg REG_R3) #endif #ifdef REG_R4 -globalRegMaybe (VanillaReg 4) = Just (RealReg REG_R4) +globalRegMaybe (VanillaReg 4 _) = Just (RealReg REG_R4) #endif #ifdef REG_R5 -globalRegMaybe (VanillaReg 5) = Just (RealReg REG_R5) +globalRegMaybe (VanillaReg 5 _) = Just (RealReg REG_R5) #endif #ifdef REG_R6 -globalRegMaybe (VanillaReg 6) = Just (RealReg REG_R6) +globalRegMaybe (VanillaReg 6 _) = Just (RealReg REG_R6) #endif #ifdef REG_R7 -globalRegMaybe (VanillaReg 7) = Just (RealReg REG_R7) +globalRegMaybe (VanillaReg 7 _) = Just (RealReg REG_R7) #endif #ifdef REG_R8 -globalRegMaybe (VanillaReg 8) = Just (RealReg REG_R8) +globalRegMaybe (VanillaReg 8 _) = Just (RealReg REG_R8) #endif #ifdef REG_R9 -globalRegMaybe (VanillaReg 9) = Just (RealReg REG_R9) +globalRegMaybe (VanillaReg 9 _) = Just (RealReg REG_R9) #endif #ifdef REG_R10 -globalRegMaybe (VanillaReg 10) = Just (RealReg REG_R10) +globalRegMaybe (VanillaReg 10 _) = Just (RealReg REG_R10) #endif #ifdef REG_F1 globalRegMaybe (FloatReg 1) = Just (RealReg REG_F1)