X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FMachRegs.lhs;h=5832abe7861184d803be56e54c57b73835b65240;hb=05535340ae496c57ff218e016da6649ca1640754;hp=0174fac0ceea60ed02aae57a394ccaaf4acb2836;hpb=727fae32ea0b6ca6ebdf1b3137649813e4d7ac3d;p=ghc-hetmet.git diff --git a/compiler/nativeGen/MachRegs.lhs b/compiler/nativeGen/MachRegs.lhs index 0174fac..5832abe 100644 --- a/compiler/nativeGen/MachRegs.lhs +++ b/compiler/nativeGen/MachRegs.lhs @@ -105,8 +105,7 @@ import UniqSet import Constants import FastTypes import FastBool -import qualified UniqFM as S -import LazyUniqFM +import UniqFM #if powerpc_TARGET_ARCH import Data.Word ( Word8, Word16, Word32 ) @@ -505,34 +504,35 @@ worst n classN classC #if i386_TARGET_ARCH #define ALLOCATABLE_REGS_INTEGER (_ILIT(3)) #define ALLOCATABLE_REGS_DOUBLE (_ILIT(6)) -#endif -#if x86_64_TARGET_ARCH +#elif x86_64_TARGET_ARCH #define ALLOCATABLE_REGS_INTEGER (_ILIT(5)) #define ALLOCATABLE_REGS_DOUBLE (_ILIT(2)) -#endif -#if powerpc_TARGET_ARCH +#elif powerpc_TARGET_ARCH #define ALLOCATABLE_REGS_INTEGER (_ILIT(16)) #define ALLOCATABLE_REGS_DOUBLE (_ILIT(26)) + +#else +#error ToDo: define ALLOCATABLE_REGS_INTEGER and ALLOCATABLE_REGS_DOUBLE #endif {-# INLINE regClass #-} trivColorable :: RegClass -> UniqSet Reg -> UniqSet Reg -> Bool -trivColorable classN (MkUniqFM conflicts) (MkUniqFM exclusions) +trivColorable classN conflicts exclusions = {-# SCC "trivColorable" #-} let {-# INLINE isSqueesed #-} isSqueesed cI cF ufm = case ufm of - S.NodeUFM _ _ left right + NodeUFM _ _ left right -> case isSqueesed cI cF right of (# s, cI', cF' #) -> case s of False -> isSqueesed cI' cF' left True -> (# True, cI', cF' #) - S.LeafUFM _ (Lazy reg) + LeafUFM _ reg -> case regClass reg of RcInteger -> case cI +# _ILIT(1) of @@ -542,7 +542,7 @@ trivColorable classN (MkUniqFM conflicts) (MkUniqFM exclusions) -> case cF +# _ILIT(1) of cF' -> (# cF' >=# ALLOCATABLE_REGS_DOUBLE, cI, cF' #) - S.EmptyUFM + EmptyUFM -> (# False, cI, cF #) in case isSqueesed (_ILIT(0)) (_ILIT(0)) conflicts of