2 -- | Utils for calculating general worst, bound, squeese and free, functions.
4 -- as per: "A Generalized Algorithm for Graph-Coloring Register Allocation"
5 -- Michael Smith, Normal Ramsey, Glenn Holloway.
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
12 -- This code is here because we can test the architecture specific code against it.
15 {-# OPTIONS_GHC -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/WorkingConventions#Warnings
39 -- Some basic register classes.
40 -- These aren't nessesarally in 1-to-1 correspondance with the allocatable
41 -- RegClasses in MachRegs.hs
44 -- general purpose regs
45 = ClassG32 -- 32 bit GPRs
46 | ClassG16 -- 16 bit GPRs
47 | ClassG8 -- 8 bit GPRs
49 -- floating point regs
50 | ClassF64 -- 64 bit FPRs
51 deriving (Show, Eq, Enum)
54 -- | A register of some class
56 -- a register of some class
59 -- a sub-component of one of the other regs
64 -- | so we can put regs in UniqSets
65 instance Uniquable Reg where
68 $ fromEnum c * 1000 + i
70 getUnique (RegSub s (Reg c i))
72 $ fromEnum s * 10000 + fromEnum c * 1000 + i
74 getUnique (RegSub s (RegSub c _))
75 = error "RegArchBase.getUnique: can't have a sub-reg of a sub-reg."
77 -- | A subcomponent of another register
79 = SubL16 -- lowest 16 bits
80 | SubL8 -- lowest 8 bits
81 | SubL8H -- second lowest 8 bits
82 deriving (Show, Enum, Ord, Eq)
85 -- | Worst case displacement
87 -- a node N of classN has some number of neighbors,
88 -- all of which are from classC.
90 -- (worst neighbors classN classC) is the maximum number of potential
91 -- colors for N that can be lost by coloring its neighbors.
93 -- This should be hand coded/cached for each particular architecture,
94 -- because the compute time is very long..
97 :: (RegClass -> UniqSet Reg)
98 -> (Reg -> UniqSet Reg)
99 -> Int -> RegClass -> RegClass -> Int
101 worst regsOfClass regAlias neighbors classN classC
102 = let regAliasS regs = unionManyUniqSets
106 -- all the regs in classes N, C
107 regsN = regsOfClass classN
108 regsC = regsOfClass classC
110 -- all the possible subsets of c which have size < m
111 regsS = filter (\s -> sizeUniqSet s >= 1 && sizeUniqSet s <= neighbors)
114 -- for each of the subsets of C, the regs which conflict with posiblities for N
116 = map (\s -> intersectUniqSets regsN (regAliasS s)) regsS
118 in maximum $ map sizeUniqSet $ regsS_conflict
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.
127 :: (RegClass -> UniqSet Reg)
128 -> (Reg -> UniqSet Reg)
129 -> RegClass -> [RegClass] -> Int
131 bound regsOfClass regAlias classN classesC
132 = let regAliasS regs = unionManyUniqSets
138 $ map (regAliasS . regsOfClass) classesC
140 overlap = intersectUniqSets (regsOfClass classN) regsC_aliases
142 in sizeUniqSet overlap
145 -- | The total squeese on a particular node with a list of neighbors.
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.
152 :: (RegClass -> UniqSet Reg)
153 -> (Reg -> UniqSet Reg)
154 -> RegClass -> [(Int, RegClass)] -> Int
156 squeese regsOfClass regAlias classN countCs
157 = sum (map (\(i, classC) -> worst regsOfClass regAlias i classN classC) countCs)
160 -- | powerset (for lists)
161 powersetL :: [a] -> [[a]]
162 powersetL = map concat . mapM (\x -> [[],[x]])
164 -- | powersetLS (list of sets)
165 powersetLS :: Uniquable a => UniqSet a -> [UniqSet a]
166 powersetLS s = map mkUniqSet $ powersetL $ uniqSetToList s
169 -- | unions (for sets)
170 unionsS :: Ord a => Set (Set a) -> Set a
171 unionsS ss = Set.unions $ Set.toList ss