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

diff --git a/compiler/nativeGen/RegAllocColor.hs b/compiler/nativeGen/RegAllocColor.hs
index 933c8ab..ecb5faf 100644
--- a/compiler/nativeGen/RegAllocColor.hs
+++ b/compiler/nativeGen/RegAllocColor.hs
@@ -50,12 +50,12 @@ maxSpinCount	= 10
 -- | The top level of the graph coloring register allocator.
 --	
 regAlloc
-	:: UniqFM (UniqSet Reg)				-- ^ the registers we can use for allocation
-	-> UniqSet Int					-- ^ the set of available spill slots.
-	-> [LiveCmmTop]					-- ^ code annotated with liveness information.
+	:: UniqFM (UniqSet Reg)		-- ^ the registers we can use for allocation
+	-> UniqSet Int			-- ^ the set of available spill slots.
+	-> [LiveCmmTop]			-- ^ code annotated with liveness information.
 	-> UniqSM 
-		( [NatCmmTop]				-- ^ code with registers allocated.
-		, [RegAllocStats] )			-- ^ stats for each stage of allocation
+		( [NatCmmTop]		-- ^ code with registers allocated.
+		, [RegAllocStats] )	-- ^ stats for each stage of allocation
 		
 regAlloc regsFree slotsFree code
  = do
@@ -63,7 +63,7 @@ regAlloc regsFree slotsFree code
 		<- regAlloc_spin 0 trivColorable regsFree slotsFree [] code
 	
 	return	( code_final
-		, debug_codeGraphs )
+		, reverse debug_codeGraphs )
 
 regAlloc_spin (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code 
  = do
@@ -79,11 +79,21 @@ regAlloc_spin (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code
  	-- build a conflict graph from the code.
 	graph		<- buildGraph code
 
-	-- build a map of how many instructions each reg lives for
-	--	this lazy, it won't be computed unless we need to spill
+	-- build a map of how many instructions each reg lives for.
+	--	this is lazy, it won't be computed unless we need to spill
 	let fmLife	= plusUFMs_C (\(r1, l1) (r2, l2) -> (r1, l1 + l2))
 			$ map lifetimeCount code
 
+	-- record startup state
+	let stat1	=
+		if spinCount == 0
+		 then	Just $ RegAllocStatsStart
+		 	{ raLiveCmm	= code
+			, raGraph	= graph
+			, raLifetimes	= fmLife }
+		 else	Nothing
+
+
 	-- the function to choose regs to leave uncolored
 	let spill	= chooseSpill_maxLife fmLife
 	
@@ -96,17 +106,23 @@ regAlloc_spin (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code
 	 then do
 		-- patch the registers using the info in the graph
 	 	let code_patched	= map (patchRegsFromGraph graph_colored) code
+
+		-- 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
-			{ raLiveCmm	= code
-			, raGraph	= graph_colored
-			, raPatchedCmm	= code_patched }
+			{ raGraph	= graph_colored
+			, raPatchedCmm	= code_patched
+			, raFinalCmm	= code_final }
 
 		return	( code_nat
-			, debug_codeGraphs ++ [stat]
+			, [stat] ++ maybeToList stat1 ++ debug_codeGraphs
 			, graph_colored)
 
 	 else do
@@ -121,13 +137,14 @@ regAlloc_spin (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code
 		-- record what happened in this stage for debugging
 		let stat	=
 			RegAllocStatsSpill
-			{ raLiveCmm	= code_spilled
-			, raGraph	= graph_colored
-			, raSpillStats	= spillStats }
+			{ raGraph	= graph_colored
+			, raSpillStats	= spillStats
+			, raLifetimes	= fmLife
+			, raSpilled	= code_spilled }
 			    	
 		-- try again
 		regAlloc_spin (spinCount + 1) triv regsFree slotsFree' 
-			(debug_codeGraphs ++ [stat])
+			([stat] ++ maybeToList stat1 ++ debug_codeGraphs)
 			code_relive
 
  
@@ -192,7 +209,7 @@ buildGraph code
 
 
 -- | Add some conflict edges to the graph.
---	Conflicts between virtual and real regs are recorded as exlusions.
+--	Conflicts between virtual and real regs are recorded as exclusions.
 --
 graphAddConflictSet 
 	:: UniqSet Reg
@@ -213,7 +230,7 @@ graphAddConflictSet set graph
    in	graph2
 	
 
--- | Add some coalesences edges to the graph
+-- | Add some coalesence edges to the graph
 --	Coalesences between virtual and real regs are recorded as preferences.
 --
 graphAddCoalesce