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