Merging in the new codegen branch
[ghc-hetmet.git] / compiler / nativeGen / MachRegs.lhs
index c4f84a4..2e578c0 100644 (file)
 -- -----------------------------------------------------------------------------
 
 \begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 #include "nativeGen/NCG.h"
 
 module MachRegs (
 
+       -- * Sizes
+       Size(..), intSize, floatSize, isFloatSize, 
+                 wordSize, cmmTypeSize, sizeToWidth,
+
        -- * Immediate values
        Imm(..), strImmLit, litToImm,
 
@@ -26,17 +37,18 @@ module MachRegs (
 
        -- * The 'Reg' type
        RegNo,
-       Reg(..), isRealReg, isVirtualReg,
+       Reg(..), isRealReg, isVirtualReg, renameVirtualReg,
         RegClass(..), regClass,
+       trivColorable,
        getHiVRegFromLo, 
        mkVReg,
 
        -- * Global registers
         get_GlobalReg_reg_or_addr,
-       callerSaves, callerSaveVolatileRegs,
 
        -- * Machine-dependent register-related stuff
         allocatableRegs, argRegs, allArgRegs, callClobberedRegs,
+       allocatableRegsInClass,
        freeReg,
        spRel,
 
@@ -85,15 +97,17 @@ module MachRegs (
 #include "../includes/MachRegs.h"
 
 import Cmm
-import MachOp          ( MachRep(..) )
-
+import CgUtils          ( get_GlobalReg_addr )
 import CLabel           ( CLabel, mkMainCapabilityLabel )
 import Pretty
 import Outputable      ( Outputable(..), pprPanic, panic )
 import qualified Outputable
 import Unique
+import UniqSet
 import Constants
 import FastTypes
+import FastBool
+import UniqFM
 
 #if powerpc_TARGET_ARCH
 import Data.Word       ( Word8, Word16, Word32 )
@@ -101,6 +115,95 @@ 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
+    = B     -- byte (signed)
+    | Bu    -- byte (unsigned)
+    | H     -- halfword (signed, 2 bytes)
+    | Hu    -- halfword (unsigned, 2 bytes)
+    | W            -- word (4 bytes)
+    | F            -- IEEE single-precision floating pt
+    | DF    -- IEEE single-precision floating pt
+  deriving Eq
+#endif
+
+-- -----------------------------------------------------------------------------
 -- Immediates
 
 data Imm
@@ -126,8 +229,8 @@ 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 (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)
@@ -253,23 +356,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
@@ -310,75 +412,16 @@ ripRel imm = AddrBaseIndex EABaseRip EAIndexNone imm
 -- 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 StixExpr denoting the
--- address in the register table holding it.  get_MagicId_addr always
--- produces the register table address for it.
+-- 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_addr              :: GlobalReg -> CmmExpr
-get_Regtable_addr_from_offset   :: MachRep -> Int -> CmmExpr
-
 get_GlobalReg_reg_or_addr mid
    = case globalRegMaybe mid of
         Just rr -> Left rr
         Nothing -> Right (get_GlobalReg_addr mid)
 
-get_GlobalReg_addr BaseReg = regTableOffset 0
-get_GlobalReg_addr mid     = get_Regtable_addr_from_offset 
-                               (globalRegRep mid) (baseRegOffset mid)
-
--- Calculate a literal representing an offset into the register table.
--- Used when we don't have an actual BaseReg to offset from.
-regTableOffset n = 
-  CmmLit (CmmLabelOff mkMainCapabilityLabel (oFFSET_Capability_r + n))
-
-get_Regtable_addr_from_offset rep offset
-   = case globalRegMaybe BaseReg of
-                 Nothing -> regTableOffset offset
-                 Just _  -> CmmRegOff (CmmGlobal BaseReg) offset
-
--- -----------------------------------------------------------------------------
--- caller-save registers
-
--- Here we generate the sequence of saves/restores required around a
--- foreign call instruction.
-
--- TODO: reconcile with includes/Regs.h
---  * Regs.h claims that BaseReg should be saved last and loaded first
---    * This might not have been tickled before since BaseReg is callee save
---  * Regs.h saves SparkHd, ParkT1, SparkBase and SparkLim
-callerSaveVolatileRegs :: Maybe [GlobalReg] -> ([CmmStmt], [CmmStmt])
-callerSaveVolatileRegs vols = (caller_save, caller_load)
-  where
-    caller_save = foldr ($!) [] (map callerSaveGlobalReg    regs_to_save)
-    caller_load = foldr ($!) [] (map callerRestoreGlobalReg regs_to_save)
-
-    system_regs = [Sp,SpLim,Hp,HpLim,CurrentTSO,CurrentNursery,
-                  {-SparkHd,SparkTl,SparkBase,SparkLim,-}BaseReg ]
-
-    regs_to_save = system_regs ++ vol_list
-
-    vol_list = case vols of Nothing -> all_of_em; Just regs -> regs
-
-    all_of_em = [ VanillaReg n | n <- [0..mAX_Vanilla_REG] ]
-            ++ [ FloatReg   n | n <- [0..mAX_Float_REG] ]
-            ++ [ DoubleReg  n | n <- [0..mAX_Double_REG] ]
-            ++ [ LongReg    n | n <- [0..mAX_Long_REG] ]
-
-    callerSaveGlobalReg reg next
-       | callerSaves reg = 
-               CmmStore (get_GlobalReg_addr reg) 
-                        (CmmReg (CmmGlobal reg)) : next
-       | otherwise = next
-
-    callerRestoreGlobalReg reg next
-       | callerSaves reg = 
-               CmmAssign (CmmGlobal reg)
-                         (CmmLoad (get_GlobalReg_addr reg) (globalRegRep reg))
-                       : next
-       | otherwise = next
-
-
 -- ---------------------------------------------------------------------------
 -- Registers
 
@@ -412,6 +455,11 @@ data RegClass
    | RcDouble
      deriving Eq
 
+instance Uniquable RegClass where
+    getUnique RcInteger        = mkUnique 'L' 0
+    getUnique RcFloat  = mkUnique 'L' 1
+    getUnique RcDouble = mkUnique 'L' 2
+
 type RegNo = Int
 
 data Reg
@@ -434,16 +482,18 @@ 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
 #else
-        F32   -> VirtualRegD u
+        FF32    -> VirtualRegD u
 #endif
-        F64   -> VirtualRegD u
-        other -> VirtualRegI u
+        FF64    -> VirtualRegD u
+       _other -> panic "mkVReg"
 
 isVirtualReg :: Reg -> Bool
 isVirtualReg (RealReg _)      = False
@@ -455,6 +505,15 @@ isVirtualReg (VirtualRegD _)  = True
 isRealReg :: Reg -> Bool
 isRealReg = not . isVirtualReg
 
+renameVirtualReg :: Unique -> Reg -> Reg
+renameVirtualReg u r
+ = case r of
+       RealReg _       -> error "renameVirtualReg: can't change unique on a real reg"
+       VirtualRegI _   -> VirtualRegI  u
+       VirtualRegHi _  -> VirtualRegHi u
+       VirtualRegF _   -> VirtualRegF  u
+       VirtualRegD _   -> VirtualRegD  u
+
 instance Show Reg where
     show (RealReg i)      = showReg i
     show (VirtualRegI u)  = "%vI_" ++ show u
@@ -462,10 +521,132 @@ instance Show Reg where
     show (VirtualRegF u)  = "%vF_" ++ show u
     show (VirtualRegD u)  = "%vD_" ++ show u
 
+instance Outputable RegClass where
+    ppr RcInteger      = Outputable.text "I"
+    ppr RcFloat                = Outputable.text "F"
+    ppr RcDouble       = Outputable.text "D"
+
 instance Outputable Reg where
     ppr r = Outputable.text (show r)
 
 
+
+
+-- trivColorable function for the graph coloring allocator
+--     This gets hammered by scanGraph during register allocation,
+--     so needs to be fairly efficient.
+--
+--     NOTE:   This only works for arcitectures with just RcInteger and RcDouble
+--             (which are disjoint) ie. x86, x86_64 and ppc
+--
+
+--     BL 2007/09
+--     Doing a nice fold over the UniqSet makes trivColorable use
+--     32% of total compile time and 42% of total alloc when compiling SHA1.lhs from darcs.
+{-
+trivColorable :: RegClass -> UniqSet Reg -> UniqSet Reg -> Bool
+trivColorable classN conflicts exclusions
+ = let
+
+       acc :: Reg -> (Int, Int) -> (Int, Int)
+       acc r (cd, cf)  
+        = case regClass r of
+               RcInteger       -> (cd+1, cf)
+               RcDouble        -> (cd,   cf+1)
+               _               -> panic "MachRegs.trivColorable: reg class not handled"
+
+       tmp                     = foldUniqSet acc (0, 0) conflicts
+       (countInt,  countFloat) = foldUniqSet acc tmp    exclusions
+
+       squeese         = worst countInt   classN RcInteger
+                       + worst countFloat classN RcDouble
+
+   in  squeese < allocatableRegsInClass classN
+
+-- | Worst case displacement
+--     node N of classN has n neighbors of class C.
+--
+--     We currently only have RcInteger and RcDouble, which don't conflict at all.
+--     This is a bit boring compared to what's in RegArchX86.
+--
+worst :: Int -> RegClass -> RegClass -> Int
+worst n classN classC
+ = case classN of
+       RcInteger
+        -> case classC of
+               RcInteger       -> min n (allocatableRegsInClass RcInteger)
+               RcDouble        -> 0
+               
+       RcDouble
+        -> case classC of
+               RcDouble        -> min n (allocatableRegsInClass RcDouble)
+               RcInteger       -> 0
+-}
+
+
+-- The number of allocatable regs is hard coded here so we can do a fast comparision
+-- in trivColorable. It's ok if these numbers are _less_ than the actual number of
+-- free regs, but they can't be more or the register conflict graph won't color.
+--
+-- There is an allocatableRegsInClass :: RegClass -> Int, but doing the unboxing
+-- is too slow for us here.
+--
+-- Compare MachRegs.freeRegs  and MachRegs.h to get these numbers.
+--
+#if i386_TARGET_ARCH
+#define ALLOCATABLE_REGS_INTEGER (_ILIT(3))
+#define ALLOCATABLE_REGS_DOUBLE  (_ILIT(6))
+
+#elif x86_64_TARGET_ARCH
+#define ALLOCATABLE_REGS_INTEGER (_ILIT(5))
+#define ALLOCATABLE_REGS_DOUBLE  (_ILIT(2))
+
+#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 conflicts exclusions
+ = {-# SCC "trivColorable" #-}
+   let
+       {-# INLINE   isSqueesed    #-}
+       isSqueesed cI cF ufm
+         = case ufm of
+               NodeUFM _ _ left right
+                -> case isSqueesed cI cF right of
+                       (# s, cI', cF' #)
+                        -> case s of
+                               False   -> isSqueesed cI' cF' left
+                               True    -> (# True, cI', cF' #)
+
+               LeafUFM _ reg
+                -> case regClass reg of
+                       RcInteger
+                        -> case cI +# _ILIT(1) of
+                               cI' -> (# cI' >=# ALLOCATABLE_REGS_INTEGER, cI', cF #)
+
+                       RcDouble
+                        -> case cF +# _ILIT(1) of
+                               cF' -> (# cF' >=# ALLOCATABLE_REGS_DOUBLE,  cI, cF' #)
+
+               EmptyUFM
+                ->     (# False, cI, cF #)
+
+   in case isSqueesed (_ILIT(0)) (_ILIT(0)) conflicts of
+       (# False, cI', cF' #)
+        -> case isSqueesed cI' cF' exclusions of
+               (# s, _, _ #)   -> not s
+
+       (# True, _, _ #)
+        -> False
+
+
+
 -- -----------------------------------------------------------------------------
 -- Machine-specific register stuff
 
@@ -527,6 +708,7 @@ fake3 = RealReg 11
 fake4 = RealReg 12
 fake5 = RealReg 13
 
+
 -- 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
@@ -548,6 +730,7 @@ showReg n
      then regNames !! n
      else "%unknown_x86_real_reg_" ++ show n
 
+
 #endif
 
 {-
@@ -1011,6 +1194,25 @@ allocatableRegs
    = let isFree i = isFastTrue (freeReg i)
      in  filter isFree allMachRegNos
 
+
+-- | The number of regs in each class.
+--     We go via top level CAFs to ensure that we're not recomputing
+--     the length of these lists each time the fn is called.
+allocatableRegsInClass :: RegClass -> Int
+allocatableRegsInClass cls
+ = case cls of
+       RcInteger       -> allocatableRegsInteger
+       RcDouble        -> allocatableRegsDouble
+
+allocatableRegsInteger 
+       = length $ filter (\r -> regClass r == RcInteger) 
+                $ map RealReg allocatableRegs
+
+allocatableRegsDouble
+       = length $ filter (\r -> regClass r == RcDouble) 
+                $ map RealReg allocatableRegs
+
+
 -- these are the regs which we cannot assume stay alive over a
 -- C call.  
 callClobberedRegs :: [Reg]
@@ -1238,117 +1440,6 @@ freeReg REG_HpLim = fastBool False
 freeReg n               = fastBool True
 
 
--- -----------------------------------------------------------------------------
--- Information about global registers
-
-baseRegOffset :: GlobalReg -> Int
-
-baseRegOffset (VanillaReg 1)      = oFFSET_StgRegTable_rR1
-baseRegOffset (VanillaReg 2)      = oFFSET_StgRegTable_rR2
-baseRegOffset (VanillaReg 3)      = oFFSET_StgRegTable_rR3
-baseRegOffset (VanillaReg 4)      = oFFSET_StgRegTable_rR4
-baseRegOffset (VanillaReg 5)      = oFFSET_StgRegTable_rR5
-baseRegOffset (VanillaReg 6)      = oFFSET_StgRegTable_rR6
-baseRegOffset (VanillaReg 7)      = oFFSET_StgRegTable_rR7
-baseRegOffset (VanillaReg 8)      = oFFSET_StgRegTable_rR8
-baseRegOffset (VanillaReg 9)      = oFFSET_StgRegTable_rR9
-baseRegOffset (VanillaReg 10)     = oFFSET_StgRegTable_rR10
-baseRegOffset (FloatReg  1)       = oFFSET_StgRegTable_rF1
-baseRegOffset (FloatReg  2)       = oFFSET_StgRegTable_rF2
-baseRegOffset (FloatReg  3)       = oFFSET_StgRegTable_rF3
-baseRegOffset (FloatReg  4)       = oFFSET_StgRegTable_rF4
-baseRegOffset (DoubleReg 1)       = oFFSET_StgRegTable_rD1
-baseRegOffset (DoubleReg 2)       = oFFSET_StgRegTable_rD2
-baseRegOffset Sp                 = oFFSET_StgRegTable_rSp
-baseRegOffset SpLim              = oFFSET_StgRegTable_rSpLim
-baseRegOffset (LongReg 1)         = oFFSET_StgRegTable_rL1
-baseRegOffset Hp                 = oFFSET_StgRegTable_rHp
-baseRegOffset HpLim              = oFFSET_StgRegTable_rHpLim
-baseRegOffset CurrentTSO         = oFFSET_StgRegTable_rCurrentTSO
-baseRegOffset CurrentNursery     = oFFSET_StgRegTable_rCurrentNursery
-baseRegOffset HpAlloc            = oFFSET_StgRegTable_rHpAlloc
-baseRegOffset GCEnter1           = oFFSET_stgGCEnter1
-baseRegOffset GCFun              = oFFSET_stgGCFun
-#ifdef DEBUG
-baseRegOffset BaseReg            = panic "baseRegOffset:BaseReg"
-baseRegOffset _                          = panic "baseRegOffset:other"
-#endif
-
-
--- | Returns 'True' if this global register is stored in a caller-saves
--- machine register.
-
-callerSaves :: GlobalReg -> Bool
-
-#ifdef CALLER_SAVES_Base
-callerSaves BaseReg            = True
-#endif
-#ifdef CALLER_SAVES_R1
-callerSaves (VanillaReg 1)     = True
-#endif
-#ifdef CALLER_SAVES_R2
-callerSaves (VanillaReg 2)     = True
-#endif
-#ifdef CALLER_SAVES_R3
-callerSaves (VanillaReg 3)     = True
-#endif
-#ifdef CALLER_SAVES_R4
-callerSaves (VanillaReg 4)     = True
-#endif
-#ifdef CALLER_SAVES_R5
-callerSaves (VanillaReg 5)     = True
-#endif
-#ifdef CALLER_SAVES_R6
-callerSaves (VanillaReg 6)     = True
-#endif
-#ifdef CALLER_SAVES_R7
-callerSaves (VanillaReg 7)     = True
-#endif
-#ifdef CALLER_SAVES_R8
-callerSaves (VanillaReg 8)     = True
-#endif
-#ifdef CALLER_SAVES_F1
-callerSaves (FloatReg 1)       = True
-#endif
-#ifdef CALLER_SAVES_F2
-callerSaves (FloatReg 2)       = True
-#endif
-#ifdef CALLER_SAVES_F3
-callerSaves (FloatReg 3)       = True
-#endif
-#ifdef CALLER_SAVES_F4
-callerSaves (FloatReg 4)       = True
-#endif
-#ifdef CALLER_SAVES_D1
-callerSaves (DoubleReg 1)      = True
-#endif
-#ifdef CALLER_SAVES_D2
-callerSaves (DoubleReg 2)      = True
-#endif
-#ifdef CALLER_SAVES_L1
-callerSaves (LongReg 1)                = True
-#endif
-#ifdef CALLER_SAVES_Sp
-callerSaves Sp                 = True
-#endif
-#ifdef CALLER_SAVES_SpLim
-callerSaves SpLim              = True
-#endif
-#ifdef CALLER_SAVES_Hp
-callerSaves Hp                 = True
-#endif
-#ifdef CALLER_SAVES_HpLim
-callerSaves HpLim              = True
-#endif
-#ifdef CALLER_SAVES_CurrentTSO
-callerSaves CurrentTSO         = True
-#endif
-#ifdef CALLER_SAVES_CurrentNursery
-callerSaves CurrentNursery     = True
-#endif
-callerSaves _                  = False
-
-
 --  | Returns 'Nothing' if this global register is not stored
 -- in a real machine register, otherwise returns @'Just' reg@, where
 -- reg is the machine register it is stored in.
@@ -1359,34 +1450,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)