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 #include "nativeGen/NCG.h"
  24
  25 import qualified GraphColor     as Color
  26 import RegLiveness
  27 import RegSpill
  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         :: UniqFM (UniqSet Reg)                         -- ^ the registers we can use for allocation
  55         -> UniqSet Int                                  -- ^ the set of available spill slots.
  56         -> [LiveCmmTop]                                 -- ^ code annotated with liveness information.
  57         -> UniqSM
  58                 ( [NatCmmTop]                           -- ^ code with registers allocated.
  59                 , [ ( [LiveCmmTop]
  60                     , Color.Graph Reg RegClass Reg) ])  -- ^ code and graph for each pass
  61
  62 regAlloc regsFree slotsFree code
  63  = do
  64         (code_final, debug_codeGraphs, graph_final)
  65                 <- regAlloc_spin 0 trivColorable regsFree slotsFree [] code
  66
  67         return  ( code_final
  68                 , debug_codeGraphs )
  69
  70 regAlloc_spin (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 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         -- the function to choose regs to leave uncolored
  90         let spill       = chooseSpill_maxLife fmLife
  91
  92         -- try and color the graph
  93         let (graph_colored, rsSpill)
  94                         = Color.colorGraph regsFree triv spill graph
  95
  96         -- see if we've found a coloring
  97         if isEmptyUniqSet rsSpill
  98          then do
  99                 -- patch the registers using the info in the graph
 100                 let code_patched        = map (patchRegsFromGraph graph_colored) code
 101                 let code_nat            = map stripLive code_patched
 102
 103                 return  ( code_nat
 104                         , debug_codeGraphs ++ [(code, graph_colored), (code_patched, graph_colored)]
 105                         , graph_colored)
 106
 107          else do
 108                 -- spill the uncolored regs
 109                 (code_spilled, slotsFree')
 110                         <- regSpill code slotsFree rsSpill
 111
 112                 -- recalculate liveness
 113                 let code_nat    = map stripLive code_spilled
 114                 code_relive     <- mapM regLiveness code_nat
 115
 116                 -- try again
 117                 regAlloc_spin (spinCount + 1) triv regsFree slotsFree'
 118                         (debug_codeGraphs ++ [(code, graph_colored)])
 119                         code_relive
 120
 121
 122 -----
 123 -- Simple maxconflicts isn't always good, because we
 124 --      can naievely end up spilling vregs that only live for one or two instrs.
 125 --
 126 {-
 127 chooseSpill_maxConflicts
 128         :: Color.Graph Reg RegClass Reg
 129         -> Reg
 130
 131 chooseSpill_maxConflicts graph
 132  = let  node    = maximumBy
 133                         (\n1 n2 -> compare
 134                                 (sizeUniqSet $ Color.nodeConflicts n1)
 135                                 (sizeUniqSet $ Color.nodeConflicts n2))
 136                 $ eltsUFM $ Color.graphMap graph
 137
 138    in   Color.nodeId node
 139 -}
 140
 141 -----
 142 chooseSpill_maxLife
 143         :: UniqFM (Reg, Int)
 144         -> Color.Graph Reg RegClass Reg
 145         -> Reg
 146
 147 chooseSpill_maxLife life graph
 148  = let  node    = maximumBy (\n1 n2 -> compare (getLife n1) (getLife n2))
 149                 $ eltsUFM $ Color.graphMap graph
 150
 151         -- Orphan vregs die in the same instruction they are born in.
 152         --      They will be in the graph, but not in the liveness map.
 153         --      Their liveness is 0.
 154         getLife n
 155          = case lookupUFM life (Color.nodeId n) of
 156                 Just (_, l)     -> l
 157                 Nothing         -> 0
 158
 159    in   Color.nodeId node
 160
 161
 162 -- | Build a graph from the liveness and coalesce information in this code.
 163
 164 buildGraph
 165         :: [LiveCmmTop]
 166         -> UniqSM (Color.Graph Reg RegClass Reg)
 167
 168 buildGraph code
 169  = do
 170         -- Add the reg-reg conflicts to the graph
 171         let conflictSets        = unionManyBags (map slurpConflicts code)
 172         let graph_conflict      = foldrBag graphAddConflictSet Color.initGraph conflictSets
 173
 174
 175         -- Add the coalescences edges to the graph.
 176         let coalesce            = unionManyBags (map slurpJoinMovs code)
 177         let graph_coalesce      = foldrBag graphAddCoalesce graph_conflict coalesce
 178
 179         return  $ graph_coalesce
 180
 181
 182 -- | Add some conflict edges to the graph.
 183 --      Conflicts between virtual and real regs are recorded as exlusions.
 184 --
 185 graphAddConflictSet
 186         :: UniqSet Reg
 187         -> Color.Graph Reg RegClass Reg
 188         -> Color.Graph Reg RegClass Reg
 189
 190 graphAddConflictSet set graph
 191  = let  reals           = filterUFM isRealReg set
 192         virtuals        = filterUFM (not . isRealReg) set
 193
 194         graph1  = Color.addConflicts virtuals regClass graph
 195         graph2  = foldr (\(r1, r2) -> Color.addExclusion r1 regClass r2)
 196                         graph1
 197                         [ (a, b)
 198                                 | a <- uniqSetToList virtuals
 199                                 , b <- uniqSetToList reals]
 200
 201    in   graph2
 202
 203
 204 -- | Add some coalesences edges to the graph
 205 --      Coalesences between virtual and real regs are recorded as preferences.
 206 --
 207 graphAddCoalesce
 208         :: (Reg, Reg)
 209         -> Color.Graph Reg RegClass Reg
 210         -> Color.Graph Reg RegClass Reg
 211
 212 graphAddCoalesce (r1, r2) graph
 213         | RealReg regno <- r1
 214         = Color.addPreference (regWithClass r2) r1 graph
 215
 216         | RealReg regno <- r2
 217         = Color.addPreference (regWithClass r1) r2 graph
 218
 219         | otherwise
 220         = Color.addCoalesce (regWithClass r1) (regWithClass r2) graph
 221
 222         where   regWithClass r  = (r, regClass r)
 223
 224
 225 -- | Patch registers in code using the reg -> reg mapping in this graph.
 226 patchRegsFromGraph
 227         :: Color.Graph Reg RegClass Reg
 228         -> LiveCmmTop -> LiveCmmTop
 229
 230 patchRegsFromGraph graph code
 231  = let
 232         -- a function to lookup the hardreg for a virtual reg from the graph.
 233         patchF reg
 234                 -- leave real regs alone.
 235                 | isRealReg reg
 236                 = reg
 237
 238                 -- this virtual has a regular node in the graph.
 239                 | Just node     <- Color.lookupNode graph reg
 240                 = case Color.nodeColor node of
 241                         Just color      -> color
 242                         Nothing         -> reg
 243
 244                 -- no node in the graph for this virtual, bad news.
 245                 | otherwise
 246                 = pprPanic "patchRegsFromGraph: register mapping failed."
 247                         (  text "There is no node in the graph for register " <> ppr reg
 248                         $$ ppr code
 249                         $$ Color.dotGraph (\x -> text "white") trivColorable graph)
 250
 251    in   patchEraseLive patchF code
 252
 253
 254 -----
 255 -- Register colors for drawing conflict graphs
 256 --      Keep this out of MachRegs.hs because it's specific to the graph coloring allocator.
 257
 258
 259 -- reg colors for x86
 260 #if i386_TARGET_ARCH
 261 regDotColor :: Reg -> SDoc
 262 regDotColor reg
 263  = let  Just    str     = lookupUFM regColors reg
 264    in   text str
 265
 266 regColors
 267  = listToUFM
 268  $      [ (eax, "#00ff00")
 269         , (ebx, "#0000ff")
 270         , (ecx, "#00ffff")
 271         , (edx, "#0080ff")
 272
 273         , (fake0, "#ff00ff")
 274         , (fake1, "#ff00aa")
 275         , (fake2, "#aa00ff")
 276         , (fake3, "#aa00aa")
 277         , (fake4, "#ff0055")
 278         , (fake5, "#5500ff") ]
 279 #endif
 280
 281
 282 -- reg colors for x86_64
 283 #if x86_64_TARGET_ARCH
 284 regDotColor :: Reg -> SDoc
 285 regDotColor reg
 286  = let  Just    str     = lookupUFM regColors reg
 287    in   text str
 288
 289 regColors
 290  = listToUFM
 291  $      [ (rax, "#00ff00"), (eax, "#00ff00")
 292         , (rbx, "#0000ff"), (ebx, "#0000ff")
 293         , (rcx, "#00ffff"), (ecx, "#00ffff")
 294         , (rdx, "#0080ff"), (edx, "#00ffff")
 295         , (r8,  "#00ff80")
 296         , (r9,  "#008080")
 297         , (r10, "#0040ff")
 298         , (r11, "#00ff40")
 299         , (r12, "#008040")
 300         , (r13, "#004080")
 301         , (r14, "#004040")
 302         , (r15, "#002080") ]
 303
 304         ++ zip (map RealReg [16..31]) (repeat "red")
 305 #endif
 306
 307
 308 -- reg colors for ppc
 309 #if powerpc_TARGET_ARCH
 310 regDotColor :: Reg -> SDoc
 311 regDotColor reg
 312  = case regClass reg of
 313         RcInteger       -> text "blue"
 314         RcFloat         -> text "red"
 315 #endif
 316
 317
 318 {-
 319 toX11Color (r, g, b)
 320  = let  rs      = padL 2 '0' (showHex r "")
 321         gs      = padL 2 '0' (showHex r "")
 322         bs      = padL 2 '0' (showHex r "")
 323
 324         padL n c s
 325                 = replicate (n - length s) c ++ s
 326   in    "#" ++ rs ++ gs ++ bs
 327 -}
 328
 329 plusUFMs_C  :: (elt -> elt -> elt) -> [UniqFM elt] -> UniqFM elt
 330 plusUFMs_C f maps
 331         = foldl (plusUFM_C f) emptyUFM maps
 332