X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocColor.hs;h=c49a94dc8fa0ec5f311a16df9020b27793d03933;hb=589238c4c2712d29092086926cc48eeb5e9b8fa7;hp=45727c5070a9603549504085edafd2c75a681c66;hpb=eeea62298b2ee975f84f1d50c71ac458ffb7c6a4;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/RegAllocColor.hs b/compiler/nativeGen/RegAllocColor.hs
index 45727c5..c49a94d 100644
--- a/compiler/nativeGen/RegAllocColor.hs
+++ b/compiler/nativeGen/RegAllocColor.hs
@@ -13,6 +13,13 @@
 --	Colors in graphviz graphs could be nicer.
 --
 
+{-# 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 RegAllocColor ( 
 	regAlloc,
 	regDotColor
@@ -23,10 +30,10 @@ where
 import qualified GraphColor	as Color
 import RegLiveness
 import RegSpill
+import RegSpillClean
 import RegAllocStats
 import MachRegs
 import MachInstrs
-import RegCoalesce
 import PprMach
 
 import UniqSupply
@@ -108,6 +115,9 @@ regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs c
 		-- patch the registers using the info in the graph
 	 	let code_patched	= map (patchRegsFromGraph graph_colored) code
 
+		-- clean out unneeded SPILL/RELOADs
+		let code_spillclean	= map cleanSpills code_patched
+
 		-- strip off liveness information
 		let code_nat		= map stripLive code_patched
 
@@ -119,10 +129,12 @@ regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs c
 		let stat		=
 			RegAllocStatsColored
 			{ raGraph	= graph_colored
-			, raPatchedCmm	= code_patched
-			, raFinalCmm	= code_final }
+			, raPatched	= code_patched
+			, raSpillClean	= code_spillclean
+			, raFinal	= code_final
+			, raSRMs	= foldl addSRM (0, 0, 0) $ map countSRMs code_spillclean }
 
-		return	( code_nat
+		return	( code_final
 			, if dump
 				then [stat] ++ maybeToList stat1 ++ debug_codeGraphs
 				else []
@@ -201,16 +213,20 @@ buildGraph
 	
 buildGraph code
  = do
- 	-- Add the reg-reg conflicts to the graph
-	let conflictSets	= unionManyBags (map slurpConflicts code)
-	let graph_conflict	= foldrBag graphAddConflictSet Color.initGraph conflictSets
+	-- Slurp out the conflicts and reg->reg moves from this code
+	let (conflictList, moveList) =
+		unzip $ map slurpConflicts code
 
+	let conflictBag		= unionManyBags conflictList
+	let moveBag		= unionManyBags moveList
+
+ 	-- Add the reg-reg conflicts to the graph
+	let graph_conflict	= foldrBag graphAddConflictSet Color.initGraph conflictBag
 
 	-- Add the coalescences edges to the graph.
-	let coalesce		= unionManyBags (map slurpJoinMovs code)
-	let graph_coalesce	= foldrBag graphAddCoalesce graph_conflict coalesce
+	let graph_coalesce	= foldrBag graphAddCoalesce graph_conflict moveBag
 			
-	return	$ graph_coalesce
+	return	graph_coalesce
 
 
 -- | Add some conflict edges to the graph.