compiler/nativeGen/RegAllocStats.hs

   1 {-# OPTIONS -fno-warn-missing-signatures #-}
   2 -- Carries interesting info for debugging / profiling of the
   3 --      graph coloring register allocator.
   4 --
   5
   6 module RegAllocStats (
   7         RegAllocStats (..),
   8         regDotColor,
   9
  10         pprStats,
  11         pprStatsSpills,
  12         pprStatsLifetimes,
  13         pprStatsConflict,
  14         pprStatsLifeConflict,
  15
  16         countSRMs, addSRM
  17 )
  18
  19 where
  20
  21 #include "nativeGen/NCG.h"
  22
  23 import qualified GraphColor as Color
  24 import RegLiveness
  25 import RegAllocInfo
  26 import RegSpill
  27 import RegSpillCost
  28 import MachRegs
  29 import MachInstrs
  30 import Cmm
  31
  32 import Outputable
  33 import UniqFM
  34 import UniqSet
  35 import State
  36
  37 import Data.List
  38
  39 data RegAllocStats
  40
  41         -- initial graph
  42         = RegAllocStatsStart
  43         { raLiveCmm     :: [LiveCmmTop]                   -- ^ initial code, with liveness
  44         , raGraph       :: Color.Graph Reg RegClass Reg   -- ^ the initial, uncolored graph
  45         , raSpillCosts  :: SpillCostInfo }                -- ^ information to help choose which regs to spill
  46
  47         -- a spill stage
  48         | RegAllocStatsSpill
  49         { raGraph       :: Color.Graph Reg RegClass Reg -- ^ the partially colored graph
  50         , raCoalesced   :: UniqFM Reg                   -- ^ the regs that were coaleced
  51         , raSpillStats  :: SpillStats                   -- ^ spiller stats
  52         , raSpillCosts  :: SpillCostInfo                -- ^ number of instrs each reg lives for
  53         , raSpilled     :: [LiveCmmTop] }               -- ^ code with spill instructions added
  54
  55         -- a successful coloring
  56         | RegAllocStatsColored
  57         { raGraph        :: Color.Graph Reg RegClass Reg -- ^ the uncolored graph
  58         , raGraphColored :: Color.Graph Reg RegClass Reg -- ^ the coalesced and colored graph
  59         , raCoalesced   :: UniqFM Reg                   -- ^ the regs that were coaleced
  60         , raPatched     :: [LiveCmmTop]                 -- ^ code with vregs replaced by hregs
  61         , raSpillClean  :: [LiveCmmTop]                 -- ^ code with unneeded spill/reloads cleaned out
  62         , raFinal       :: [NatCmmTop]                  -- ^ final code
  63         , raSRMs        :: (Int, Int, Int) }            -- ^ spill/reload/reg-reg moves present in this code
  64
  65 instance Outputable RegAllocStats where
  66
  67  ppr (s@RegAllocStatsStart{})
  68         =  text "#  Start"
  69         $$ text "#  Native code with liveness information."
  70         $$ ppr (raLiveCmm s)
  71         $$ text ""
  72         $$ text "#  Initial register conflict graph."
  73         $$ Color.dotGraph regDotColor trivColorable (raGraph s)
  74
  75
  76  ppr (s@RegAllocStatsSpill{})
  77         =  text "#  Spill"
  78
  79         $$ text "#  Register conflict graph."
  80         $$ Color.dotGraph regDotColor trivColorable (raGraph s)
  81         $$ text ""
  82
  83         $$ (if (not $ isNullUFM $ raCoalesced s)
  84                 then    text "#  Registers coalesced."
  85                         $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
  86                         $$ text ""
  87                 else empty)
  88
  89         $$ text "#  Spill costs.  reg uses defs lifetime degree cost"
  90         $$ vcat (map (pprSpillCostRecord (raGraph s)) $ eltsUFM $ raSpillCosts s)
  91         $$ text ""
  92
  93         $$ text "#  Spills inserted."
  94         $$ ppr (raSpillStats s)
  95         $$ text ""
  96
  97         $$ text "#  Code with spills inserted."
  98         $$ (ppr (raSpilled s))
  99
 100
 101  ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
 102         =  text "#  Colored"
 103
 104         $$ text "#  Register conflict graph (initial)."
 105         $$ Color.dotGraph regDotColor trivColorable (raGraph s)
 106         $$ text ""
 107
 108         $$ text "#  Register conflict graph (colored)."
 109         $$ Color.dotGraph regDotColor trivColorable (raGraphColored s)
 110         $$ text ""
 111
 112         $$ (if (not $ isNullUFM $ raCoalesced s)
 113                 then    text "#  Registers coalesced."
 114                         $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
 115                         $$ text ""
 116                 else empty)
 117
 118         $$ text "#  Native code after register allocation."
 119         $$ ppr (raPatched s)
 120         $$ text ""
 121
 122         $$ text "#  Clean out unneeded spill/reloads."
 123         $$ ppr (raSpillClean s)
 124         $$ text ""
 125
 126         $$ text "#  Final code, after rewriting spill/rewrite pseudo instrs."
 127         $$ ppr (raFinal s)
 128         $$ text ""
 129         $$  text "#  Score:"
 130         $$ (text "#          spills  inserted: " <> int spills)
 131         $$ (text "#          reloads inserted: " <> int reloads)
 132         $$ (text "#   reg-reg moves remaining: " <> int moves)
 133         $$ text ""
 134
 135 -- | Do all the different analysis on this list of RegAllocStats
 136 pprStats :: [RegAllocStats] -> Color.Graph Reg RegClass Reg -> SDoc
 137 pprStats stats graph
 138  = let  outSpills       = pprStatsSpills    stats
 139         outLife         = pprStatsLifetimes stats
 140         outConflict     = pprStatsConflict  stats
 141         outScatter      = pprStatsLifeConflict stats graph
 142
 143   in    vcat [outSpills, outLife, outConflict, outScatter]
 144
 145
 146 -- | Dump a table of how many spill loads / stores were inserted for each vreg.
 147 pprStatsSpills
 148         :: [RegAllocStats] -> SDoc
 149
 150 pprStatsSpills stats
 151  = let
 152         finals  = [ s   | s@RegAllocStatsColored{} <- stats]
 153
 154         -- sum up how many stores/loads/reg-reg-moves were left in the code
 155         total   = foldl' addSRM (0, 0, 0)
 156                 $ map raSRMs finals
 157
 158     in  (  text "-- spills-added-total"
 159         $$ text "--    (stores, loads, reg_reg_moves_remaining)"
 160         $$ ppr total
 161         $$ text "")
 162
 163
 164 -- | Dump a table of how long vregs tend to live for in the initial code.
 165 pprStatsLifetimes
 166         :: [RegAllocStats] -> SDoc
 167
 168 pprStatsLifetimes stats
 169  = let  info            = foldl' plusSpillCostInfo zeroSpillCostInfo
 170                                 [ raSpillCosts s
 171                                         | s@RegAllocStatsStart{} <- stats ]
 172
 173         lifeBins        = binLifetimeCount $ lifeMapFromSpillCostInfo info
 174
 175    in   (  text "-- vreg-population-lifetimes"
 176         $$ text "--   (instruction_count, number_of_vregs_that_lived_that_long)"
 177         $$ (vcat $ map ppr $ eltsUFM lifeBins)
 178         $$ text "\n")
 179
 180 binLifetimeCount :: UniqFM (Reg, Int) -> UniqFM (Int, Int)
 181 binLifetimeCount fm
 182  = let  lifes   = map (\l -> (l, (l, 1)))
 183                 $ map snd
 184                 $ eltsUFM fm
 185
 186    in   addListToUFM_C
 187                 (\(l1, c1) (_, c2) -> (l1, c1 + c2))
 188                 emptyUFM
 189                 lifes
 190
 191
 192 -- | Dump a table of how many conflicts vregs tend to have in the initial code.
 193 pprStatsConflict
 194         :: [RegAllocStats] -> SDoc
 195
 196 pprStatsConflict stats
 197  = let  confMap = foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
 198                         emptyUFM
 199                 $ map Color.slurpNodeConflictCount
 200                         [ raGraph s | s@RegAllocStatsStart{} <- stats ]
 201
 202    in   (  text "-- vreg-conflicts"
 203         $$ text "--   (conflict_count, number_of_vregs_that_had_that_many_conflicts)"
 204         $$ (vcat $ map ppr $ eltsUFM confMap)
 205         $$ text "\n")
 206
 207
 208 -- | For every vreg, dump it's how many conflicts it has and its lifetime
 209 --      good for making a scatter plot.
 210 pprStatsLifeConflict
 211         :: [RegAllocStats]
 212         -> Color.Graph Reg RegClass Reg         -- ^ global register conflict graph
 213         -> SDoc
 214
 215 pprStatsLifeConflict stats graph
 216  = let  lifeMap = lifeMapFromSpillCostInfo
 217                 $ foldl' plusSpillCostInfo zeroSpillCostInfo
 218                 $ [ raSpillCosts s | s@RegAllocStatsStart{} <- stats ]
 219
 220         scatter = map   (\r ->  let lifetime    = case lookupUFM lifeMap r of
 221                                                         Just (_, l)     -> l
 222                                                         Nothing         -> 0
 223                                     Just node   = Color.lookupNode graph r
 224                                 in parens $ hcat $ punctuate (text ", ")
 225                                         [ doubleQuotes $ ppr $ Color.nodeId node
 226                                         , ppr $ sizeUniqSet (Color.nodeConflicts node)
 227                                         , ppr $ lifetime ])
 228                 $ map Color.nodeId
 229                 $ eltsUFM
 230                 $ Color.graphMap graph
 231
 232    in   (  text "-- vreg-conflict-lifetime"
 233         $$ text "--   (vreg, vreg_conflicts, vreg_lifetime)"
 234         $$ (vcat scatter)
 235         $$ text "\n")
 236
 237
 238 -- | Count spill/reload/reg-reg moves.
 239 --      Lets us see how well the register allocator has done.
 240 --
 241 countSRMs :: LiveCmmTop -> (Int, Int, Int)
 242 countSRMs cmm
 243         = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0)
 244
 245 countSRM_block (BasicBlock i instrs)
 246  = do   instrs' <- mapM countSRM_instr instrs
 247         return  $ BasicBlock i instrs'
 248
 249 countSRM_instr li@(Instr instr _)
 250         | SPILL _ _     <- instr
 251         = do    modify  $ \(s, r, m)    -> (s + 1, r, m)
 252                 return li
 253
 254         | RELOAD _ _    <- instr
 255         = do    modify  $ \(s, r, m)    -> (s, r + 1, m)
 256                 return li
 257
 258         | Just _                <- isRegRegMove instr
 259         = do    modify  $ \(s, r, m)    -> (s, r, m + 1)
 260                 return li
 261
 262         | otherwise
 263         =       return li
 264
 265 -- sigh..
 266 addSRM (s1, r1, m1) (s2, r2, m2)
 267         = (s1+s2, r1+r2, m1+m2)
 268
 269 -----
 270 -- Register colors for drawing conflict graphs
 271 --      Keep this out of MachRegs.hs because it's specific to the graph coloring allocator.
 272
 273
 274 -- reg colors for x86
 275 #if i386_TARGET_ARCH
 276 regDotColor :: Reg -> SDoc
 277 regDotColor reg
 278  = let  Just    str     = lookupUFM regColors reg
 279    in   text str
 280
 281 regColors
 282  = listToUFM
 283  $      [ (eax, "#00ff00")
 284         , (ebx, "#0000ff")
 285         , (ecx, "#00ffff")
 286         , (edx, "#0080ff")
 287
 288         , (fake0, "#ff00ff")
 289         , (fake1, "#ff00aa")
 290         , (fake2, "#aa00ff")
 291         , (fake3, "#aa00aa")
 292         , (fake4, "#ff0055")
 293         , (fake5, "#5500ff") ]
 294 #endif
 295
 296
 297 -- reg colors for x86_64
 298 #if x86_64_TARGET_ARCH
 299 regDotColor :: Reg -> SDoc
 300 regDotColor reg
 301  = let  Just    str     = lookupUFM regColors reg
 302    in   text str
 303
 304 regColors
 305  = listToUFM
 306  $      [ (rax, "#00ff00"), (eax, "#00ff00")
 307         , (rbx, "#0000ff"), (ebx, "#0000ff")
 308         , (rcx, "#00ffff"), (ecx, "#00ffff")
 309         , (rdx, "#0080ff"), (edx, "#00ffff")
 310         , (r8,  "#00ff80")
 311         , (r9,  "#008080")
 312         , (r10, "#0040ff")
 313         , (r11, "#00ff40")
 314         , (r12, "#008040")
 315         , (r13, "#004080")
 316         , (r14, "#004040")
 317         , (r15, "#002080") ]
 318
 319         ++ zip (map RealReg [16..31]) (repeat "red")
 320 #endif
 321
 322
 323 -- reg colors for ppc
 324 #if powerpc_TARGET_ARCH
 325 regDotColor :: Reg -> SDoc
 326 regDotColor reg
 327  = case regClass reg of
 328         RcInteger       -> text "blue"
 329         RcFloat         -> text "red"
 330         RcDouble        -> text "green"
 331 #endif
 332
 333
 334 {-
 335 toX11Color (r, g, b)
 336  = let  rs      = padL 2 '0' (showHex r "")
 337         gs      = padL 2 '0' (showHex r "")
 338         bs      = padL 2 '0' (showHex r "")
 339
 340         padL n c s
 341                 = replicate (n - length s) c ++ s
 342   in    "#" ++ rs ++ gs ++ bs
 343 -}