From 4839f119310cd82dec679239e0897e4a2a26ee92 Mon Sep 17 00:00:00 2001
From: "Ben.Lippmeier@anu.edu.au" <unknown>
Date: Fri, 24 Aug 2007 09:57:34 +0000
Subject: [PATCH] Show spill/reload pseudo instrs in regalloc stage dump

---
 compiler/nativeGen/RegAllocColor.hs |   11 +++++++----
 compiler/nativeGen/RegAllocStats.hs |    9 +++++++--
 compiler/nativeGen/RegLiveness.hs   |   24 ++++++++++++------------
 3 files changed, 26 insertions(+), 18 deletions(-)

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
diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs
index 798af02..a762f83 100644
--- a/compiler/nativeGen/RegAllocStats.hs
+++ b/compiler/nativeGen/RegAllocStats.hs
@@ -21,6 +21,7 @@ import qualified GraphColor as Color
 import RegLiveness
 import RegSpill
 import MachRegs
+import MachInstrs
 
 import Outputable
 import UniqFM
@@ -46,8 +47,8 @@ data RegAllocStats
 	-- a successful coloring
 	| RegAllocStatsColored
 	{ raGraph	:: Color.Graph Reg RegClass Reg -- ^ the colored graph
-	, raPatchedCmm	:: [LiveCmmTop] }		-- ^ code after register allocation
-
+	, raPatchedCmm	:: [LiveCmmTop] 		-- ^ code after register allocation 
+	, raFinalCmm	:: [NatCmmTop] }		-- ^ final code
 
 instance Outputable RegAllocStats where
 
@@ -77,6 +78,10 @@ instance Outputable RegAllocStats where
 	$$ text ""
 	$$ text "#  Native code after register allocation."
 	$$ ppr (raPatchedCmm s)
+	$$ text ""
+	$$ text "#  Final code, after rewriting spill/rewrite pseudo instrs."
+	$$ ppr (raFinalCmm s)
+	$$ text ""
 
 
 -- | Do all the different analysis on this list of RegAllocStats
diff --git a/compiler/nativeGen/RegLiveness.hs b/compiler/nativeGen/RegLiveness.hs
index 8f313ae..1ba241f 100644
--- a/compiler/nativeGen/RegLiveness.hs
+++ b/compiler/nativeGen/RegLiveness.hs
@@ -178,9 +178,6 @@ mapGenBlockTopM f (CmmProc header label params blocks)
  	return	$ CmmProc header label params blocks'
 
 
-
-
-
 -- | Slurp out the list of register conflicts from this top level thing.
 
 slurpConflicts :: LiveCmmTop -> Bag (UniqSet Reg)
@@ -248,22 +245,25 @@ spillNatBlock :: NatBasicBlock -> NatBasicBlock
 spillNatBlock (BasicBlock i instrs)
  = 	BasicBlock i instrs'
  where 	(instrs', _)
- 		= runState (mapM spillNat instrs) 0
+ 		= runState (spillNat [] instrs) 0
+
+	spillNat acc []
+	 = 	return (reverse acc)
 
-	spillNat instr@(DELTA i)
+	spillNat acc (instr@(DELTA i) : instrs)
 	 = do	put i
-	 	return instr
+	 	spillNat acc instrs
 
-	spillNat (SPILL reg slot)
+	spillNat acc (SPILL reg slot : instrs)
 	 = do	delta	<- get
-	 	return	$ mkSpillInstr reg delta slot
+	 	spillNat (mkSpillInstr reg delta slot : acc) instrs
 
-	spillNat (RELOAD slot reg)
+	spillNat acc (RELOAD slot reg : instrs)
 	 = do	delta	<- get
-	 	return	$ mkLoadInstr reg delta slot
+	 	spillNat (mkLoadInstr reg delta slot : acc) instrs
 
-	spillNat instr
-	 =	return instr
+	spillNat acc (instr : instrs)
+	 =	spillNat (instr : acc) instrs
 
 
 -- | Slurp out a map of how many times each register was live upon entry to an instruction.
-- 
1.7.10.4