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
  16 where
  17
  18 #include "nativeGen/NCG.h"
  19
  20 import qualified GraphColor as Color
  21 import RegLiveness
  22 import RegSpill
  23 import MachRegs
  24
  25 import Outputable
  26 import UniqFM
  27 import UniqSet
  28
  29 import Data.List
  30
  31 data RegAllocStats
  32
  33         -- initial graph
  34         = RegAllocStatsStart
  35         { raLiveCmm     :: [LiveCmmTop]                   -- ^ initial code, with liveness
  36         , raGraph       :: Color.Graph Reg RegClass Reg  -- ^ the initial, uncolored graph
  37         , raLifetimes   :: UniqFM (Reg, Int) }            -- ^ number of instrs each reg lives for
  38
  39         -- a spill stage
  40         | RegAllocStatsSpill
  41         { raGraph       :: Color.Graph Reg RegClass Reg -- ^ the partially colored graph
  42         , raSpillStats  :: SpillStats                   -- ^ spiller stats
  43         , raLifetimes   :: UniqFM (Reg, Int)            -- ^ number of instrs each reg lives for
  44         , raSpilled     :: [LiveCmmTop] }               -- ^ code with spill instructions added
  45
  46         -- a successful coloring
  47         | RegAllocStatsColored
  48         { raGraph       :: Color.Graph Reg RegClass Reg -- ^ the colored graph
  49         , raPatchedCmm  :: [LiveCmmTop] }               -- ^ code after register allocation
  50
  51
  52 instance Outputable RegAllocStats where
  53
  54  ppr (s@RegAllocStatsStart{})
  55         =  text "#  Start"
  56         $$ text "#  Native code with liveness information."
  57         $$ ppr (raLiveCmm s)
  58         $$ text ""
  59         $$ text "#  Initial register conflict graph."
  60         $$ Color.dotGraph regDotColor trivColorable (raGraph s)
  61
  62  ppr (s@RegAllocStatsSpill{})
  63         =  text "#  Spill"
  64         $$ text "#  Register conflict graph."
  65         $$ Color.dotGraph regDotColor trivColorable (raGraph s)
  66         $$ text ""
  67         $$ text "#  Spills inserted."
  68         $$ ppr (raSpillStats s)
  69         $$ text ""
  70         $$ text "#  Code with spills inserted."
  71         $$ (ppr (raSpilled s))
  72
  73  ppr (s@RegAllocStatsColored{})
  74         =  text "#  Colored"
  75         $$ text "#  Register conflict graph."
  76         $$ Color.dotGraph regDotColor trivColorable (raGraph s)
  77         $$ text ""
  78         $$ text "#  Native code after register allocation."
  79         $$ ppr (raPatchedCmm s)
  80
  81
  82 -- | Do all the different analysis on this list of RegAllocStats
  83 pprStats :: [RegAllocStats] -> Color.Graph Reg RegClass Reg -> SDoc
  84 pprStats stats graph
  85  = let  outSpills       = pprStatsSpills    stats
  86         outLife         = pprStatsLifetimes stats
  87         outConflict     = pprStatsConflict  stats
  88         outScatter      = pprStatsLifeConflict stats graph
  89
  90   in    vcat [outSpills, outLife, outConflict, outScatter]
  91
  92
  93 -- | Dump a table of how many spill loads / stores were inserted for each vreg.
  94 pprStatsSpills
  95         :: [RegAllocStats] -> SDoc
  96
  97 pprStatsSpills stats
  98  = let  -- slurp out the stats from all the spiller stages
  99         spillStats      = [ s   | s@RegAllocStatsSpill{} <- stats]
 100
 101         -- build a map of how many spill load/stores were inserted for each vreg
 102         spillSL         = foldl' (plusUFM_C accSpillSL) emptyUFM
 103                         $ map (spillStoreLoad . raSpillStats) spillStats
 104
 105         -- print the count of load/spills as a tuple so we can read back from the file easilly
 106         pprSpillSL (r, loads, stores)
 107          = (parens $ (hcat $ punctuate (text ", ") [doubleQuotes (ppr r), int loads, int stores]))
 108
 109         -- sum up the total number of spill instructions inserted
 110         spillList       = eltsUFM spillSL
 111         spillTotal      = foldl' (\(s1, l1) (s2, l2) -> (s1 + s2, l1 + l2))
 112                                 (0, 0)
 113                         $ map (\(n, s, l) -> (s, l))
 114                         $ spillList
 115
 116     in  (  text "-- spills-added-total"
 117         $$ text "--    (stores, loads)"
 118         $$ (ppr spillTotal)
 119         $$ text ""
 120         $$ text "-- spills-added"
 121         $$ text "--    (reg_name, stores, loads)"
 122         $$ (vcat $ map pprSpillSL $ spillList)
 123         $$ text "")
 124
 125
 126 -- | Dump a table of how long vregs tend to live for in the initial code.
 127 pprStatsLifetimes
 128         :: [RegAllocStats] -> SDoc
 129
 130 pprStatsLifetimes stats
 131  = let  lifeMap         = foldl' plusUFM emptyUFM
 132                                 [ raLifetimes s | s@RegAllocStatsStart{} <- stats ]
 133         lifeBins        = binLifetimeCount lifeMap
 134
 135    in   (  text "-- vreg-population-lifetimes"
 136         $$ text "--   (instruction_count, number_of_vregs_that_lived_that_long)"
 137         $$ (vcat $ map ppr $ eltsUFM lifeBins)
 138         $$ text "\n")
 139
 140 binLifetimeCount :: UniqFM (Reg, Int) -> UniqFM (Int, Int)
 141 binLifetimeCount fm
 142  = let  lifes   = map (\l -> (l, (l, 1)))
 143                 $ map snd
 144                 $ eltsUFM fm
 145
 146    in   addListToUFM_C
 147                 (\(l1, c1) (l2, c2) -> (l1, c1 + c2))
 148                 emptyUFM
 149                 lifes
 150
 151
 152 -- | Dump a table of how many conflicts vregs tend to have in the initial code.
 153 pprStatsConflict
 154         :: [RegAllocStats] -> SDoc
 155
 156 pprStatsConflict stats
 157  = let  confMap = foldl' (plusUFM_C (\(c1, n1) (c2, n2) -> (c1, n1 + n2)))
 158                         emptyUFM
 159                 $ map Color.slurpNodeConflictCount
 160                         [ raGraph s | s@RegAllocStatsStart{} <- stats ]
 161
 162    in   (  text "-- vreg-conflicts"
 163         $$ text "--   (conflict_count, number_of_vregs_that_had_that_many_conflicts)"
 164         $$ (vcat $ map ppr $ eltsUFM confMap)
 165         $$ text "\n")
 166
 167
 168 -- | For every vreg, dump it's how many conflicts it has and its lifetime
 169 --      good for making a scatter plot.
 170 pprStatsLifeConflict
 171         :: [RegAllocStats]
 172         -> Color.Graph Reg RegClass Reg         -- ^ global register conflict graph
 173         -> SDoc
 174
 175 pprStatsLifeConflict stats graph
 176  = let  lifeMap = foldl' plusUFM emptyUFM
 177                         [ raLifetimes s | s@RegAllocStatsStart{} <- stats ]
 178
 179         scatter = map   (\r ->  let Just (_, lifetime)  = lookupUFM lifeMap r
 180                                     Just node           = Color.lookupNode graph r
 181                                 in parens $ hcat $ punctuate (text ", ")
 182                                         [ doubleQuotes $ ppr $ Color.nodeId node
 183                                         , ppr $ sizeUniqSet (Color.nodeConflicts node)
 184                                         , ppr $ lifetime ])
 185                 $ map Color.nodeId
 186                 $ eltsUFM
 187                 $ Color.graphMap graph
 188
 189    in   (  text "-- vreg-conflict-lifetime"
 190         $$ text "--   (vreg, vreg_conflicts, vreg_lifetime)"
 191         $$ (vcat scatter)
 192         $$ text "\n")
 193
 194
 195 -----
 196 -- Register colors for drawing conflict graphs
 197 --      Keep this out of MachRegs.hs because it's specific to the graph coloring allocator.
 198
 199
 200 -- reg colors for x86
 201 #if i386_TARGET_ARCH
 202 regDotColor :: Reg -> SDoc
 203 regDotColor reg
 204  = let  Just    str     = lookupUFM regColors reg
 205    in   text str
 206
 207 regColors
 208  = listToUFM
 209  $      [ (eax, "#00ff00")
 210         , (ebx, "#0000ff")
 211         , (ecx, "#00ffff")
 212         , (edx, "#0080ff")
 213
 214         , (fake0, "#ff00ff")
 215         , (fake1, "#ff00aa")
 216         , (fake2, "#aa00ff")
 217         , (fake3, "#aa00aa")
 218         , (fake4, "#ff0055")
 219         , (fake5, "#5500ff") ]
 220 #endif
 221
 222
 223 -- reg colors for x86_64
 224 #if x86_64_TARGET_ARCH
 225 regDotColor :: Reg -> SDoc
 226 regDotColor reg
 227  = let  Just    str     = lookupUFM regColors reg
 228    in   text str
 229
 230 regColors
 231  = listToUFM
 232  $      [ (rax, "#00ff00"), (eax, "#00ff00")
 233         , (rbx, "#0000ff"), (ebx, "#0000ff")
 234         , (rcx, "#00ffff"), (ecx, "#00ffff")
 235         , (rdx, "#0080ff"), (edx, "#00ffff")
 236         , (r8,  "#00ff80")
 237         , (r9,  "#008080")
 238         , (r10, "#0040ff")
 239         , (r11, "#00ff40")
 240         , (r12, "#008040")
 241         , (r13, "#004080")
 242         , (r14, "#004040")
 243         , (r15, "#002080") ]
 244
 245         ++ zip (map RealReg [16..31]) (repeat "red")
 246 #endif
 247
 248
 249 -- reg colors for ppc
 250 #if powerpc_TARGET_ARCH
 251 regDotColor :: Reg -> SDoc
 252 regDotColor reg
 253  = case regClass reg of
 254         RcInteger       -> text "blue"
 255         RcFloat         -> text "red"
 256 #endif
 257
 258
 259 {-
 260 toX11Color (r, g, b)
 261  = let  rs      = padL 2 '0' (showHex r "")
 262         gs      = padL 2 '0' (showHex r "")
 263         bs      = padL 2 '0' (showHex r "")
 264
 265         padL n c s
 266                 = replicate (n - length s) c ++ s
 267   in    "#" ++ rs ++ gs ++ bs
 268 -}