compiler/nativeGen/RegAlloc/Graph/Stats.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 RegAlloc.Graph.Stats (
   7         RegAllocStats (..),
   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 RegAlloc.Liveness
  24 import RegAlloc.Graph.Spill
  25 import RegAlloc.Graph.SpillCost
  26 import Instruction
  27 import RegClass
  28 import Reg
  29
  30 import Cmm
  31 import Outputable
  32 import UniqFM
  33 import UniqSet
  34 import State
  35
  36 import Data.List
  37
  38 data RegAllocStats instr
  39
  40         -- initial graph
  41         = RegAllocStatsStart
  42         { raLiveCmm     :: [LiveCmmTop instr]                           -- ^ initial code, with liveness
  43         , raGraph       :: Color.Graph VirtualReg RegClass RealReg      -- ^ the initial, uncolored graph
  44         , raSpillCosts  :: SpillCostInfo }                              -- ^ information to help choose which regs to spill
  45
  46         -- a spill stage
  47         | RegAllocStatsSpill
  48         { raGraph       :: Color.Graph VirtualReg RegClass RealReg      -- ^ the partially colored graph
  49         , raCoalesced   :: UniqFM VirtualReg                            -- ^ the regs that were coaleced
  50         , raSpillStats  :: SpillStats                                   -- ^ spiller stats
  51         , raSpillCosts  :: SpillCostInfo                                -- ^ number of instrs each reg lives for
  52         , raSpilled     :: [LiveCmmTop instr] }                         -- ^ code with spill instructions added
  53
  54         -- a successful coloring
  55         | RegAllocStatsColored
  56         { raGraph         :: Color.Graph VirtualReg RegClass RealReg    -- ^ the uncolored graph
  57         , raGraphColored  :: Color.Graph VirtualReg RegClass RealReg    -- ^ the coalesced and colored graph
  58         , raCoalesced     :: UniqFM VirtualReg                          -- ^ the regs that were coaleced
  59         , raCodeCoalesced :: [LiveCmmTop instr]                         -- ^ code with coalescings applied
  60         , raPatched       :: [LiveCmmTop instr]                         -- ^ code with vregs replaced by hregs
  61         , raSpillClean    :: [LiveCmmTop instr]                         -- ^ code with unneeded spill\/reloads cleaned out
  62         , raFinal         :: [NatCmmTop instr]                          -- ^ final code
  63         , raSRMs          :: (Int, Int, Int) }                          -- ^ spill\/reload\/reg-reg moves present in this code
  64
  65 instance Outputable instr => Outputable (RegAllocStats instr) 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 coalescings applied."
 119         $$ ppr (raCodeCoalesced s)
 120         $$ text ""
 121
 122         $$ text "#  Native code after register allocation."
 123         $$ ppr (raPatched s)
 124         $$ text ""
 125
 126         $$ text "#  Clean out unneeded spill/reloads."
 127         $$ ppr (raSpillClean s)
 128         $$ text ""
 129
 130         $$ text "#  Final code, after rewriting spill/rewrite pseudo instrs."
 131         $$ ppr (raFinal s)
 132         $$ text ""
 133         $$  text "#  Score:"
 134         $$ (text "#          spills  inserted: " <> int spills)
 135         $$ (text "#          reloads inserted: " <> int reloads)
 136         $$ (text "#   reg-reg moves remaining: " <> int moves)
 137         $$ text ""
 138
 139 -- | Do all the different analysis on this list of RegAllocStats
 140 pprStats
 141         :: [RegAllocStats instr]
 142         -> Color.Graph VirtualReg RegClass RealReg
 143         -> SDoc
 144
 145 pprStats stats graph
 146  = let  outSpills       = pprStatsSpills    stats
 147         outLife         = pprStatsLifetimes stats
 148         outConflict     = pprStatsConflict  stats
 149         outScatter      = pprStatsLifeConflict stats graph
 150
 151   in    vcat [outSpills, outLife, outConflict, outScatter]
 152
 153
 154 -- | Dump a table of how many spill loads \/ stores were inserted for each vreg.
 155 pprStatsSpills
 156         :: [RegAllocStats instr] -> SDoc
 157
 158 pprStatsSpills stats
 159  = let
 160         finals  = [ s   | s@RegAllocStatsColored{} <- stats]
 161
 162         -- sum up how many stores\/loads\/reg-reg-moves were left in the code
 163         total   = foldl' addSRM (0, 0, 0)
 164                 $ map raSRMs finals
 165
 166     in  (  text "-- spills-added-total"
 167         $$ text "--    (stores, loads, reg_reg_moves_remaining)"
 168         $$ ppr total
 169         $$ text "")
 170
 171
 172 -- | Dump a table of how long vregs tend to live for in the initial code.
 173 pprStatsLifetimes
 174         :: [RegAllocStats instr] -> SDoc
 175
 176 pprStatsLifetimes stats
 177  = let  info            = foldl' plusSpillCostInfo zeroSpillCostInfo
 178                                 [ raSpillCosts s
 179                                         | s@RegAllocStatsStart{} <- stats ]
 180
 181         lifeBins        = binLifetimeCount $ lifeMapFromSpillCostInfo info
 182
 183    in   (  text "-- vreg-population-lifetimes"
 184         $$ text "--   (instruction_count, number_of_vregs_that_lived_that_long)"
 185         $$ (vcat $ map ppr $ eltsUFM lifeBins)
 186         $$ text "\n")
 187
 188 binLifetimeCount :: UniqFM (VirtualReg, Int) -> UniqFM (Int, Int)
 189 binLifetimeCount fm
 190  = let  lifes   = map (\l -> (l, (l, 1)))
 191                 $ map snd
 192                 $ eltsUFM fm
 193
 194    in   addListToUFM_C
 195                 (\(l1, c1) (_, c2) -> (l1, c1 + c2))
 196                 emptyUFM
 197                 lifes
 198
 199
 200 -- | Dump a table of how many conflicts vregs tend to have in the initial code.
 201 pprStatsConflict
 202         :: [RegAllocStats instr] -> SDoc
 203
 204 pprStatsConflict stats
 205  = let  confMap = foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
 206                         emptyUFM
 207                 $ map Color.slurpNodeConflictCount
 208                         [ raGraph s | s@RegAllocStatsStart{} <- stats ]
 209
 210    in   (  text "-- vreg-conflicts"
 211         $$ text "--   (conflict_count, number_of_vregs_that_had_that_many_conflicts)"
 212         $$ (vcat $ map ppr $ eltsUFM confMap)
 213         $$ text "\n")
 214
 215
 216 -- | For every vreg, dump it's how many conflicts it has and its lifetime
 217 --      good for making a scatter plot.
 218 pprStatsLifeConflict
 219         :: [RegAllocStats instr]
 220         -> Color.Graph VirtualReg RegClass RealReg      -- ^ global register conflict graph
 221         -> SDoc
 222
 223 pprStatsLifeConflict stats graph
 224  = let  lifeMap = lifeMapFromSpillCostInfo
 225                 $ foldl' plusSpillCostInfo zeroSpillCostInfo
 226                 $ [ raSpillCosts s | s@RegAllocStatsStart{} <- stats ]
 227
 228         scatter = map   (\r ->  let lifetime    = case lookupUFM lifeMap r of
 229                                                         Just (_, l)     -> l
 230                                                         Nothing         -> 0
 231                                     Just node   = Color.lookupNode graph r
 232                                 in parens $ hcat $ punctuate (text ", ")
 233                                         [ doubleQuotes $ ppr $ Color.nodeId node
 234                                         , ppr $ sizeUniqSet (Color.nodeConflicts node)
 235                                         , ppr $ lifetime ])
 236                 $ map Color.nodeId
 237                 $ eltsUFM
 238                 $ Color.graphMap graph
 239
 240    in   (  text "-- vreg-conflict-lifetime"
 241         $$ text "--   (vreg, vreg_conflicts, vreg_lifetime)"
 242         $$ (vcat scatter)
 243         $$ text "\n")
 244
 245
 246 -- | Count spill/reload/reg-reg moves.
 247 --      Lets us see how well the register allocator has done.
 248 --
 249 countSRMs
 250         :: Instruction instr
 251         => LiveCmmTop instr -> (Int, Int, Int)
 252
 253 countSRMs cmm
 254         = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0)
 255
 256 countSRM_block (BasicBlock i instrs)
 257  = do   instrs' <- mapM countSRM_instr instrs
 258         return  $ BasicBlock i instrs'
 259
 260 countSRM_instr li
 261         | LiveInstr SPILL{} _    <- li
 262         = do    modify  $ \(s, r, m)    -> (s + 1, r, m)
 263                 return li
 264
 265         | LiveInstr RELOAD{} _  <- li
 266         = do    modify  $ \(s, r, m)    -> (s, r + 1, m)
 267                 return li
 268
 269         | LiveInstr instr _     <- li
 270         , Just _        <- takeRegRegMoveInstr instr
 271         = do    modify  $ \(s, r, m)    -> (s, r, m + 1)
 272                 return li
 273
 274         | otherwise
 275         =       return li
 276
 277 -- sigh..
 278 addSRM (s1, r1, m1) (s2, r2, m2)
 279         = (s1+s2, r1+r2, m1+m2)
 280
 281
 282
 283
 284
 285
 286 {-
 287 toX11Color (r, g, b)
 288  = let  rs      = padL 2 '0' (showHex r "")
 289         gs      = padL 2 '0' (showHex r "")
 290         bs      = padL 2 '0' (showHex r "")
 291
 292         padL n c s
 293                 = replicate (n - length s) c ++ s
 294   in    "#" ++ rs ++ gs ++ bs
 295 -}