X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocColor.hs;h=5c8569145f6ddaf3d79d998b8bcfd225cc390c3f;hb=c62b824e9e8808eb3845ddb1614494b0575eaafd;hp=0145cf7ad096a5038ac52bbe8af9d0a97b67b61c;hpb=1116b8749571c660d446258481e4e74798bbb864;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/RegAllocColor.hs b/compiler/nativeGen/RegAllocColor.hs
index 0145cf7..5c85691 100644
--- a/compiler/nativeGen/RegAllocColor.hs
+++ b/compiler/nativeGen/RegAllocColor.hs
@@ -1,10 +1,8 @@
+{-# OPTIONS -fno-warn-missing-signatures #-}
 -- | Graph coloring register allocator.
 --
--- TODO:
---	The function that choosing the potential spills could be a bit cleverer.
---	Colors in graphviz graphs could be nicer.
+-- TODO: The colors in graphviz graphs for x86_64 and ppc could be nicer.
 --
-{-# OPTIONS -fno-warn-missing-signatures #-}
 
 module RegAllocColor ( 
 	regAlloc,
@@ -35,7 +33,7 @@ import Data.List
 import Data.Maybe
 import Control.Monad
 
--- | The maximum number of build/spill cycles we'll allow.
+-- | The maximum number of build\/spill cycles we'll allow.
 --	We should only need 3 or 4 cycles tops.
 --	If we run for any longer than this we're probably in an infinite loop,
 --	It's probably better just to bail out and report a bug at this stage.
@@ -50,9 +48,9 @@ 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.
-	-> UniqSM 
-		( [NatCmmTop]		-- ^ code with registers allocated.
-		, [RegAllocStats] )	-- ^ stats for each stage of allocation
+	-> UniqSM ( [NatCmmTop], [RegAllocStats] )
+           -- ^ code with registers allocated and stats for each stage of
+           -- allocation
 		
 regAlloc dflags regsFree slotsFree code
  = do
@@ -62,7 +60,7 @@ regAlloc dflags regsFree slotsFree code
 	return	( code_final
 		, reverse debug_codeGraphs )
 
-regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code
+regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code
  = do
  	-- if any of these dump flags are turned on we want to hang on to
 	--	intermediate structures in the allocator - otherwise tell the
@@ -81,20 +79,8 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
 						$ uniqSetToList $ unionManyUniqSets $ eltsUFM regsFree)
 		$$ text "slotsFree   = " <> ppr (sizeUniqSet slotsFree))
 
-
-	-- Brig's algorithm does reckless coalescing for all but the first allocation stage
-	--	Doing this seems to reduce the number of reg-reg moves, but at the cost-
-	--	of creating more spills. Probably better just to stick with conservative 
-	--	coalescing in Color.colorGraph for now.
-	--
-	{- code_coalesced1	<- if (spinCount > 0) 
-				then regCoalesce code
-				else return code -}
-
-	let code_coalesced1	= code
-
  	-- build a conflict graph from the code.
-	graph		<- {-# SCC "BuildGraph" #-} buildGraph code_coalesced1
+	graph		<- {-# SCC "BuildGraph" #-} buildGraph code
 
 	-- VERY IMPORTANT:
 	--	We really do want the graph to be fully evaluated _before_ we start coloring.
@@ -107,7 +93,7 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
 	-- build a map of the cost of spilling each instruction
 	--	this will only actually be computed if we have to spill something.
 	let spillCosts	= foldl' plusSpillCostInfo zeroSpillCostInfo
-			$ map slurpSpillCostInfo code_coalesced1
+			$ map slurpSpillCostInfo code
 
 	-- the function to choose regs to leave uncolored
 	let spill	= chooseSpill spillCosts
@@ -126,14 +112,15 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
 			= {-# SCC "ColorGraph" #-}
 			   Color.colorGraph
 			    	(dopt Opt_RegsIterative dflags)
+				spinCount
 			    	regsFree triv spill graph
 
 	-- rewrite regs in the code that have been coalesced
 	let patchF reg	= case lookupUFM rmCoalesce reg of
 				Just reg'	-> patchF reg'
 				Nothing		-> reg
-	let code_coalesced2
-			= map (patchEraseLive patchF) code_coalesced1
+	let code_coalesced
+			= map (patchEraseLive patchF) code
 
 
 	-- see if we've found a coloring
@@ -148,7 +135,7 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
 				else graph_colored
 
 		-- patch the registers using the info in the graph
-	 	let code_patched	= map (patchRegsFromGraph graph_colored_lint) code_coalesced2
+	 	let code_patched	= map (patchRegsFromGraph graph_colored_lint) code_coalesced
 
 		-- clean out unneeded SPILL/RELOADs
 		let code_spillclean	= map cleanSpills code_patched
@@ -163,12 +150,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 =
@@ -194,7 +182,7 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
 
 	 	-- spill the uncolored regs
 		(code_spilled, slotsFree', spillStats)
-			<- regSpill code_coalesced2 slotsFree rsSpill
+			<- regSpill code_coalesced slotsFree rsSpill
 
 		-- recalculate liveness
 		let code_nat	= map stripLive code_spilled