compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs

   1
   2 module RegAlloc.Graph.TrivColorable (
   3         trivColorable,
   4 )
   5
   6 where
   7
   8 #include "HsVersions.h"
   9
  10 import RegClass
  11 import Reg
  12
  13 import GraphBase
  14
  15 import UniqFM
  16 import FastTypes
  17
  18 {-
  19 -- allocatableRegs is allMachRegNos with the fixed-use regs removed.
  20 -- i.e., these are the regs for which we are prepared to allow the
  21 -- register allocator to attempt to map VRegs to.
  22 allocatableRegs :: [RegNo]
  23 allocatableRegs
  24    = let isFree i = isFastTrue (freeReg i)
  25      in  filter isFree allMachRegNos
  26
  27
  28 -- | The number of regs in each class.
  29 --      We go via top level CAFs to ensure that we're not recomputing
  30 --      the length of these lists each time the fn is called.
  31 allocatableRegsInClass :: RegClass -> Int
  32 allocatableRegsInClass cls
  33  = case cls of
  34         RcInteger       -> allocatableRegsInteger
  35         RcDouble        -> allocatableRegsDouble
  36         RcFloat         -> panic "Regs.allocatableRegsInClass: no match\n"
  37
  38 allocatableRegsInteger :: Int
  39 allocatableRegsInteger
  40         = length $ filter (\r -> regClass r == RcInteger)
  41                  $ map RealReg allocatableRegs
  42
  43 allocatableRegsDouble :: Int
  44 allocatableRegsDouble
  45         = length $ filter (\r -> regClass r == RcDouble)
  46                  $ map RealReg allocatableRegs
  47 -}
  48
  49
  50 -- trivColorable ---------------------------------------------------------------
  51
  52 -- trivColorable function for the graph coloring allocator
  53 --      This gets hammered by scanGraph during register allocation,
  54 --      so needs to be fairly efficient.
  55 --
  56 --      NOTE:   This only works for arcitectures with just RcInteger and RcDouble
  57 --              (which are disjoint) ie. x86, x86_64 and ppc
  58 --
  59
  60 --      BL 2007/09
  61 --      Doing a nice fold over the UniqSet makes trivColorable use
  62 --      32% of total compile time and 42% of total alloc when compiling SHA1.lhs from darcs.
  63 {-
  64 trivColorable :: RegClass -> UniqSet Reg -> UniqSet Reg -> Bool
  65 trivColorable classN conflicts exclusions
  66  = let
  67
  68         acc :: Reg -> (Int, Int) -> (Int, Int)
  69         acc r (cd, cf)
  70          = case regClass r of
  71                 RcInteger       -> (cd+1, cf)
  72                 RcDouble        -> (cd,   cf+1)
  73                 _               -> panic "Regs.trivColorable: reg class not handled"
  74
  75         tmp                     = foldUniqSet acc (0, 0) conflicts
  76         (countInt,  countFloat) = foldUniqSet acc tmp    exclusions
  77
  78         squeese         = worst countInt   classN RcInteger
  79                         + worst countFloat classN RcDouble
  80
  81    in   squeese < allocatableRegsInClass classN
  82
  83 -- | Worst case displacement
  84 --      node N of classN has n neighbors of class C.
  85 --
  86 --      We currently only have RcInteger and RcDouble, which don't conflict at all.
  87 --      This is a bit boring compared to what's in RegArchX86.
  88 --
  89 worst :: Int -> RegClass -> RegClass -> Int
  90 worst n classN classC
  91  = case classN of
  92         RcInteger
  93          -> case classC of
  94                 RcInteger       -> min n (allocatableRegsInClass RcInteger)
  95                 RcDouble        -> 0
  96
  97         RcDouble
  98          -> case classC of
  99                 RcDouble        -> min n (allocatableRegsInClass RcDouble)
 100                 RcInteger       -> 0
 101 -}
 102
 103
 104 -- The number of allocatable regs is hard coded here so we can do a fast comparision
 105 -- in trivColorable. It's ok if these numbers are _less_ than the actual number of
 106 -- free regs, but they can't be more or the register conflict graph won't color.
 107 --
 108 -- There is an allocatableRegsInClass :: RegClass -> Int, but doing the unboxing
 109 -- is too slow for us here.
 110 --
 111 -- Compare Regs.freeRegs  and MachRegs.h to get these numbers.
 112 --
 113 #if i386_TARGET_ARCH
 114 #define ALLOCATABLE_REGS_INTEGER (_ILIT(3))
 115 #define ALLOCATABLE_REGS_DOUBLE  (_ILIT(6))
 116 #define ALLOCATABLE_REGS_FLOAT   (_ILIT(0))
 117
 118 #elif x86_64_TARGET_ARCH
 119 #define ALLOCATABLE_REGS_INTEGER (_ILIT(5))
 120 #define ALLOCATABLE_REGS_DOUBLE  (_ILIT(2))
 121 #define ALLOCATABLE_REGS_FLOAT   (_ILIT(0))
 122
 123 #elif powerpc_TARGET_ARCH
 124 #define ALLOCATABLE_REGS_INTEGER (_ILIT(16))
 125 #define ALLOCATABLE_REGS_DOUBLE  (_ILIT(26))
 126 #define ALLOCATABLE_REGS_FLOAT   (_ILIT(0))
 127
 128 #elif sparc_TARGET_ARCH
 129 #define ALLOCATABLE_REGS_INTEGER (_ILIT(14))
 130 #define ALLOCATABLE_REGS_DOUBLE  (_ILIT(8))
 131 #define ALLOCATABLE_REGS_FLOAT   (_ILIT(6))
 132
 133 #else
 134 #error ToDo: define ALLOCATABLE_REGS_INTEGER and ALLOCATABLE_REGS_DOUBLE
 135 #endif
 136
 137 trivColorable
 138         :: (Reg -> RegClass)
 139         -> Triv Reg RegClass Reg
 140
 141 trivColorable regClass _ conflicts exclusions
 142  = {-# SCC "trivColorable" #-}
 143    let
 144         isSqueesed cI cF ufm
 145           = case ufm of
 146                 NodeUFM _ _ left right
 147                  -> case isSqueesed cI cF right of
 148                         (# s, cI', cF' #)
 149                          -> case s of
 150                                 False   -> isSqueesed cI' cF' left
 151                                 True    -> (# True, cI', cF' #)
 152
 153                 LeafUFM _ reg
 154                  -> case regClass reg of
 155                         RcInteger
 156                          -> case cI +# _ILIT(1) of
 157                                 cI' -> (# cI' >=# ALLOCATABLE_REGS_INTEGER, cI', cF #)
 158
 159                         RcDouble
 160                          -> case cF +# _ILIT(1) of
 161                                 cF' -> (# cF' >=# ALLOCATABLE_REGS_DOUBLE,  cI, cF' #)
 162
 163                         RcFloat
 164                          -> case cF +# _ILIT(1) of
 165                                 cF' -> (# cF' >=# ALLOCATABLE_REGS_FLOAT,   cI, cF' #)
 166
 167                 EmptyUFM
 168                  ->     (# False, cI, cF #)
 169
 170    in case isSqueesed (_ILIT(0)) (_ILIT(0)) conflicts of
 171         (# False, cI', cF' #)
 172          -> case isSqueesed cI' cF' exclusions of
 173                 (# s, _, _ #)   -> not s
 174
 175         (# True, _, _ #)
 176          -> False