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         binLifetimeCount
   9 )
  10
  11 where
  12
  13 #include "nativeGen/NCG.h"
  14
  15 import qualified GraphColor as Color
  16 import RegLiveness
  17 import RegSpill
  18 import MachRegs
  19
  20 import Outputable
  21 import UniqFM
  22
  23
  24 data RegAllocStats
  25
  26         -- a spill stage
  27         = RegAllocStatsSpill
  28         { raLiveCmm     :: [LiveCmmTop]                 -- ^ code we tried to allocate regs for
  29         , raGraph       :: Color.Graph Reg RegClass Reg -- ^ the partially colored graph
  30         , raSpillStats  :: SpillStats                   -- ^ spiller stats
  31         , raLifetimes   :: UniqFM (Reg, Int) }          -- ^ number of instrs each reg lives for
  32
  33         -- a successful coloring
  34         | RegAllocStatsColored
  35         { raLiveCmm     :: [LiveCmmTop]                 -- ^ the code we allocated regs for
  36         , raGraph       :: Color.Graph Reg RegClass Reg -- ^ the colored graph
  37         , raPatchedCmm  :: [LiveCmmTop]                 -- ^ code with register allocation
  38         , raLifetimes   :: UniqFM (Reg, Int) }          -- ^ number of instrs each reg lives for
  39
  40
  41 instance Outputable RegAllocStats where
  42
  43  ppr (s@RegAllocStatsSpill{})
  44         = text "-- Spill"
  45
  46         $$ text "-- Native code with liveness information."
  47         $$ ppr (raLiveCmm s)
  48         $$ text " "
  49
  50         $$ text "-- Register conflict graph."
  51         $$ Color.dotGraph regDotColor trivColorable (raGraph s)
  52
  53         $$ text "-- Spill statistics."
  54         $$ ppr (raSpillStats s)
  55
  56
  57  ppr (s@RegAllocStatsColored{})
  58         = text "-- Colored"
  59
  60         $$ text "-- Native code with liveness information."
  61         $$ ppr (raLiveCmm s)
  62         $$ text " "
  63
  64         $$ text "-- Register conflict graph."
  65         $$ Color.dotGraph regDotColor trivColorable (raGraph s)
  66
  67         $$ text "-- Native code after register allocation."
  68         $$ ppr (raPatchedCmm s)
  69
  70
  71 -----
  72 binLifetimeCount :: UniqFM (Reg, Int) -> UniqFM (Int, Int)
  73 binLifetimeCount fm
  74  = let  lifes   = map (\l -> (l, (l, 1)))
  75                 $ map snd
  76                 $ eltsUFM fm
  77
  78    in   addListToUFM_C
  79                 (\(l1, c1) (l2, c2) -> (l1, c1 + c2))
  80                 emptyUFM
  81                 lifes
  82
  83 -----
  84 -- Register colors for drawing conflict graphs
  85 --      Keep this out of MachRegs.hs because it's specific to the graph coloring allocator.
  86
  87
  88 -- reg colors for x86
  89 #if i386_TARGET_ARCH
  90 regDotColor :: Reg -> SDoc
  91 regDotColor reg
  92  = let  Just    str     = lookupUFM regColors reg
  93    in   text str
  94
  95 regColors
  96  = listToUFM
  97  $      [ (eax, "#00ff00")
  98         , (ebx, "#0000ff")
  99         , (ecx, "#00ffff")
 100         , (edx, "#0080ff")
 101
 102         , (fake0, "#ff00ff")
 103         , (fake1, "#ff00aa")
 104         , (fake2, "#aa00ff")
 105         , (fake3, "#aa00aa")
 106         , (fake4, "#ff0055")
 107         , (fake5, "#5500ff") ]
 108 #endif
 109
 110
 111 -- reg colors for x86_64
 112 #if x86_64_TARGET_ARCH
 113 regDotColor :: Reg -> SDoc
 114 regDotColor reg
 115  = let  Just    str     = lookupUFM regColors reg
 116    in   text str
 117
 118 regColors
 119  = listToUFM
 120  $      [ (rax, "#00ff00"), (eax, "#00ff00")
 121         , (rbx, "#0000ff"), (ebx, "#0000ff")
 122         , (rcx, "#00ffff"), (ecx, "#00ffff")
 123         , (rdx, "#0080ff"), (edx, "#00ffff")
 124         , (r8,  "#00ff80")
 125         , (r9,  "#008080")
 126         , (r10, "#0040ff")
 127         , (r11, "#00ff40")
 128         , (r12, "#008040")
 129         , (r13, "#004080")
 130         , (r14, "#004040")
 131         , (r15, "#002080") ]
 132
 133         ++ zip (map RealReg [16..31]) (repeat "red")
 134 #endif
 135
 136
 137 -- reg colors for ppc
 138 #if powerpc_TARGET_ARCH
 139 regDotColor :: Reg -> SDoc
 140 regDotColor reg
 141  = case regClass reg of
 142         RcInteger       -> text "blue"
 143         RcFloat         -> text "red"
 144 #endif
 145
 146
 147 {-
 148 toX11Color (r, g, b)
 149  = let  rs      = padL 2 '0' (showHex r "")
 150         gs      = padL 2 '0' (showHex r "")
 151         bs      = padL 2 '0' (showHex r "")
 152
 153         padL n c s
 154                 = replicate (n - length s) c ++ s
 155   in    "#" ++ rs ++ gs ++ bs
 156 -}