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 RegSpillClean
  27 import RegAllocStats
  28 import MachRegs
  29 import MachInstrs
  30 import RegCoalesce
  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, graph_final)
  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           <- 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         let fmLife      = plusUFMs_C (\(r1, l1) (r2, l2) -> (r1, l1 + l2))
  87                         $ map lifetimeCount code
  88
  89         -- record startup state
  90         let stat1       =
  91                 if spinCount == 0
  92                  then   Just $ RegAllocStatsStart
  93                         { raLiveCmm     = code
  94                         , raGraph       = graph
  95                         , raLifetimes   = fmLife }
  96                  else   Nothing
  97
  98
  99         -- the function to choose regs to leave uncolored
 100         let spill       = chooseSpill_maxLife fmLife
 101
 102         -- try and color the graph
 103         let (graph_colored, rsSpill)
 104                         = Color.colorGraph regsFree triv spill graph
 105
 106         -- see if we've found a coloring
 107         if isEmptyUniqSet rsSpill
 108          then do
 109                 -- patch the registers using the info in the graph
 110                 let code_patched        = map (patchRegsFromGraph graph_colored) code
 111
 112                 -- clean out unneeded SPILL/RELOADs
 113                 let code_spillclean     = map cleanSpills code_patched
 114
 115                 -- strip off liveness information
 116                 let code_nat            = map stripLive code_patched
 117
 118                 -- rewrite SPILL/REALOAD pseudos into real instructions
 119                 let spillNatTop         = mapGenBlockTop spillNatBlock
 120                 let code_final          = map spillNatTop code_nat
 121
 122                 -- record what happened in this stage for debugging
 123                 let stat                =
 124                         RegAllocStatsColored
 125                         { raGraph       = graph_colored
 126                         , raPatched     = code_patched
 127                         , raSpillClean  = code_spillclean
 128                         , raFinal       = code_final
 129                         , raSRMs        = foldl addSRM (0, 0, 0) $ map countSRMs code_spillclean }
 130
 131                 return  ( code_final
 132                         , if dump
 133                                 then [stat] ++ maybeToList stat1 ++ debug_codeGraphs
 134                                 else []
 135                         , graph_colored)
 136
 137          else do
 138                 -- spill the uncolored regs
 139                 (code_spilled, slotsFree', spillStats)
 140                         <- regSpill code slotsFree rsSpill
 141
 142                 -- recalculate liveness
 143                 let code_nat    = map stripLive code_spilled
 144                 code_relive     <- mapM regLiveness code_nat
 145
 146                 -- record what happened in this stage for debugging
 147                 let stat        =
 148                         RegAllocStatsSpill
 149                         { raGraph       = graph_colored
 150                         , raSpillStats  = spillStats
 151                         , raLifetimes   = fmLife
 152                         , raSpilled     = code_spilled }
 153
 154                 -- try again
 155                 regAlloc_spin dump (spinCount + 1) triv regsFree slotsFree'
 156                         (if dump
 157                                 then [stat] ++ maybeToList stat1 ++ debug_codeGraphs
 158                                 else [])
 159                         code_relive
 160
 161
 162 -----
 163 -- Simple maxconflicts isn't always good, because we
 164 --      can naievely end up spilling vregs that only live for one or two instrs.
 165 --
 166 {-
 167 chooseSpill_maxConflicts
 168         :: Color.Graph Reg RegClass Reg
 169         -> Reg
 170
 171 chooseSpill_maxConflicts graph
 172  = let  node    = maximumBy
 173                         (\n1 n2 -> compare
 174                                 (sizeUniqSet $ Color.nodeConflicts n1)
 175                                 (sizeUniqSet $ Color.nodeConflicts n2))
 176                 $ eltsUFM $ Color.graphMap graph
 177
 178    in   Color.nodeId node
 179 -}
 180
 181 -----
 182 chooseSpill_maxLife
 183         :: UniqFM (Reg, Int)
 184         -> Color.Graph Reg RegClass Reg
 185         -> Reg
 186
 187 chooseSpill_maxLife life graph
 188  = let  node    = maximumBy (\n1 n2 -> compare (getLife n1) (getLife n2))
 189                 $ eltsUFM $ Color.graphMap graph
 190
 191         -- Orphan vregs die in the same instruction they are born in.
 192         --      They will be in the graph, but not in the liveness map.
 193         --      Their liveness is 0.
 194         getLife n
 195          = case lookupUFM life (Color.nodeId n) of
 196                 Just (_, l)     -> l
 197                 Nothing         -> 0
 198
 199    in   Color.nodeId node
 200
 201
 202 -- | Build a graph from the liveness and coalesce information in this code.
 203
 204 buildGraph
 205         :: [LiveCmmTop]
 206         -> UniqSM (Color.Graph Reg RegClass Reg)
 207
 208 buildGraph code
 209  = do
 210         -- Add the reg-reg conflicts to the graph
 211         let conflictSets        = unionManyBags (map slurpConflicts code)
 212         let graph_conflict      = foldrBag graphAddConflictSet Color.initGraph conflictSets
 213
 214
 215         -- Add the coalescences edges to the graph.
 216         let coalesce            = unionManyBags (map slurpJoinMovs code)
 217         let graph_coalesce      = foldrBag graphAddCoalesce graph_conflict coalesce
 218
 219         return  $ graph_coalesce
 220
 221
 222 -- | Add some conflict edges to the graph.
 223 --      Conflicts between virtual and real regs are recorded as exclusions.
 224 --
 225 graphAddConflictSet
 226         :: UniqSet Reg
 227         -> Color.Graph Reg RegClass Reg
 228         -> Color.Graph Reg RegClass Reg
 229
 230 graphAddConflictSet set graph
 231  = let  reals           = filterUFM isRealReg set
 232         virtuals        = filterUFM (not . isRealReg) set
 233
 234         graph1  = Color.addConflicts virtuals regClass graph
 235         graph2  = foldr (\(r1, r2) -> Color.addExclusion r1 regClass r2)
 236                         graph1
 237                         [ (a, b)
 238                                 | a <- uniqSetToList virtuals
 239                                 , b <- uniqSetToList reals]
 240
 241    in   graph2
 242
 243
 244 -- | Add some coalesence edges to the graph
 245 --      Coalesences between virtual and real regs are recorded as preferences.
 246 --
 247 graphAddCoalesce
 248         :: (Reg, Reg)
 249         -> Color.Graph Reg RegClass Reg
 250         -> Color.Graph Reg RegClass Reg
 251
 252 graphAddCoalesce (r1, r2) graph
 253         | RealReg regno <- r1
 254         = Color.addPreference (regWithClass r2) r1 graph
 255
 256         | RealReg regno <- r2
 257         = Color.addPreference (regWithClass r1) r2 graph
 258
 259         | otherwise
 260         = Color.addCoalesce (regWithClass r1) (regWithClass r2) graph
 261
 262         where   regWithClass r  = (r, regClass r)
 263
 264
 265 -- | Patch registers in code using the reg -> reg mapping in this graph.
 266 patchRegsFromGraph
 267         :: Color.Graph Reg RegClass Reg
 268         -> LiveCmmTop -> LiveCmmTop
 269
 270 patchRegsFromGraph graph code
 271  = let
 272         -- a function to lookup the hardreg for a virtual reg from the graph.
 273         patchF reg
 274                 -- leave real regs alone.
 275                 | isRealReg reg
 276                 = reg
 277
 278                 -- this virtual has a regular node in the graph.
 279                 | Just node     <- Color.lookupNode graph reg
 280                 = case Color.nodeColor node of
 281                         Just color      -> color
 282                         Nothing         -> reg
 283
 284                 -- no node in the graph for this virtual, bad news.
 285                 | otherwise
 286                 = pprPanic "patchRegsFromGraph: register mapping failed."
 287                         (  text "There is no node in the graph for register " <> ppr reg
 288                         $$ ppr code
 289                         $$ Color.dotGraph (\x -> text "white") trivColorable graph)
 290
 291    in   patchEraseLive patchF code
 292
 293
 294 plusUFMs_C  :: (elt -> elt -> elt) -> [UniqFM elt] -> UniqFM elt
 295 plusUFMs_C f maps
 296         = foldl (plusUFM_C f) emptyUFM maps
 297