-- | Utils for calculating general worst, bound, squeese and free, functions. -- -- as per: "A Generalized Algorithm for Graph-Coloring Register Allocation" -- Michael Smith, Normal Ramsey, Glenn Holloway. -- PLDI 2004 -- -- These general versions are not used in GHC proper because they are too slow. -- Instead, hand written optimised versions are provided for each architecture -- in MachRegs*.hs -- -- This code is here because we can test the architecture specific code against -- it. -- module GHC.CmmToAsm.Reg.Graph.Base ( RegClass(..), Reg(..), RegSub(..), worst, bound, squeese ) where import GHC.Prelude import GHC.Types.Unique.Set import GHC.Types.Unique.FM import GHC.Types.Unique import GHC.Builtin.Uniques import GHC.Utils.Monad (concatMapM) -- Some basic register classes. -- These aren't necessarily in 1-to-1 correspondence with the allocatable -- RegClasses in MachRegs.hs data RegClass -- general purpose regs = ClassG32 -- 32 bit GPRs | ClassG16 -- 16 bit GPRs | ClassG8 -- 8 bit GPRs -- floating point regs | ClassF64 -- 64 bit FPRs deriving (Show, Eq, Enum) -- | A register of some class data Reg -- a register of some class = Reg RegClass Int -- a sub-component of one of the other regs | RegSub RegSub Reg deriving (Show, Eq) -- | so we can put regs in UniqSets instance Uniquable Reg where getUnique (Reg c i) = mkRegSingleUnique \$ fromEnum c * 1000 + i getUnique (RegSub s (Reg c i)) = mkRegSubUnique \$ fromEnum s * 10000 + fromEnum c * 1000 + i getUnique (RegSub _ (RegSub _ _)) = error "RegArchBase.getUnique: can't have a sub-reg of a sub-reg." -- | A subcomponent of another register data RegSub = SubL16 -- lowest 16 bits | SubL8 -- lowest 8 bits | SubL8H -- second lowest 8 bits deriving (Show, Enum, Ord, Eq) -- | Worst case displacement -- -- a node N of classN has some number of neighbors, -- all of which are from classC. -- -- (worst neighbors classN classC) is the maximum number of potential -- colors for N that can be lost by coloring its neighbors. -- -- This should be hand coded/cached for each particular architecture, -- because the compute time is very long.. worst :: (RegClass -> UniqSet Reg) -> (Reg -> UniqSet Reg) -> Int -> RegClass -> RegClass -> Int worst regsOfClass regAlias neighbors classN classC = let regAliasS regs = unionManyUniqSets \$ map regAlias \$ nonDetEltsUniqSet regs -- This is non-deterministic but we do not -- currently support deterministic code-generation. -- See Note [Unique Determinism and code generation] -- all the regs in classes N, C regsN = regsOfClass classN regsC = regsOfClass classC -- all the possible subsets of c which have size < m regsS = filter (\s -> sizeUniqSet s >= 1 && sizeUniqSet s <= neighbors) \$ powersetLS regsC -- for each of the subsets of C, the regs which conflict -- with posiblities for N regsS_conflict = map (\s -> intersectUniqSets regsN (regAliasS s)) regsS in maximum \$ map sizeUniqSet \$ regsS_conflict -- | For a node N of classN and neighbors of classesC -- (bound classN classesC) is the maximum number of potential -- colors for N that can be lost by coloring its neighbors. bound :: (RegClass -> UniqSet Reg) -> (Reg -> UniqSet Reg) -> RegClass -> [RegClass] -> Int bound regsOfClass regAlias classN classesC = let regAliasS regs = unionManyUniqSets \$ map regAlias \$ nonDetEltsUFM regs -- See Note [Unique Determinism and code generation] regsC_aliases = unionManyUniqSets \$ map (regAliasS . getUniqSet . regsOfClass) classesC overlap = intersectUniqSets (regsOfClass classN) regsC_aliases in sizeUniqSet overlap -- | The total squeese on a particular node with a list of neighbors. -- -- A version of this should be constructed for each particular architecture, -- possibly including uses of bound, so that aliased registers don't get -- counted twice, as per the paper. squeese :: (RegClass -> UniqSet Reg) -> (Reg -> UniqSet Reg) -> RegClass -> [(Int, RegClass)] -> Int squeese regsOfClass regAlias classN countCs = sum \$ map (\(i, classC) -> worst regsOfClass regAlias i classN classC) \$ countCs -- | powerset (for lists) powersetL :: [a] -> [[a]] powersetL = concatMapM (\x -> [[],[x]]) -- | powersetLS (list of sets) powersetLS :: Uniquable a => UniqSet a -> [UniqSet a] powersetLS s = map mkUniqSet \$ powersetL \$ nonDetEltsUniqSet s -- See Note [Unique Determinism and code generation]