X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocColor.hs;fp=compiler%2FnativeGen%2FRegAllocColor.hs;h=a2b98f1f6a31e32bc71dfac6ed57013f81a930de;hb=295d2a0018243d94a7bd4e72d88d056db32ff3cf;hp=271c1a5ebcdbb976369383557d9b491293002bd3;hpb=a12bf21a5e9c2b7888cd0ed0c60b9ec1e7295df1;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/RegAllocColor.hs b/compiler/nativeGen/RegAllocColor.hs
index 271c1a5..a2b98f1 100644
--- a/compiler/nativeGen/RegAllocColor.hs
+++ b/compiler/nativeGen/RegAllocColor.hs
@@ -119,7 +119,7 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
 
 	-- rewrite regs in the code that have been coalesced
 	let patchF reg	= case lookupUFM rmCoalesce reg of
-				Just reg'	-> reg'
+				Just reg'	-> patchF reg'
 				Nothing		-> reg
 	let code_coalesced
 			= map (patchEraseLive patchF) code
@@ -246,16 +246,18 @@ buildGraph code
 	let (conflictList, moveList) =
 		unzip $ map slurpConflicts code
 
-	let conflictBag		= unionManyBags conflictList
-	let moveBag		= unionManyBags moveList
+	-- Slurp out the spill/reload coalesces
+	let moveList2		= map slurpReloadCoalesce code
 
  	-- Add the reg-reg conflicts to the graph
+	let conflictBag		= unionManyBags conflictList
 	let graph_conflict	= foldrBag graphAddConflictSet Color.initGraph conflictBag
 
 	-- Add the coalescences edges to the graph.
+	let moveBag		= unionBags (unionManyBags moveList2) (unionManyBags moveList)
 	let graph_coalesce	= foldrBag graphAddCoalesce graph_conflict moveBag
 			
-	return	graph_coalesce
+	return	$ Color.validateGraph (text "urk") graph_coalesce
 
 
 -- | Add some conflict edges to the graph.
@@ -326,7 +328,7 @@ patchRegsFromGraph graph code
 			(  text "There is no node in the graph for register " <> ppr reg
 			$$ ppr code
 			$$ Color.dotGraph (\_ -> text "white") trivColorable graph)
-	
+
    in	patchEraseLive patchF code