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

diff --git a/compiler/nativeGen/RegAllocColor.hs b/compiler/nativeGen/RegAllocColor.hs
index fc62157..0145cf7 100644
--- a/compiler/nativeGen/RegAllocColor.hs
+++ b/compiler/nativeGen/RegAllocColor.hs
@@ -139,8 +139,16 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
 	-- see if we've found a coloring
 	if isEmptyUniqSet rsSpill
 	 then do
+		-- if -fasm-lint is turned on then validate the graph
+		let graph_colored_lint	=
+			if dopt Opt_DoAsmLinting dflags
+				then Color.validateGraph (text "")
+					True 	-- require all nodes to be colored
+					graph_colored
+				else graph_colored
+
 		-- patch the registers using the info in the graph
-	 	let code_patched	= map (patchRegsFromGraph graph_colored) code_coalesced2
+	 	let code_patched	= map (patchRegsFromGraph graph_colored_lint) code_coalesced2
 
 		-- clean out unneeded SPILL/RELOADs
 		let code_spillclean	= map cleanSpills code_patched
@@ -155,7 +163,7 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
 		-- record what happened in this stage for debugging
 		let stat		=
 			RegAllocStatsColored
-			{ raGraph	= graph_colored
+			{ raGraph	= graph_colored_lint
 			, raCoalesced	= rmCoalesce
 			, raPatched	= code_patched
 			, raSpillClean	= code_spillclean
@@ -172,10 +180,18 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
 
 		return	( code_final
 			, statList
-			, graph_colored)
+			, graph_colored_lint)
 
 	 -- we couldn't find a coloring, time to spill something
 	 else do
+		-- if -fasm-lint is turned on then validate the graph
+		let graph_colored_lint	=
+			if dopt Opt_DoAsmLinting dflags
+				then Color.validateGraph (text "")
+					False 	-- don't require nodes to be colored
+					graph_colored
+				else graph_colored
+
 	 	-- spill the uncolored regs
 		(code_spilled, slotsFree', spillStats)
 			<- regSpill code_coalesced2 slotsFree rsSpill
@@ -187,7 +203,7 @@ regAlloc_spin dflags (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs
 		-- record what happened in this stage for debugging
 		let stat	=
 			RegAllocStatsSpill
-			{ raGraph	= graph_colored
+			{ raGraph	= graph_colored_lint
 			, raCoalesced	= rmCoalesce
 			, raSpillStats	= spillStats
 			, raSpillCosts	= spillCosts