compiler/nativeGen/RegAllocStats.hs

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