X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocColor.hs;h=ecb5fafc655f843454c46d46309f76f2ffd4e995;hb=4839f119310cd82dec679239e0897e4a2a26ee92;hp=92efc4a1d324e08e7219c6b7f8eb6c4c7d6dc6a7;hpb=0168c633a9d209e978528f059193d19cdb5e6740;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/RegAllocColor.hs b/compiler/nativeGen/RegAllocColor.hs
index 92efc4a..ecb5faf 100644
--- a/compiler/nativeGen/RegAllocColor.hs
+++ b/compiler/nativeGen/RegAllocColor.hs
@@ -105,18 +105,21 @@ regAlloc_spin (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code
 	if isEmptyUniqSet rsSpill
 	 then do
 		-- patch the registers using the info in the graph
-		--	also rewrite SPILL/REALOAD pseudos into real instructions
 	 	let code_patched	= map (patchRegsFromGraph graph_colored) code
 
-		let spillNatTop		= mapGenBlockTop spillNatBlock
-		let code_nat		= map (spillNatTop . stripLive) code_patched
+		-- strip off liveness information
+		let code_nat		= map stripLive code_patched
 
+		-- rewrite SPILL/REALOAD pseudos into real instructions
+		let spillNatTop		= mapGenBlockTop spillNatBlock
+		let code_final		= map spillNatTop code_nat
 		
 		-- record what happened in this stage for debugging
 		let stat		=
 			RegAllocStatsColored
 			{ raGraph	= graph_colored
-			, raPatchedCmm	= code_patched }
+			, raPatchedCmm	= code_patched
+			, raFinalCmm	= code_final }
 
 		return	( code_nat
 			, [stat] ++ maybeToList stat1 ++ debug_codeGraphs