X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FnativeGen%2FRegAllocStats.hs;h=ae5f106dfd49039f74114b9db2227acdca9912ef;hb=44da8b0ac437e0cd6d85a63a389ca15735f153c0;hp=751c556f51dc11c13accc1be85865dddf65d282a;hpb=f0d0e9d63ee27a12e80b6f069be5e9d4b55ca545;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs
index 751c556..ae5f106 100644
--- a/compiler/nativeGen/RegAllocStats.hs
+++ b/compiler/nativeGen/RegAllocStats.hs
@@ -4,7 +4,12 @@
 
 module RegAllocStats (
 	RegAllocStats (..),
-	regDotColor
+	regDotColor,
+
+	pprStatsSpills,
+	pprStatsLifetimes,
+	pprStatsConflict,
+	pprStatsLifeConflict
 )
 
 where
@@ -18,7 +23,9 @@ import MachRegs
 
 import Outputable
 import UniqFM
+import UniqSet
 
+import Data.List
 
 data RegAllocStats
 
@@ -26,13 +33,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
@@ -65,6 +74,94 @@ instance Outputable RegAllocStats where
 	$$ ppr (raPatchedCmm s)
 
 
+-- | Dump a table of how many spill loads / stores were inserted for each vreg.
+pprStatsSpills
+	:: [RegAllocStats] -> SDoc
+
+pprStatsSpills stats
+ = let	-- slurp out the stats from all the spiller stages
+	spillStats	= [ s	| s@RegAllocStatsSpill{} <- stats]
+
+	-- build a map of how many spill load/stores were inserted for each vreg
+	spillLS		= foldl' (plusUFM_C accSpillLS) emptyUFM
+			$ map (spillLoadStore . raSpillStats) spillStats
+
+	-- print the count of load/spills as a tuple so we can read back from the file easilly
+	pprSpillLS (r, loads, stores)
+	 = (parens $ (hcat $ punctuate (text ", ") [doubleQuotes (ppr r), int loads, int stores]))
+
+
+    in	(  text "-- spills-added"
+	$$ text "--    (reg_name, spill_loads_added, spill_stores_added)."
+	$$ (vcat $ map pprSpillLS $ eltsUFM spillLS)
+	$$ text "\n")
+
+
+
+-- | Dump a table of how long vregs tend to live for.
+pprStatsLifetimes
+	:: [RegAllocStats] -> SDoc
+
+pprStatsLifetimes stats
+ = let	lifeMap		= foldl' plusUFM emptyUFM $ map raLifetimes stats
+	lifeBins	= binLifetimeCount lifeMap
+
+   in	(  text "-- vreg-population-lifetimes"
+	$$ text "--   (instruction_count, number_of_vregs_that_lived_that_long)"
+	$$ (vcat $ map ppr $ eltsUFM lifeBins)
+	$$ text "\n")
+
+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
+
+
+-- | Dump a table of how many conflicts vregs tend to have.
+pprStatsConflict
+	:: [RegAllocStats] -> SDoc
+
+pprStatsConflict stats
+ = let	confMap	= foldl' (plusUFM_C (\(c1, n1) (c2, n2) -> (c1, n1 + n2)))
+			emptyUFM
+		$ map Color.slurpNodeConflictCount
+		$ map raGraph stats
+
+   in	(  text "-- vreg-conflicts"
+	$$ text "--   (conflict_count, number_of_vregs_that_had_that_many_conflicts)"
+	$$ (vcat $ map ppr $ eltsUFM confMap)
+	$$ text "\n")
+
+
+-- | For every vreg, dump it's how many conflicts it has and its lifetime
+--	good for making a scatter plot.
+pprStatsLifeConflict
+	:: [RegAllocStats] -> Color.Graph Reg RegClass Reg -> SDoc
+
+pprStatsLifeConflict stats graph
+ = let	lifeMap	= foldl' plusUFM emptyUFM $ map raLifetimes stats
+ 	scatter	= map	(\r ->  let Just (_, lifetime)	= lookupUFM lifeMap r
+				    Just node		= Color.lookupNode graph r
+				in parens $ hcat $ punctuate (text ", ")
+					[ doubleQuotes $ ppr $ Color.nodeId node
+					, ppr $ sizeUniqSet (Color.nodeConflicts node)
+					, ppr $ lifetime ])
+		$ map Color.nodeId
+		$ eltsUFM
+		$ Color.graphMap graph
+
+   in 	(  text "-- vreg-conflict-lifetime"
+	$$ text "--   (vreg, vreg_conflicts, vreg_lifetime)"
+	$$ (vcat scatter)
+	$$ text "\n")
+
+
 -----
 -- Register colors for drawing conflict graphs
 --	Keep this out of MachRegs.hs because it's specific to the graph coloring allocator.