X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocStats.hs;h=728225abb938120b1e7071cac936670f4cb86561;hb=a8312580d6f089d153d8af668484d4c2eb75e8a8;hp=a38db1d88edbe6ae2ff840753e6b098e140a657f;hpb=f8c572418898d4c0e703f6d67510c9c37b51cc6e;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs
index a38db1d..728225a 100644
--- a/compiler/nativeGen/RegAllocStats.hs
+++ b/compiler/nativeGen/RegAllocStats.hs
@@ -1,6 +1,7 @@
-
 -- Carries interesting info for debugging / profiling of the 
 --	graph coloring register allocator.
+--
+{-# OPTIONS -fno-warn-missing-signatures #-}
 
 module RegAllocStats (
 	RegAllocStats (..),
@@ -45,6 +46,7 @@ data RegAllocStats
 	-- a spill stage
 	| RegAllocStatsSpill
 	{ raGraph	:: Color.Graph Reg RegClass Reg	-- ^ the partially colored graph
+	, raCoalesced	:: UniqFM Reg			-- ^ the regs that were coaleced
 	, raSpillStats	:: SpillStats 			-- ^ spiller stats
 	, raLifetimes	:: UniqFM (Reg, Int) 		-- ^ number of instrs each reg lives for
 	, raSpilled	:: [LiveCmmTop] }		-- ^ code with spill instructions added
@@ -52,6 +54,7 @@ data RegAllocStats
 	-- a successful coloring
 	| RegAllocStatsColored
 	{ raGraph	:: Color.Graph Reg RegClass Reg -- ^ the colored graph
+	, raCoalesced	:: UniqFM Reg			-- ^ the regs that were coaleced
 	, raPatched	:: [LiveCmmTop] 		-- ^ code with vregs replaced by hregs
 	, raSpillClean  :: [LiveCmmTop]			-- ^ code with unneeded spill/reloads cleaned out
 	, raFinal	:: [NatCmmTop] 			-- ^ final code
@@ -67,28 +70,49 @@ instance Outputable RegAllocStats where
 	$$ text "#  Initial register conflict graph."
 	$$ Color.dotGraph regDotColor trivColorable (raGraph s)
 
+
  ppr (s@RegAllocStatsSpill{})
  	=  text "#  Spill"
+
 	$$ text "#  Register conflict graph."
 	$$ Color.dotGraph regDotColor trivColorable (raGraph s)
 	$$ text ""
+
+	$$ (if (not $ isNullUFM $ raCoalesced s)
+		then 	text "#  Registers coalesced."
+			$$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
+			$$ text ""
+		else empty)
+
 	$$ text "#  Spills inserted."
 	$$ ppr (raSpillStats s)
 	$$ text ""
+
 	$$ text "#  Code with spills inserted."
 	$$ (ppr (raSpilled s))
 
+
  ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
  	=  text "#  Colored"
+
 	$$ text "#  Register conflict graph."
 	$$ Color.dotGraph regDotColor trivColorable (raGraph s)
 	$$ text ""
+
+	$$ (if (not $ isNullUFM $ raCoalesced s)
+		then 	text "#  Registers coalesced."
+			$$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
+			$$ text ""
+		else empty)
+
 	$$ text "#  Native code after register allocation."
 	$$ ppr (raPatched s)
 	$$ text ""
+
 	$$ text "#  Clean out unneeded spill/reloads."
 	$$ ppr (raSpillClean s)
 	$$ text ""
+
 	$$ text "#  Final code, after rewriting spill/rewrite pseudo instrs."
 	$$ ppr (raFinal s)
 	$$ text ""
@@ -148,7 +172,7 @@ binLifetimeCount fm
 		$ eltsUFM fm
 
    in	addListToUFM_C
-		(\(l1, c1) (l2, c2) -> (l1, c1 + c2))
+		(\(l1, c1) (_, c2) -> (l1, c1 + c2))
 		emptyUFM
 		lifes
 
@@ -158,7 +182,7 @@ pprStatsConflict
 	:: [RegAllocStats] -> SDoc
 
 pprStatsConflict stats
- = let	confMap	= foldl' (plusUFM_C (\(c1, n1) (c2, n2) -> (c1, n1 + n2)))
+ = let	confMap	= foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
 			emptyUFM
 		$ map Color.slurpNodeConflictCount
 			[ raGraph s | s@RegAllocStatsStart{} <- stats ]
@@ -209,12 +233,12 @@ countSRM_block (BasicBlock i instrs)
  = do	instrs'	<- mapM countSRM_instr instrs
  	return	$ BasicBlock i instrs'
 
-countSRM_instr li@(Instr instr live)
-	| SPILL reg slot	<- instr
+countSRM_instr li@(Instr instr _)
+	| SPILL _ _	<- instr
 	= do	modify 	$ \(s, r, m)	-> (s + 1, r, m)
 		return li
 
-	| RELOAD slot reg	<- instr
+	| RELOAD _ _	<- instr
 	= do	modify	$ \(s, r, m)	-> (s, r + 1, m)
 		return li