From 6a347ffc34c0ded44c213e2a0217477f7b8196b9 Mon Sep 17 00:00:00 2001
From: "Ben.Lippmeier@anu.edu.au" <unknown>
Date: Mon, 17 Sep 2007 12:42:41 +0000
Subject: [PATCH] Bugfix to iterative coalescer

Coalescences must be applied to the unsimplified graph in the same order
they were found by the iterative coalescing algorithm - otherwise
the vreg rewrite mapping will be wrong and badness will ensue.
---
 compiler/nativeGen/RegAllocColor.hs |   13 +++++++------
 compiler/nativeGen/RegAllocStats.hs |    9 +++++++--
 compiler/utils/GraphColor.hs        |    4 ++--
 compiler/utils/GraphOps.hs          |    8 +++++---
 4 files changed, 21 insertions(+), 13 deletions(-)

diff --git a/compiler/nativeGen/RegAllocColor.hs b/compiler/nativeGen/RegAllocColor.hs
index 0145cf7..40dd64c 100644
--- a/compiler/nativeGen/RegAllocColor.hs
+++ b/compiler/nativeGen/RegAllocColor.hs
@@ -163,12 +163,13 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
 		-- record what happened in this stage for debugging
 		let stat		=
 			RegAllocStatsColored
-			{ raGraph	= graph_colored_lint
-			, raCoalesced	= rmCoalesce
-			, raPatched	= code_patched
-			, raSpillClean	= code_spillclean
-			, raFinal	= code_final
-			, raSRMs	= foldl' addSRM (0, 0, 0) $ map countSRMs code_spillclean }
+			{ raGraph		= graph
+			, raGraphColored	= graph_colored_lint
+			, raCoalesced		= rmCoalesce
+			, raPatched		= code_patched
+			, raSpillClean		= code_spillclean
+			, raFinal		= code_final
+			, raSRMs		= foldl' addSRM (0, 0, 0) $ map countSRMs code_spillclean }
 
 
 		let statList =
diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs
index 81578a3..ca71f9d 100644
--- a/compiler/nativeGen/RegAllocStats.hs
+++ b/compiler/nativeGen/RegAllocStats.hs
@@ -54,7 +54,8 @@ data RegAllocStats
 
 	-- 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
@@ -100,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)
diff --git a/compiler/utils/GraphColor.hs b/compiler/utils/GraphColor.hs
index 09fc5c2..bd777b7 100644
--- a/compiler/utils/GraphColor.hs
+++ b/compiler/utils/GraphColor.hs
@@ -138,7 +138,7 @@ colorScan_spin iterative triv spill graph
 
 	-- if the graph is empty then we're done
 	| isNullUFM $ graphMap graph
-	= (ksTriv, ksSpill, kksCoalesce)
+	= (ksTriv, ksSpill, reverse kksCoalesce)
 
 	-- Simplify:
 	--	Look for trivially colorable nodes.
@@ -172,7 +172,7 @@ colorScan_spin iterative triv spill graph
 		--	go back to Simplify and see if this frees up more nodes to be trivially colorable.
 		(graph2, kksCoalesceFound @(_:_))
 		 -> colorScan_spin iterative triv spill graph2
-			ksTriv ksSpill (kksCoalesceFound ++ kksCoalesce)
+			ksTriv ksSpill (reverse kksCoalesceFound ++ kksCoalesce)
 
 		-- Freeze:
 		-- nothing could be coalesced (or was triv),
diff --git a/compiler/utils/GraphOps.hs b/compiler/utils/GraphOps.hs
index ad5e18f..972dd07 100644
--- a/compiler/utils/GraphOps.hs
+++ b/compiler/utils/GraphOps.hs
@@ -273,7 +273,9 @@ coalesceGraph
 				--	less colorable (aggressive coalescing)
 	-> Triv k cls color
 	-> Graph k cls color
-	-> (Graph k cls color, [(k, k)])
+	-> ( Graph k cls color
+	   , [(k, k)])		-- pairs of nodes that were coalesced, in the order that the
+	   			--	coalescing was applied.
 
 coalesceGraph aggressive triv graph
 	= coalesceGraph' aggressive triv graph []
@@ -301,8 +303,8 @@ coalesceGraph' aggressive triv graph kkPairsAcc
 
 	-- keep running until there are no more coalesces can be found
    in	case catMaybes mPairs of
-	 []	-> (graph', kkPairsAcc)
-	 pairs	-> coalesceGraph' aggressive triv graph' (pairs ++ kkPairsAcc)
+	 []	-> (graph', reverse kkPairsAcc)
+	 pairs	-> coalesceGraph' aggressive triv graph' (reverse pairs ++ kkPairsAcc)
 
 
 -- | Coalesce this pair of nodes unconditionally / agressively.
-- 
1.7.10.4