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