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