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         , raPatched     :: [LiveCmmTop instr]                           -- ^ code with vregs replaced by hregs
  60         , raSpillClean  :: [LiveCmmTop instr]                           -- ^ code with unneeded spill\/reloads cleaned out
  61         , raFinal       :: [NatCmmTop instr]                            -- ^ final code
  62         , raSRMs        :: (Int, Int, Int) }                            -- ^ spill\/reload\/reg-reg moves present in this code
  63
  64 instance Outputable instr => Outputable (RegAllocStats instr) where
  65
  66  ppr (s@RegAllocStatsStart{})
  67         =  text "#  Start"
  68         $$ text "#  Native code with liveness information."
  69         $$ ppr (raLiveCmm s)
  70         $$ text ""
  71 --      $$ text "#  Initial register conflict graph."
  72 --      $$ Color.dotGraph regDotColor trivColorable (raGraph s)
  73
  74
  75  ppr (s@RegAllocStatsSpill{})
  76         =  text "#  Spill"
  77
  78 --      $$ text "#  Register conflict graph."
  79 --      $$ Color.dotGraph regDotColor trivColorable (raGraph s)
  80 --      $$ text ""
  81
  82         $$ (if (not $ isNullUFM $ raCoalesced s)
  83                 then    text "#  Registers coalesced."
  84                         $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
  85                         $$ text ""
  86                 else empty)
  87
  88 --      $$ text "#  Spill costs.  reg uses defs lifetime degree cost"
  89 --      $$ vcat (map (pprSpillCostRecord (raGraph s)) $ eltsUFM $ raSpillCosts s)
  90 --      $$ text ""
  91
  92         $$ text "#  Spills inserted."
  93         $$ ppr (raSpillStats s)
  94         $$ text ""
  95
  96         $$ text "#  Code with spills inserted."
  97         $$ (ppr (raSpilled s))
  98
  99
 100  ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
 101         =  text "#  Colored"
 102
 103 --      $$ text "#  Register conflict graph (initial)."
 104 --      $$ Color.dotGraph regDotColor trivColorable (raGraph s)
 105 --      $$ text ""
 106
 107 --      $$ text "#  Register conflict graph (colored)."
 108 --      $$ Color.dotGraph regDotColor trivColorable (raGraphColored s)
 109 --      $$ text ""
 110
 111         $$ (if (not $ isNullUFM $ raCoalesced s)
 112                 then    text "#  Registers coalesced."
 113                         $$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
 114                         $$ text ""
 115                 else empty)
 116
 117         $$ text "#  Native code after register allocation."
 118         $$ ppr (raPatched s)
 119         $$ text ""
 120
 121         $$ text "#  Clean out unneeded spill/reloads."
 122         $$ ppr (raSpillClean s)
 123         $$ text ""
 124
 125         $$ text "#  Final code, after rewriting spill/rewrite pseudo instrs."
 126         $$ ppr (raFinal s)
 127         $$ text ""
 128         $$  text "#  Score:"
 129         $$ (text "#          spills  inserted: " <> int spills)
 130         $$ (text "#          reloads inserted: " <> int reloads)
 131         $$ (text "#   reg-reg moves remaining: " <> int moves)
 132         $$ text ""
 133
 134 -- | Do all the different analysis on this list of RegAllocStats
 135 pprStats
 136         :: [RegAllocStats instr]
 137         -> Color.Graph VirtualReg RegClass RealReg
 138         -> SDoc
 139
 140 pprStats stats graph
 141  = let  outSpills       = pprStatsSpills    stats
 142         outLife         = pprStatsLifetimes stats
 143         outConflict     = pprStatsConflict  stats
 144         outScatter      = pprStatsLifeConflict stats graph
 145
 146   in    vcat [outSpills, outLife, outConflict, outScatter]
 147
 148
 149 -- | Dump a table of how many spill loads \/ stores were inserted for each vreg.
 150 pprStatsSpills
 151         :: [RegAllocStats instr] -> SDoc
 152
 153 pprStatsSpills stats
 154  = let
 155         finals  = [ s   | s@RegAllocStatsColored{} <- stats]
 156
 157         -- sum up how many stores\/loads\/reg-reg-moves were left in the code
 158         total   = foldl' addSRM (0, 0, 0)
 159                 $ map raSRMs finals
 160
 161     in  (  text "-- spills-added-total"
 162         $$ text "--    (stores, loads, reg_reg_moves_remaining)"
 163         $$ ppr total
 164         $$ text "")
 165
 166
 167 -- | Dump a table of how long vregs tend to live for in the initial code.
 168 pprStatsLifetimes
 169         :: [RegAllocStats instr] -> SDoc
 170
 171 pprStatsLifetimes stats
 172  = let  info            = foldl' plusSpillCostInfo zeroSpillCostInfo
 173                                 [ raSpillCosts s
 174                                         | s@RegAllocStatsStart{} <- stats ]
 175
 176         lifeBins        = binLifetimeCount $ lifeMapFromSpillCostInfo info
 177
 178    in   (  text "-- vreg-population-lifetimes"
 179         $$ text "--   (instruction_count, number_of_vregs_that_lived_that_long)"
 180         $$ (vcat $ map ppr $ eltsUFM lifeBins)
 181         $$ text "\n")
 182
 183 binLifetimeCount :: UniqFM (VirtualReg, Int) -> UniqFM (Int, Int)
 184 binLifetimeCount fm
 185  = let  lifes   = map (\l -> (l, (l, 1)))
 186                 $ map snd
 187                 $ eltsUFM fm
 188
 189    in   addListToUFM_C
 190                 (\(l1, c1) (_, c2) -> (l1, c1 + c2))
 191                 emptyUFM
 192                 lifes
 193
 194
 195 -- | Dump a table of how many conflicts vregs tend to have in the initial code.
 196 pprStatsConflict
 197         :: [RegAllocStats instr] -> SDoc
 198
 199 pprStatsConflict stats
 200  = let  confMap = foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
 201                         emptyUFM
 202                 $ map Color.slurpNodeConflictCount
 203                         [ raGraph s | s@RegAllocStatsStart{} <- stats ]
 204
 205    in   (  text "-- vreg-conflicts"
 206         $$ text "--   (conflict_count, number_of_vregs_that_had_that_many_conflicts)"
 207         $$ (vcat $ map ppr $ eltsUFM confMap)
 208         $$ text "\n")
 209
 210
 211 -- | For every vreg, dump it's how many conflicts it has and its lifetime
 212 --      good for making a scatter plot.
 213 pprStatsLifeConflict
 214         :: [RegAllocStats instr]
 215         -> Color.Graph VirtualReg RegClass RealReg      -- ^ global register conflict graph
 216         -> SDoc
 217
 218 pprStatsLifeConflict stats graph
 219  = let  lifeMap = lifeMapFromSpillCostInfo
 220                 $ foldl' plusSpillCostInfo zeroSpillCostInfo
 221                 $ [ raSpillCosts s | s@RegAllocStatsStart{} <- stats ]
 222
 223         scatter = map   (\r ->  let lifetime    = case lookupUFM lifeMap r of
 224                                                         Just (_, l)     -> l
 225                                                         Nothing         -> 0
 226                                     Just node   = Color.lookupNode graph r
 227                                 in parens $ hcat $ punctuate (text ", ")
 228                                         [ doubleQuotes $ ppr $ Color.nodeId node
 229                                         , ppr $ sizeUniqSet (Color.nodeConflicts node)
 230                                         , ppr $ lifetime ])
 231                 $ map Color.nodeId
 232                 $ eltsUFM
 233                 $ Color.graphMap graph
 234
 235    in   (  text "-- vreg-conflict-lifetime"
 236         $$ text "--   (vreg, vreg_conflicts, vreg_lifetime)"
 237         $$ (vcat scatter)
 238         $$ text "\n")
 239
 240
 241 -- | Count spill/reload/reg-reg moves.
 242 --      Lets us see how well the register allocator has done.
 243 --
 244 countSRMs
 245         :: Instruction instr
 246         => LiveCmmTop instr -> (Int, Int, Int)
 247
 248 countSRMs cmm
 249         = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0)
 250
 251 countSRM_block (BasicBlock i instrs)
 252  = do   instrs' <- mapM countSRM_instr instrs
 253         return  $ BasicBlock i instrs'
 254
 255 countSRM_instr li
 256         | SPILL _ _     <- li
 257         = do    modify  $ \(s, r, m)    -> (s + 1, r, m)
 258                 return li
 259
 260         | RELOAD _ _    <- li
 261         = do    modify  $ \(s, r, m)    -> (s, r + 1, m)
 262                 return li
 263
 264         | Instr instr _ <- li
 265         , Just _        <- takeRegRegMoveInstr instr
 266         = do    modify  $ \(s, r, m)    -> (s, r, m + 1)
 267                 return li
 268
 269         | otherwise
 270         =       return li
 271
 272 -- sigh..
 273 addSRM (s1, r1, m1) (s2, r2, m2)
 274         = (s1+s2, r1+r2, m1+m2)
 275
 276
 277
 278
 279
 280
 281 {-
 282 toX11Color (r, g, b)
 283  = let  rs      = padL 2 '0' (showHex r "")
 284         gs      = padL 2 '0' (showHex r "")
 285         bs      = padL 2 '0' (showHex r "")
 286
 287         padL n c s
 288                 = replicate (n - length s) c ++ s
 289   in    "#" ++ rs ++ gs ++ bs
 290 -}