Add vreg-population-lifetimes to drop-asm-stats

[ghc-hetmet.git] / compiler / nativeGen / RegAllocStats.hs

diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs
index 751c556..844ffcd 100644 (file)
--- a/compiler/nativeGen/RegAllocStats.hs
+++ b/compiler/nativeGen/RegAllocStats.hs
@@ -4,7 +4,8 @@
 
 module RegAllocStats (
        RegAllocStats (..),
-       regDotColor
+       regDotColor,
+       binLifetimeCount
 )
 
 where
@@ -26,13 +27,15 @@ data RegAllocStats
        = RegAllocStatsSpill
        { raLiveCmm     :: [LiveCmmTop]                 -- ^ code we tried to allocate regs for
        , raGraph       :: Color.Graph Reg RegClass Reg -- ^ the partially colored graph
-       , raSpillStats  :: SpillStats }                 -- ^ spiller stats
+       , raSpillStats  :: SpillStats                   -- ^ spiller stats
+       , raLifetimes   :: UniqFM (Reg, Int) }          -- ^ number of instrs each reg lives for
 
        -- a successful coloring
        | RegAllocStatsColored
        { raLiveCmm     :: [LiveCmmTop]                 -- ^ the code we allocated regs for
        , raGraph       :: Color.Graph Reg RegClass Reg -- ^ the colored graph
-       , raPatchedCmm  :: [LiveCmmTop] }               -- ^ code with register allocation
+       , raPatchedCmm  :: [LiveCmmTop]                 -- ^ code with register allocation
+       , raLifetimes   :: UniqFM (Reg, Int) }          -- ^ number of instrs each reg lives for
 
 
 instance Outputable RegAllocStats where
@@ -66,6 +69,18 @@ instance Outputable RegAllocStats where
 
 
 -----
+binLifetimeCount :: UniqFM (Reg, Int) -> UniqFM (Int, Int)
+binLifetimeCount fm
+ = let lifes   = map (\l -> (l, (l, 1)))
+               $ map snd
+               $ eltsUFM fm
+
+   in  addListToUFM_C
+               (\(l1, c1) (l2, c2) -> (l1, c1 + c2))
+               emptyUFM
+               lifes
+
+-----
 -- Register colors for drawing conflict graphs
 --     Keep this out of MachRegs.hs because it's specific to the graph coloring allocator.