X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocStats.hs;h=8eb86605ab886500685231fb5d5c8d2ed51edd8b;hb=6a05ec5ef5373f61b7f9f5bdc344483417fa801b;hp=ed54532d5a8025d7d0a528d1c153a98bf2e61e70;hpb=92e1151179b419ce5d7a144993053ae982e0df5e;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs
index ed54532..8eb8660 100644
--- a/compiler/nativeGen/RegAllocStats.hs
+++ b/compiler/nativeGen/RegAllocStats.hs
@@ -1,13 +1,7 @@
-
+{-# OPTIONS -fno-warn-missing-signatures #-}
 -- Carries interesting info for debugging / profiling of the 
 --	graph coloring register allocator.
-
-{-# OPTIONS_GHC -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
--- for details
+--
 
 module RegAllocStats (
 	RegAllocStats (..),
@@ -30,6 +24,7 @@ import qualified GraphColor as Color
 import RegLiveness
 import RegAllocInfo
 import RegSpill
+import RegSpillCost
 import MachRegs
 import MachInstrs
 import Cmm
@@ -46,20 +41,21 @@ data RegAllocStats
 	-- initial graph
 	= RegAllocStatsStart
 	{ raLiveCmm	:: [LiveCmmTop]			  -- ^ initial code, with liveness
-	, raGraph	:: Color.Graph Reg RegClass Reg  -- ^ the initial, uncolored graph
-	, raLifetimes	:: UniqFM (Reg, Int) } 		  -- ^ number of instrs each reg lives for
+	, raGraph	:: Color.Graph Reg RegClass Reg   -- ^ the initial, uncolored graph
+	, raSpillCosts	:: SpillCostInfo } 		  -- ^ information to help choose which regs to spill
 
 	-- 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
+	, raSpillCosts	:: SpillCostInfo 		-- ^ number of instrs each reg lives for
 	, raSpilled	:: [LiveCmmTop] }		-- ^ code with spill instructions added
 
 	-- a successful coloring
 	| RegAllocStatsColored
-	{ raGraph	:: Color.Graph Reg RegClass Reg -- ^ the colored graph
+	{ raGraph	 :: Color.Graph Reg RegClass Reg -- ^ the uncolored graph
+	, raGraphColored :: Color.Graph Reg RegClass Reg -- ^ the coalesced and 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
@@ -90,6 +86,10 @@ instance Outputable RegAllocStats where
 			$$ text ""
 		else empty)
 
+	$$ text "#  Spill costs.  reg uses defs lifetime degree cost"
+	$$ vcat (map (pprSpillCostRecord (raGraph s)) $ eltsUFM $ raSpillCosts s)
+	$$ text ""
+
 	$$ text "#  Spills inserted."
 	$$ ppr (raSpillStats s)
 	$$ text ""
@@ -101,10 +101,14 @@ instance Outputable RegAllocStats where
  ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
  	=  text "#  Colored"
 
-	$$ text "#  Register conflict graph."
+	$$ text "#  Register conflict graph (initial)."
 	$$ Color.dotGraph regDotColor trivColorable (raGraph s)
 	$$ text ""
 
+	$$ text "#  Register conflict graph (colored)."
+	$$ Color.dotGraph regDotColor trivColorable (raGraphColored s)
+	$$ text ""
+
 	$$ (if (not $ isNullUFM $ raCoalesced s)
 		then 	text "#  Registers coalesced."
 			$$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
@@ -162,9 +166,11 @@ pprStatsLifetimes
 	:: [RegAllocStats] -> SDoc
 
 pprStatsLifetimes stats
- = let	lifeMap		= foldl' plusUFM emptyUFM
- 				[ raLifetimes s | s@RegAllocStatsStart{} <- stats ]
-	lifeBins	= binLifetimeCount lifeMap
+ = let	info		= foldl' plusSpillCostInfo zeroSpillCostInfo
+ 				[ raSpillCosts s
+					| s@RegAllocStatsStart{} <- stats ]
+
+	lifeBins	= binLifetimeCount $ lifeMapFromSpillCostInfo info
 
    in	(  text "-- vreg-population-lifetimes"
 	$$ text "--   (instruction_count, number_of_vregs_that_lived_that_long)"
@@ -178,7 +184,7 @@ binLifetimeCount fm
 		$ eltsUFM fm
 
    in	addListToUFM_C
-		(\(l1, c1) (l2, c2) -> (l1, c1 + c2))
+		(\(l1, c1) (_, c2) -> (l1, c1 + c2))
 		emptyUFM
 		lifes
 
@@ -188,7 +194,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 ]
@@ -207,8 +213,9 @@ pprStatsLifeConflict
 	-> SDoc
 
 pprStatsLifeConflict stats graph
- = let	lifeMap	= foldl' plusUFM emptyUFM
- 			[ raLifetimes s	| s@RegAllocStatsStart{} <- stats ]
+ = let	lifeMap	= lifeMapFromSpillCostInfo
+ 		$ foldl' plusSpillCostInfo zeroSpillCostInfo
+		$ [ raSpillCosts s | s@RegAllocStatsStart{} <- stats ]
 
  	scatter	= map	(\r ->  let lifetime	= case lookupUFM lifeMap r of
 							Just (_, l)	-> l
@@ -239,12 +246,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
 
@@ -320,6 +327,7 @@ regDotColor reg
  = case regClass reg of
  	RcInteger	-> text "blue"
 	RcFloat		-> text "red"
+	RcDouble	-> text "green"
 #endif