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 Reg RegClass Reg   -- ^ 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 Reg RegClass Reg -- ^ the partially colored graph
  49         , raCoalesced   :: UniqFM Reg                   -- ^ 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 Reg RegClass Reg -- ^ the uncolored graph
  57         , raGraphColored :: Color.Graph Reg RegClass Reg -- ^ the coalesced and colored graph
  58         , raCoalesced   :: UniqFM Reg                   -- ^ 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 :: [RegAllocStats instr] -> Color.Graph Reg RegClass Reg -> SDoc
 136 pprStats stats graph
 137  = let  outSpills       = pprStatsSpills    stats
 138         outLife         = pprStatsLifetimes stats
 139         outConflict     = pprStatsConflict  stats
 140         outScatter      = pprStatsLifeConflict stats graph
 141
 142   in    vcat [outSpills, outLife, outConflict, outScatter]
 143
 144
 145 -- | Dump a table of how many spill loads \/ stores were inserted for each vreg.
 146 pprStatsSpills
 147         :: [RegAllocStats instr] -> SDoc
 148
 149 pprStatsSpills stats
 150  = let
 151         finals  = [ s   | s@RegAllocStatsColored{} <- stats]
 152
 153         -- sum up how many stores\/loads\/reg-reg-moves were left in the code
 154         total   = foldl' addSRM (0, 0, 0)
 155                 $ map raSRMs finals
 156
 157     in  (  text "-- spills-added-total"
 158         $$ text "--    (stores, loads, reg_reg_moves_remaining)"
 159         $$ ppr total
 160         $$ text "")
 161
 162
 163 -- | Dump a table of how long vregs tend to live for in the initial code.
 164 pprStatsLifetimes
 165         :: [RegAllocStats instr] -> SDoc
 166
 167 pprStatsLifetimes stats
 168  = let  info            = foldl' plusSpillCostInfo zeroSpillCostInfo
 169                                 [ raSpillCosts s
 170                                         | s@RegAllocStatsStart{} <- stats ]
 171
 172         lifeBins        = binLifetimeCount $ lifeMapFromSpillCostInfo info
 173
 174    in   (  text "-- vreg-population-lifetimes"
 175         $$ text "--   (instruction_count, number_of_vregs_that_lived_that_long)"
 176         $$ (vcat $ map ppr $ eltsUFM lifeBins)
 177         $$ text "\n")
 178
 179 binLifetimeCount :: UniqFM (Reg, Int) -> UniqFM (Int, Int)
 180 binLifetimeCount fm
 181  = let  lifes   = map (\l -> (l, (l, 1)))
 182                 $ map snd
 183                 $ eltsUFM fm
 184
 185    in   addListToUFM_C
 186                 (\(l1, c1) (_, c2) -> (l1, c1 + c2))
 187                 emptyUFM
 188                 lifes
 189
 190
 191 -- | Dump a table of how many conflicts vregs tend to have in the initial code.
 192 pprStatsConflict
 193         :: [RegAllocStats instr] -> SDoc
 194
 195 pprStatsConflict stats
 196  = let  confMap = foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
 197                         emptyUFM
 198                 $ map Color.slurpNodeConflictCount
 199                         [ raGraph s | s@RegAllocStatsStart{} <- stats ]
 200
 201    in   (  text "-- vreg-conflicts"
 202         $$ text "--   (conflict_count, number_of_vregs_that_had_that_many_conflicts)"
 203         $$ (vcat $ map ppr $ eltsUFM confMap)
 204         $$ text "\n")
 205
 206
 207 -- | For every vreg, dump it's how many conflicts it has and its lifetime
 208 --      good for making a scatter plot.
 209 pprStatsLifeConflict
 210         :: [RegAllocStats instr]
 211         -> Color.Graph Reg RegClass Reg         -- ^ global register conflict graph
 212         -> SDoc
 213
 214 pprStatsLifeConflict stats graph
 215  = let  lifeMap = lifeMapFromSpillCostInfo
 216                 $ foldl' plusSpillCostInfo zeroSpillCostInfo
 217                 $ [ raSpillCosts s | s@RegAllocStatsStart{} <- stats ]
 218
 219         scatter = map   (\r ->  let lifetime    = case lookupUFM lifeMap r of
 220                                                         Just (_, l)     -> l
 221                                                         Nothing         -> 0
 222                                     Just node   = Color.lookupNode graph r
 223                                 in parens $ hcat $ punctuate (text ", ")
 224                                         [ doubleQuotes $ ppr $ Color.nodeId node
 225                                         , ppr $ sizeUniqSet (Color.nodeConflicts node)
 226                                         , ppr $ lifetime ])
 227                 $ map Color.nodeId
 228                 $ eltsUFM
 229                 $ Color.graphMap graph
 230
 231    in   (  text "-- vreg-conflict-lifetime"
 232         $$ text "--   (vreg, vreg_conflicts, vreg_lifetime)"
 233         $$ (vcat scatter)
 234         $$ text "\n")
 235
 236
 237 -- | Count spill/reload/reg-reg moves.
 238 --      Lets us see how well the register allocator has done.
 239 --
 240 countSRMs
 241         :: Instruction instr
 242         => LiveCmmTop instr -> (Int, Int, Int)
 243
 244 countSRMs cmm
 245         = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0)
 246
 247 countSRM_block (BasicBlock i instrs)
 248  = do   instrs' <- mapM countSRM_instr instrs
 249         return  $ BasicBlock i instrs'
 250
 251 countSRM_instr li
 252         | SPILL _ _     <- li
 253         = do    modify  $ \(s, r, m)    -> (s + 1, r, m)
 254                 return li
 255
 256         | RELOAD _ _    <- li
 257         = do    modify  $ \(s, r, m)    -> (s, r + 1, m)
 258                 return li
 259
 260         | Instr instr _ <- li
 261         , Just _        <- takeRegRegMoveInstr instr
 262         = do    modify  $ \(s, r, m)    -> (s, r, m + 1)
 263                 return li
 264
 265         | otherwise
 266         =       return li
 267
 268 -- sigh..
 269 addSRM (s1, r1, m1) (s2, r2, m2)
 270         = (s1+s2, r1+r2, m1+m2)
 271
 272
 273
 274
 275
 276
 277 {-
 278 toX11Color (r, g, b)
 279  = let  rs      = padL 2 '0' (showHex r "")
 280         gs      = padL 2 '0' (showHex r "")
 281         bs      = padL 2 '0' (showHex r "")
 282
 283         padL n c s
 284                 = replicate (n - length s) c ++ s
 285   in    "#" ++ rs ++ gs ++ bs
 286 -}