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
 108                 return  ( code_nat
 109                         , debug_codeGraphs ++ [stat]
 110                         , graph_colored)
 111
 112          else do
 113                 -- spill the uncolored regs
 114                 (code_spilled, slotsFree', spillStats)
 115                         <- regSpill code slotsFree rsSpill
 116
 117                 -- recalculate liveness
 118                 let code_nat    = map stripLive code_spilled
 119                 code_relive     <- mapM regLiveness code_nat
 120
 121                 -- record what happened in this stage for debugging
 122                 let stat        =
 123                         RegAllocStatsSpill
 124                         { raLiveCmm     = code_spilled
 125                         , raGraph       = graph_colored
 126                         , raSpillStats  = spillStats }
 127
 128                 -- try again
 129                 regAlloc_spin (spinCount + 1) triv regsFree slotsFree'
 130                         (debug_codeGraphs ++ [stat])
 131                         code_relive
 132
 133
 134 -----
 135 -- Simple maxconflicts isn't always good, because we
 136 --      can naievely end up spilling vregs that only live for one or two instrs.
 137 --
 138 {-
 139 chooseSpill_maxConflicts
 140         :: Color.Graph Reg RegClass Reg
 141         -> Reg
 142
 143 chooseSpill_maxConflicts graph
 144  = let  node    = maximumBy
 145                         (\n1 n2 -> compare
 146                                 (sizeUniqSet $ Color.nodeConflicts n1)
 147                                 (sizeUniqSet $ Color.nodeConflicts n2))
 148                 $ eltsUFM $ Color.graphMap graph
 149
 150    in   Color.nodeId node
 151 -}
 152
 153 -----
 154 chooseSpill_maxLife
 155         :: UniqFM (Reg, Int)
 156         -> Color.Graph Reg RegClass Reg
 157         -> Reg
 158
 159 chooseSpill_maxLife life graph
 160  = let  node    = maximumBy (\n1 n2 -> compare (getLife n1) (getLife n2))
 161                 $ eltsUFM $ Color.graphMap graph
 162
 163         -- Orphan vregs die in the same instruction they are born in.
 164         --      They will be in the graph, but not in the liveness map.
 165         --      Their liveness is 0.
 166         getLife n
 167          = case lookupUFM life (Color.nodeId n) of
 168                 Just (_, l)     -> l
 169                 Nothing         -> 0
 170
 171    in   Color.nodeId node
 172
 173
 174 -- | Build a graph from the liveness and coalesce information in this code.
 175
 176 buildGraph
 177         :: [LiveCmmTop]
 178         -> UniqSM (Color.Graph Reg RegClass Reg)
 179
 180 buildGraph code
 181  = do
 182         -- Add the reg-reg conflicts to the graph
 183         let conflictSets        = unionManyBags (map slurpConflicts code)
 184         let graph_conflict      = foldrBag graphAddConflictSet Color.initGraph conflictSets
 185
 186
 187         -- Add the coalescences edges to the graph.
 188         let coalesce            = unionManyBags (map slurpJoinMovs code)
 189         let graph_coalesce      = foldrBag graphAddCoalesce graph_conflict coalesce
 190
 191         return  $ graph_coalesce
 192
 193
 194 -- | Add some conflict edges to the graph.
 195 --      Conflicts between virtual and real regs are recorded as exlusions.
 196 --
 197 graphAddConflictSet
 198         :: UniqSet Reg
 199         -> Color.Graph Reg RegClass Reg
 200         -> Color.Graph Reg RegClass Reg
 201
 202 graphAddConflictSet set graph
 203  = let  reals           = filterUFM isRealReg set
 204         virtuals        = filterUFM (not . isRealReg) set
 205
 206         graph1  = Color.addConflicts virtuals regClass graph
 207         graph2  = foldr (\(r1, r2) -> Color.addExclusion r1 regClass r2)
 208                         graph1
 209                         [ (a, b)
 210                                 | a <- uniqSetToList virtuals
 211                                 , b <- uniqSetToList reals]
 212
 213    in   graph2
 214
 215
 216 -- | Add some coalesences edges to the graph
 217 --      Coalesences between virtual and real regs are recorded as preferences.
 218 --
 219 graphAddCoalesce
 220         :: (Reg, Reg)
 221         -> Color.Graph Reg RegClass Reg
 222         -> Color.Graph Reg RegClass Reg
 223
 224 graphAddCoalesce (r1, r2) graph
 225         | RealReg regno <- r1
 226         = Color.addPreference (regWithClass r2) r1 graph
 227
 228         | RealReg regno <- r2
 229         = Color.addPreference (regWithClass r1) r2 graph
 230
 231         | otherwise
 232         = Color.addCoalesce (regWithClass r1) (regWithClass r2) graph
 233
 234         where   regWithClass r  = (r, regClass r)
 235
 236
 237 -- | Patch registers in code using the reg -> reg mapping in this graph.
 238 patchRegsFromGraph
 239         :: Color.Graph Reg RegClass Reg
 240         -> LiveCmmTop -> LiveCmmTop
 241
 242 patchRegsFromGraph graph code
 243  = let
 244         -- a function to lookup the hardreg for a virtual reg from the graph.
 245         patchF reg
 246                 -- leave real regs alone.
 247                 | isRealReg reg
 248                 = reg
 249
 250                 -- this virtual has a regular node in the graph.
 251                 | Just node     <- Color.lookupNode graph reg
 252                 = case Color.nodeColor node of
 253                         Just color      -> color
 254                         Nothing         -> reg
 255
 256                 -- no node in the graph for this virtual, bad news.
 257                 | otherwise
 258                 = pprPanic "patchRegsFromGraph: register mapping failed."
 259                         (  text "There is no node in the graph for register " <> ppr reg
 260                         $$ ppr code
 261                         $$ Color.dotGraph (\x -> text "white") trivColorable graph)
 262
 263    in   patchEraseLive patchF code
 264
 265
 266 plusUFMs_C  :: (elt -> elt -> elt) -> [UniqFM elt] -> UniqFM elt
 267 plusUFMs_C f maps
 268         = foldl (plusUFM_C f) emptyUFM maps
 269