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