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 {-# OPTIONS -fno-warn-missing-signatures #-}
  16
  17 module RegAllocColor (
  18         regAlloc,
  19         regDotColor
  20 )
  21
  22 where
  23
  24 import qualified GraphColor     as Color
  25 import RegLiveness
  26 import RegSpill
  27 import RegSpillClean
  28 import RegAllocStats
  29 import MachRegs
  30 import MachInstrs
  31 import PprMach
  32
  33 import UniqSupply
  34 import UniqSet
  35 import UniqFM
  36 import Bag
  37 import Outputable
  38
  39 import Data.List
  40 import Data.Maybe
  41 import Control.Monad
  42
  43 -- | The maximum number of build/spill cycles we'll allow.
  44 --      We should only need 3 or 4 cycles tops.
  45 --      If we run for any longer than this we're probably in an infinite loop,
  46 --      It's probably better just to bail out and report a bug at this stage.
  47 maxSpinCount    :: Int
  48 maxSpinCount    = 10
  49
  50
  51 -- | The top level of the graph coloring register allocator.
  52 --
  53 regAlloc
  54         :: Bool                         -- ^ whether to generate RegAllocStats, or not.
  55         -> UniqFM (UniqSet Reg)         -- ^ the registers we can use for allocation
  56         -> UniqSet Int                  -- ^ the set of available spill slots.
  57         -> [LiveCmmTop]                 -- ^ code annotated with liveness information.
  58         -> UniqSM
  59                 ( [NatCmmTop]           -- ^ code with registers allocated.
  60                 , [RegAllocStats] )     -- ^ stats for each stage of allocation
  61
  62 regAlloc dump regsFree slotsFree code
  63  = do
  64         (code_final, debug_codeGraphs, _)
  65                 <- regAlloc_spin dump 0 trivColorable regsFree slotsFree [] code
  66
  67         return  ( code_final
  68                 , reverse debug_codeGraphs )
  69
  70 regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code
  71  = do
  72         -- check that we're not running off down the garden path.
  73         when (spinCount > maxSpinCount)
  74          $ pprPanic "regAlloc_spin: max build/spill cycle count exceeded."
  75                 (  text "It looks like the register allocator is stuck in an infinite loop."
  76                 $$ text "max cycles  = " <> int maxSpinCount
  77                 $$ text "regsFree    = " <> (hcat       $ punctuate space $ map (docToSDoc . pprUserReg)
  78                                                 $ uniqSetToList $ unionManyUniqSets $ eltsUFM regsFree)
  79                 $$ text "slotsFree   = " <> ppr (sizeUniqSet slotsFree))
  80
  81         -- build a conflict graph from the code.
  82         graph           <- {-# SCC "BuildGraph" #-} buildGraph code
  83
  84         -- build a map of how many instructions each reg lives for.
  85         --      this is lazy, it won't be computed unless we need to spill
  86
  87         let fmLife      = {-# SCC "LifetimeCount" #-} plusUFMs_C (\(r1, l1) (_, l2) -> (r1, l1 + l2))
  88                         $ map lifetimeCount code
  89
  90         -- record startup state
  91         let stat1       =
  92                 if spinCount == 0
  93                  then   Just $ RegAllocStatsStart
  94                         { raLiveCmm     = code
  95                         , raGraph       = graph
  96                         , raLifetimes   = fmLife }
  97                  else   Nothing
  98
  99
 100         -- the function to choose regs to leave uncolored
 101         let spill       = chooseSpill_maxLife fmLife
 102
 103         -- try and color the graph
 104         let (graph_colored, rsSpill, rmCoalesce)
 105                         = {-# SCC "ColorGraph" #-} Color.colorGraph regsFree triv spill graph
 106
 107         -- rewrite regs in the code that have been coalesced
 108         let patchF reg  = case lookupUFM rmCoalesce reg of
 109                                 Just reg'       -> reg'
 110                                 Nothing         -> reg
 111         let code_coalesced
 112                         = map (patchEraseLive patchF) code
 113
 114
 115         -- see if we've found a coloring
 116         if isEmptyUniqSet rsSpill
 117          then do
 118                 -- patch the registers using the info in the graph
 119                 let code_patched        = map (patchRegsFromGraph graph_colored) code_coalesced
 120
 121                 -- clean out unneeded SPILL/RELOADs
 122                 let code_spillclean     = map cleanSpills code_patched
 123
 124                 -- strip off liveness information
 125                 let code_nat            = map stripLive code_patched
 126
 127                 -- rewrite SPILL/REALOAD pseudos into real instructions
 128                 let spillNatTop         = mapGenBlockTop spillNatBlock
 129                 let code_final          = map spillNatTop code_nat
 130
 131                 -- record what happened in this stage for debugging
 132                 let stat                =
 133                         RegAllocStatsColored
 134                         { raGraph       = graph_colored
 135                         , raCoalesced   = rmCoalesce
 136                         , raPatched     = code_patched
 137                         , raSpillClean  = code_spillclean
 138                         , raFinal       = code_final
 139                         , raSRMs        = foldl addSRM (0, 0, 0) $ map countSRMs code_spillclean }
 140
 141                 return  ( code_final
 142                         , if dump
 143                                 then [stat] ++ maybeToList stat1 ++ debug_codeGraphs
 144                                 else []
 145                         , graph_colored)
 146
 147          else do
 148                 -- spill the uncolored regs
 149                 (code_spilled, slotsFree', spillStats)
 150                         <- regSpill code_coalesced slotsFree rsSpill
 151
 152                 -- recalculate liveness
 153                 let code_nat    = map stripLive code_spilled
 154                 code_relive     <- mapM regLiveness code_nat
 155
 156                 -- record what happened in this stage for debugging
 157                 let stat        =
 158                         RegAllocStatsSpill
 159                         { raGraph       = graph_colored
 160                         , raCoalesced   = rmCoalesce
 161                         , raSpillStats  = spillStats
 162                         , raLifetimes   = fmLife
 163                         , raSpilled     = code_spilled }
 164
 165                 -- try again
 166                 regAlloc_spin dump (spinCount + 1) triv regsFree slotsFree'
 167                         (if dump
 168                                 then [stat] ++ maybeToList stat1 ++ debug_codeGraphs
 169                                 else [])
 170                         code_relive
 171
 172
 173 -----
 174 -- Simple maxconflicts isn't always good, because we
 175 --      can naievely end up spilling vregs that only live for one or two instrs.
 176 --
 177 {-
 178 chooseSpill_maxConflicts
 179         :: Color.Graph Reg RegClass Reg
 180         -> Reg
 181
 182 chooseSpill_maxConflicts graph
 183  = let  node    = maximumBy
 184                         (\n1 n2 -> compare
 185                                 (sizeUniqSet $ Color.nodeConflicts n1)
 186                                 (sizeUniqSet $ Color.nodeConflicts n2))
 187                 $ eltsUFM $ Color.graphMap graph
 188
 189    in   Color.nodeId node
 190 -}
 191
 192 -----
 193 chooseSpill_maxLife
 194         :: UniqFM (Reg, Int)
 195         -> Color.Graph Reg RegClass Reg
 196         -> Reg
 197
 198 chooseSpill_maxLife life graph
 199  = let  node    = maximumBy (\n1 n2 -> compare (getLife n1) (getLife n2))
 200                 $ eltsUFM $ Color.graphMap graph
 201
 202         -- Orphan vregs die in the same instruction they are born in.
 203         --      They will be in the graph, but not in the liveness map.
 204         --      Their liveness is 0.
 205         getLife n
 206          = case lookupUFM life (Color.nodeId n) of
 207                 Just (_, l)     -> l
 208                 Nothing         -> 0
 209
 210    in   Color.nodeId node
 211
 212
 213 -- | Build a graph from the liveness and coalesce information in this code.
 214
 215 buildGraph
 216         :: [LiveCmmTop]
 217         -> UniqSM (Color.Graph Reg RegClass Reg)
 218
 219 buildGraph code
 220  = do
 221         -- Slurp out the conflicts and reg->reg moves from this code
 222         let (conflictList, moveList) =
 223                 unzip $ map slurpConflicts code
 224
 225         let conflictBag         = unionManyBags conflictList
 226         let moveBag             = unionManyBags moveList
 227
 228         -- Add the reg-reg conflicts to the graph
 229         let graph_conflict      = foldrBag graphAddConflictSet Color.initGraph conflictBag
 230
 231         -- Add the coalescences edges to the graph.
 232         let graph_coalesce      = foldrBag graphAddCoalesce graph_conflict moveBag
 233
 234         return  graph_coalesce
 235
 236
 237 -- | Add some conflict edges to the graph.
 238 --      Conflicts between virtual and real regs are recorded as exclusions.
 239 --
 240 graphAddConflictSet
 241         :: UniqSet Reg
 242         -> Color.Graph Reg RegClass Reg
 243         -> Color.Graph Reg RegClass Reg
 244
 245 graphAddConflictSet set graph
 246  = let  reals           = filterUFM isRealReg set
 247         virtuals        = filterUFM (not . isRealReg) set
 248
 249         graph1  = Color.addConflicts virtuals regClass graph
 250         graph2  = foldr (\(r1, r2) -> Color.addExclusion r1 regClass r2)
 251                         graph1
 252                         [ (a, b)
 253                                 | a <- uniqSetToList virtuals
 254                                 , b <- uniqSetToList reals]
 255
 256    in   graph2
 257
 258
 259 -- | Add some coalesence edges to the graph
 260 --      Coalesences between virtual and real regs are recorded as preferences.
 261 --
 262 graphAddCoalesce
 263         :: (Reg, Reg)
 264         -> Color.Graph Reg RegClass Reg
 265         -> Color.Graph Reg RegClass Reg
 266
 267 graphAddCoalesce (r1, r2) graph
 268         | RealReg _ <- r1
 269         = Color.addPreference (regWithClass r2) r1 graph
 270
 271         | RealReg _ <- r2
 272         = Color.addPreference (regWithClass r1) r2 graph
 273
 274         | otherwise
 275         = Color.addCoalesce (regWithClass r1) (regWithClass r2) graph
 276
 277         where   regWithClass r  = (r, regClass r)
 278
 279
 280 -- | Patch registers in code using the reg -> reg mapping in this graph.
 281 patchRegsFromGraph
 282         :: Color.Graph Reg RegClass Reg
 283         -> LiveCmmTop -> LiveCmmTop
 284
 285 patchRegsFromGraph graph code
 286  = let
 287         -- a function to lookup the hardreg for a virtual reg from the graph.
 288         patchF reg
 289                 -- leave real regs alone.
 290                 | isRealReg reg
 291                 = reg
 292
 293                 -- this virtual has a regular node in the graph.
 294                 | Just node     <- Color.lookupNode graph reg
 295                 = case Color.nodeColor node of
 296                         Just color      -> color
 297                         Nothing         -> reg
 298
 299                 -- no node in the graph for this virtual, bad news.
 300                 | otherwise
 301                 = pprPanic "patchRegsFromGraph: register mapping failed."
 302                         (  text "There is no node in the graph for register " <> ppr reg
 303                         $$ ppr code
 304                         $$ Color.dotGraph (\_ -> text "white") trivColorable graph)
 305
 306    in   patchEraseLive patchF code
 307
 308
 309 plusUFMs_C  :: (elt -> elt -> elt) -> [UniqFM elt] -> UniqFM elt
 310 plusUFMs_C f maps
 311         = foldl (plusUFM_C f) emptyUFM maps
 312