compiler/nativeGen/RegAllocStats.hs

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