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