compiler/nativeGen/RegAllocColor.hs

   1 -- | Graph coloring register allocator.
   2 --
   3 -- TODO:
   4 --      Live range splitting:
   5 --              At the moment regs that are spilled are spilled for all time, even though
   6 --              we might be able to allocate them a hardreg in different parts of the code.
   7 --
   8 --      As we're aggressively coalescing before register allocation proper we're not currently
   9 --      using the coalescence information present in the graph.
  10 --
  11 --      The function that choosing the potential spills could be a bit cleverer.
  12 --
  13 --      Colors in graphviz graphs could be nicer.
  14 --
  15
  16 module RegAllocColor (
  17         regAlloc,
  18         regDotColor
  19 )
  20
  21 where
  22
  23 import qualified GraphColor     as Color
  24 import RegLiveness
  25 import RegSpill
  26 import RegAllocStats
  27 import MachRegs
  28 import MachInstrs
  29 import RegCoalesce
  30 import PprMach
  31
  32 import UniqSupply
  33 import UniqSet
  34 import UniqFM
  35 import Bag
  36 import Outputable
  37
  38 import Data.List
  39 import Data.Maybe
  40 import Control.Monad
  41
  42 -- | The maximum number of build/spill cycles we'll allow.
  43 --      We should only need 3 or 4 cycles tops.
  44 --      If we run for any longer than this we're probably in an infinite loop,
  45 --      It's probably better just to bail out and report a bug at this stage.
  46 maxSpinCount    :: Int
  47 maxSpinCount    = 10
  48
  49
  50 -- | The top level of the graph coloring register allocator.
  51 --
  52 regAlloc
  53         :: UniqFM (UniqSet Reg)                         -- ^ the registers we can use for allocation
  54         -> UniqSet Int                                  -- ^ the set of available spill slots.
  55         -> [LiveCmmTop]                                 -- ^ code annotated with liveness information.
  56         -> UniqSM
  57                 ( [NatCmmTop]                           -- ^ code with registers allocated.
  58                 , [RegAllocStats] )                     -- ^ stats for each stage of allocation
  59
  60 regAlloc regsFree slotsFree code
  61  = do
  62         (code_final, debug_codeGraphs, graph_final)
  63                 <- regAlloc_spin 0 trivColorable regsFree slotsFree [] code
  64
  65         return  ( code_final
  66                 , debug_codeGraphs )
  67
  68 regAlloc_spin (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code
  69  = do
  70         -- check that we're not running off down the garden path.
  71         when (spinCount > maxSpinCount)
  72          $ pprPanic "regAlloc_spin: max build/spill cycle count exceeded."
  73                 (  text "It looks like the register allocator is stuck in an infinite loop."
  74                 $$ text "max cycles  = " <> int maxSpinCount
  75                 $$ text "regsFree    = " <> (hcat       $ punctuate space $ map (docToSDoc . pprUserReg)
  76                                                 $ uniqSetToList $ unionManyUniqSets $ eltsUFM regsFree)
  77                 $$ text "slotsFree   = " <> ppr (sizeUniqSet slotsFree))
  78
  79         -- build a conflict graph from the code.
  80         graph           <- buildGraph code
  81
  82         -- build a map of how many instructions each reg lives for
  83         --      this lazy, it won't be computed unless we need to spill
  84         let fmLife      = plusUFMs_C (\(r1, l1) (r2, l2) -> (r1, l1 + l2))
  85                         $ map lifetimeCount code
  86
  87         -- the function to choose regs to leave uncolored
  88         let spill       = chooseSpill_maxLife fmLife
  89
  90         -- try and color the graph
  91         let (graph_colored, rsSpill)
  92                         = Color.colorGraph regsFree triv spill graph
  93
  94         -- see if we've found a coloring
  95         if isEmptyUniqSet rsSpill
  96          then do
  97                 -- patch the registers using the info in the graph
  98                 let code_patched        = map (patchRegsFromGraph graph_colored) code
  99                 let code_nat            = map stripLive code_patched
 100
 101                 -- record what happened in this stage for debugging
 102                 let stat                =
 103                         RegAllocStatsColored
 104                         { raLiveCmm     = code
 105                         , raGraph       = graph_colored
 106                         , raPatchedCmm  = code_patched
 107                         , raLifetimes   = fmLife }
 108
 109                 return  ( code_nat
 110                         , debug_codeGraphs ++ [stat]
 111                         , graph_colored)
 112
 113          else do
 114                 -- spill the uncolored regs
 115                 (code_spilled, slotsFree', spillStats)
 116                         <- regSpill code slotsFree rsSpill
 117
 118                 -- recalculate liveness
 119                 let code_nat    = map stripLive code_spilled
 120                 code_relive     <- mapM regLiveness code_nat
 121
 122                 -- record what happened in this stage for debugging
 123                 let stat        =
 124                         RegAllocStatsSpill
 125                         { raLiveCmm     = code_spilled
 126                         , raGraph       = graph_colored
 127                         , raSpillStats  = spillStats
 128                         , raLifetimes   = fmLife }
 129
 130                 -- try again
 131                 regAlloc_spin (spinCount + 1) triv regsFree slotsFree'
 132                         (debug_codeGraphs ++ [stat])
 133                         code_relive
 134
 135
 136 -----
 137 -- Simple maxconflicts isn't always good, because we
 138 --      can naievely end up spilling vregs that only live for one or two instrs.
 139 --
 140 {-
 141 chooseSpill_maxConflicts
 142         :: Color.Graph Reg RegClass Reg
 143         -> Reg
 144
 145 chooseSpill_maxConflicts graph
 146  = let  node    = maximumBy
 147                         (\n1 n2 -> compare
 148                                 (sizeUniqSet $ Color.nodeConflicts n1)
 149                                 (sizeUniqSet $ Color.nodeConflicts n2))
 150                 $ eltsUFM $ Color.graphMap graph
 151
 152    in   Color.nodeId node
 153 -}
 154
 155 -----
 156 chooseSpill_maxLife
 157         :: UniqFM (Reg, Int)
 158         -> Color.Graph Reg RegClass Reg
 159         -> Reg
 160
 161 chooseSpill_maxLife life graph
 162  = let  node    = maximumBy (\n1 n2 -> compare (getLife n1) (getLife n2))
 163                 $ eltsUFM $ Color.graphMap graph
 164
 165         -- Orphan vregs die in the same instruction they are born in.
 166         --      They will be in the graph, but not in the liveness map.
 167         --      Their liveness is 0.
 168         getLife n
 169          = case lookupUFM life (Color.nodeId n) of
 170                 Just (_, l)     -> l
 171                 Nothing         -> 0
 172
 173    in   Color.nodeId node
 174
 175
 176 -- | Build a graph from the liveness and coalesce information in this code.
 177
 178 buildGraph
 179         :: [LiveCmmTop]
 180         -> UniqSM (Color.Graph Reg RegClass Reg)
 181
 182 buildGraph code
 183  = do
 184         -- Add the reg-reg conflicts to the graph
 185         let conflictSets        = unionManyBags (map slurpConflicts code)
 186         let graph_conflict      = foldrBag graphAddConflictSet Color.initGraph conflictSets
 187
 188
 189         -- Add the coalescences edges to the graph.
 190         let coalesce            = unionManyBags (map slurpJoinMovs code)
 191         let graph_coalesce      = foldrBag graphAddCoalesce graph_conflict coalesce
 192
 193         return  $ graph_coalesce
 194
 195
 196 -- | Add some conflict edges to the graph.
 197 --      Conflicts between virtual and real regs are recorded as exlusions.
 198 --
 199 graphAddConflictSet
 200         :: UniqSet Reg
 201         -> Color.Graph Reg RegClass Reg
 202         -> Color.Graph Reg RegClass Reg
 203
 204 graphAddConflictSet set graph
 205  = let  reals           = filterUFM isRealReg set
 206         virtuals        = filterUFM (not . isRealReg) set
 207
 208         graph1  = Color.addConflicts virtuals regClass graph
 209         graph2  = foldr (\(r1, r2) -> Color.addExclusion r1 regClass r2)
 210                         graph1
 211                         [ (a, b)
 212                                 | a <- uniqSetToList virtuals
 213                                 , b <- uniqSetToList reals]
 214
 215    in   graph2
 216
 217
 218 -- | Add some coalesences edges to the graph
 219 --      Coalesences between virtual and real regs are recorded as preferences.
 220 --
 221 graphAddCoalesce
 222         :: (Reg, Reg)
 223         -> Color.Graph Reg RegClass Reg
 224         -> Color.Graph Reg RegClass Reg
 225
 226 graphAddCoalesce (r1, r2) graph
 227         | RealReg regno <- r1
 228         = Color.addPreference (regWithClass r2) r1 graph
 229
 230         | RealReg regno <- r2
 231         = Color.addPreference (regWithClass r1) r2 graph
 232
 233         | otherwise
 234         = Color.addCoalesce (regWithClass r1) (regWithClass r2) graph
 235
 236         where   regWithClass r  = (r, regClass r)
 237
 238
 239 -- | Patch registers in code using the reg -> reg mapping in this graph.
 240 patchRegsFromGraph
 241         :: Color.Graph Reg RegClass Reg
 242         -> LiveCmmTop -> LiveCmmTop
 243
 244 patchRegsFromGraph graph code
 245  = let
 246         -- a function to lookup the hardreg for a virtual reg from the graph.
 247         patchF reg
 248                 -- leave real regs alone.
 249                 | isRealReg reg
 250                 = reg
 251
 252                 -- this virtual has a regular node in the graph.
 253                 | Just node     <- Color.lookupNode graph reg
 254                 = case Color.nodeColor node of
 255                         Just color      -> color
 256                         Nothing         -> reg
 257
 258                 -- no node in the graph for this virtual, bad news.
 259                 | otherwise
 260                 = pprPanic "patchRegsFromGraph: register mapping failed."
 261                         (  text "There is no node in the graph for register " <> ppr reg
 262                         $$ ppr code
 263                         $$ Color.dotGraph (\x -> text "white") trivColorable graph)
 264
 265    in   patchEraseLive patchF code
 266
 267
 268 plusUFMs_C  :: (elt -> elt -> elt) -> [UniqFM elt] -> UniqFM elt
 269 plusUFMs_C f maps
 270         = foldl (plusUFM_C f) emptyUFM maps
 271