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 lifetime    = case lookupUFM lifeMap r of
 180                                                         Just (_, l)     -> l
 181                                                         Nothing         -> 0
 182                                     Just node   = Color.lookupNode graph r
 183                                 in parens $ hcat $ punctuate (text ", ")
 184                                         [ doubleQuotes $ ppr $ Color.nodeId node
 185                                         , ppr $ sizeUniqSet (Color.nodeConflicts node)
 186                                         , ppr $ lifetime ])
 187                 $ map Color.nodeId
 188                 $ eltsUFM
 189                 $ Color.graphMap graph
 190
 191    in   (  text "-- vreg-conflict-lifetime"
 192         $$ text "--   (vreg, vreg_conflicts, vreg_lifetime)"
 193         $$ (vcat scatter)
 194         $$ text "\n")
 195
 196
 197 -----
 198 -- Register colors for drawing conflict graphs
 199 --      Keep this out of MachRegs.hs because it's specific to the graph coloring allocator.
 200
 201
 202 -- reg colors for x86
 203 #if i386_TARGET_ARCH
 204 regDotColor :: Reg -> SDoc
 205 regDotColor reg
 206  = let  Just    str     = lookupUFM regColors reg
 207    in   text str
 208
 209 regColors
 210  = listToUFM
 211  $      [ (eax, "#00ff00")
 212         , (ebx, "#0000ff")
 213         , (ecx, "#00ffff")
 214         , (edx, "#0080ff")
 215
 216         , (fake0, "#ff00ff")
 217         , (fake1, "#ff00aa")
 218         , (fake2, "#aa00ff")
 219         , (fake3, "#aa00aa")
 220         , (fake4, "#ff0055")
 221         , (fake5, "#5500ff") ]
 222 #endif
 223
 224
 225 -- reg colors for x86_64
 226 #if x86_64_TARGET_ARCH
 227 regDotColor :: Reg -> SDoc
 228 regDotColor reg
 229  = let  Just    str     = lookupUFM regColors reg
 230    in   text str
 231
 232 regColors
 233  = listToUFM
 234  $      [ (rax, "#00ff00"), (eax, "#00ff00")
 235         , (rbx, "#0000ff"), (ebx, "#0000ff")
 236         , (rcx, "#00ffff"), (ecx, "#00ffff")
 237         , (rdx, "#0080ff"), (edx, "#00ffff")
 238         , (r8,  "#00ff80")
 239         , (r9,  "#008080")
 240         , (r10, "#0040ff")
 241         , (r11, "#00ff40")
 242         , (r12, "#008040")
 243         , (r13, "#004080")
 244         , (r14, "#004040")
 245         , (r15, "#002080") ]
 246
 247         ++ zip (map RealReg [16..31]) (repeat "red")
 248 #endif
 249
 250
 251 -- reg colors for ppc
 252 #if powerpc_TARGET_ARCH
 253 regDotColor :: Reg -> SDoc
 254 regDotColor reg
 255  = case regClass reg of
 256         RcInteger       -> text "blue"
 257         RcFloat         -> text "red"
 258 #endif
 259
 260
 261 {-
 262 toX11Color (r, g, b)
 263  = let  rs      = padL 2 '0' (showHex r "")
 264         gs      = padL 2 '0' (showHex r "")
 265         bs      = padL 2 '0' (showHex r "")
 266
 267         padL n c s
 268                 = replicate (n - length s) c ++ s
 269   in    "#" ++ rs ++ gs ++ bs
 270 -}