compiler/nativeGen/RegArchBase.hs

   1
   2 -- | Utils for calculating general worst, bound, squeese and free, functions.
   3 --
   4 --      as per: "A Generalized Algorithm for Graph-Coloring Register Allocation"
   5 --              Michael Smith, Normal Ramsey, Glenn Holloway.
   6 --              PLDI 2004
   7 --
   8 --      These general versions are not used in GHC proper because they are too slow.
   9 --      Instead, hand written optimised versions are provided for each architecture
  10 --      in MachRegs*.hs
  11 --
  12 --      This code is here because we can test the architecture specific code against it.
  13 --
  14
  15 module RegArchBase (
  16         RegClass(..),
  17         Reg(..),
  18         RegSub(..),
  19
  20         worst,
  21         bound,
  22         squeese
  23 )
  24
  25 where
  26
  27 -----
  28 import UniqSet
  29 import Unique
  30
  31
  32 -- Some basic register classes.
  33 --      These aren't nessesarally in 1-to-1 correspondance with the allocatable
  34 --      RegClasses in MachRegs.hs
  35 --
  36 data RegClass
  37         -- general purpose regs
  38         = ClassG32      -- 32 bit GPRs
  39         | ClassG16      -- 16 bit GPRs
  40         | ClassG8       -- 8  bit GPRs
  41
  42         -- floating point regs
  43         | ClassF64      -- 64 bit FPRs
  44         deriving (Show, Eq, Enum)
  45
  46
  47 -- | A register of some class
  48 data Reg
  49         -- a register of some class
  50         = Reg RegClass Int
  51
  52         -- a sub-component of one of the other regs
  53         | RegSub RegSub Reg
  54         deriving (Show, Eq)
  55
  56
  57 -- | so we can put regs in UniqSets
  58 instance Uniquable Reg where
  59         getUnique (Reg c i)
  60          = mkUnique 'R'
  61          $ fromEnum c * 1000 + i
  62
  63         getUnique (RegSub s (Reg c i))
  64          = mkUnique 'S'
  65          $ fromEnum s * 10000 + fromEnum c * 1000 + i
  66
  67         getUnique (RegSub _ (RegSub _ _))
  68           = error "RegArchBase.getUnique: can't have a sub-reg of a sub-reg."
  69
  70 -- | A subcomponent of another register
  71 data RegSub
  72         = SubL16        -- lowest 16 bits
  73         | SubL8         -- lowest  8 bits
  74         | SubL8H        -- second lowest 8 bits
  75         deriving (Show, Enum, Ord, Eq)
  76
  77
  78 -- | Worst case displacement
  79 --
  80 --      a node N of classN has some number of neighbors,
  81 --      all of which are from classC.
  82 --
  83 --      (worst neighbors classN classC) is the maximum number of potential
  84 --      colors for N that can be lost by coloring its neighbors.
  85
  86 -- This should be hand coded/cached for each particular architecture,
  87 --      because the compute time is very long..
  88
  89 worst
  90         :: (RegClass    -> UniqSet Reg)
  91         -> (Reg         -> UniqSet Reg)
  92         -> Int -> RegClass -> RegClass -> Int
  93
  94 worst regsOfClass regAlias neighbors classN classC
  95  = let  regAliasS regs  = unionManyUniqSets
  96                         $ map regAlias
  97                         $ uniqSetToList regs
  98
  99         -- all the regs in classes N, C
 100         regsN           = regsOfClass classN
 101         regsC           = regsOfClass classC
 102
 103         -- all the possible subsets of c which have size < m
 104         regsS           = filter (\s -> sizeUniqSet s >= 1 && sizeUniqSet s <= neighbors)
 105                         $ powersetLS regsC
 106
 107         -- for each of the subsets of C, the regs which conflict with posiblities for N
 108         regsS_conflict
 109                 = map (\s -> intersectUniqSets regsN (regAliasS s)) regsS
 110
 111   in    maximum $ map sizeUniqSet $ regsS_conflict
 112
 113
 114 -- | For a node N of classN and neighbors of classesC
 115 --      (bound classN classesC) is the maximum number of potential
 116 --      colors for N that can be lost by coloring its neighbors.
 117 --
 118
 119 bound
 120         :: (RegClass    -> UniqSet Reg)
 121         -> (Reg         -> UniqSet Reg)
 122         -> RegClass -> [RegClass] -> Int
 123
 124 bound regsOfClass regAlias classN classesC
 125  = let  regAliasS regs  = unionManyUniqSets
 126                         $ map regAlias
 127                         $ uniqSetToList regs
 128
 129         regsC_aliases
 130                 = unionManyUniqSets
 131                 $ map (regAliasS . regsOfClass) classesC
 132
 133         overlap = intersectUniqSets (regsOfClass classN) regsC_aliases
 134
 135    in   sizeUniqSet overlap
 136
 137
 138 -- | The total squeese on a particular node with a list of neighbors.
 139 --
 140 --      A version of this should be constructed for each particular architecture,
 141 --      possibly including uses of bound, so that alised registers don't get counted
 142 --      twice, as per the paper.
 143 --
 144 squeese
 145         :: (RegClass    -> UniqSet Reg)
 146         -> (Reg         -> UniqSet Reg)
 147         -> RegClass -> [(Int, RegClass)] -> Int
 148
 149 squeese regsOfClass regAlias classN countCs
 150         = sum (map (\(i, classC) -> worst regsOfClass regAlias i classN classC) countCs)
 151
 152
 153 -- | powerset (for lists)
 154 powersetL :: [a] -> [[a]]
 155 powersetL       = map concat . mapM (\x -> [[],[x]])
 156
 157 -- | powersetLS (list of sets)
 158 powersetLS :: Uniquable a => UniqSet a -> [UniqSet a]
 159 powersetLS s    = map mkUniqSet $ powersetL $ uniqSetToList s
 160
 161 {-
 162 -- | unions (for sets)
 163 unionsS :: Ord a => Set (Set a) -> Set a
 164 unionsS ss      = Set.unions $ Set.toList ss
 165 -}
 166