X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FAsmCodeGen.lhs;h=13f620fe50b29b4787e16568d8c6b177a2677b4d;hb=dc6cd68f919657139df43136b1bd57520b2a01b2;hp=177ef0ef678a321e5c29c42f08012fa1bf7237af;hpb=475940d68ab79a5f352ccaca485baa17a2df0765;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 177ef0e..13f620f 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -23,7 +23,6 @@ import RegAllocLinear
 import RegAllocStats
 import RegLiveness
 import RegCoalesce
-import qualified RegSpill	as Spill
 import qualified RegAllocColor	as Color
 import qualified GraphColor	as Color
 
@@ -372,79 +371,68 @@ x86fp_kludge top@(CmmProc info lbl params code) =
 cmmNativeGenDump :: DynFlags -> Module -> ModLocation -> [CmmNativeGenDump] -> IO ()
 cmmNativeGenDump dflags mod modLocation dump
  = do
-
 	dumpIfSet_dyn dflags
 		Opt_D_dump_opt_cmm "Optimised Cmm"
 		(pprCmm $ Cmm $ map cdCmmOpt dump)
 
 	dumpIfSet_dyn dflags
-		Opt_D_dump_asm_native   "(asm-native) Native code"
+		Opt_D_dump_asm_native   "Native code"
 		(vcat $ map (docToSDoc . pprNatCmmTop)	$ concatMap cdNative dump)
 
 	dumpIfSet_dyn dflags
-		Opt_D_dump_asm_liveness "(asm-liveness) Liveness info added"
+		Opt_D_dump_asm_liveness "Liveness annotations added"
 		(vcat $ map (ppr . cdLiveness) dump)
 
 	dumpIfSet_dyn dflags
-		Opt_D_dump_asm_coalesce "(asm-coalesce) Register moves coalesced."
-		(vcat $ map (ppr . (\(Just c) -> c) . cdCoalesce) dump)
+		Opt_D_dump_asm_coalesce "Reg-Reg moves coalesced"
+		(vcat $ map (fromMaybe empty . liftM ppr . cdCoalesce) dump)
 
 	dumpIfSet_dyn dflags
-		Opt_D_dump_asm_regalloc "(asm-regalloc) Registers allocated"
+		Opt_D_dump_asm_regalloc "Registers allocated"
 		(vcat $ map (docToSDoc . pprNatCmmTop) $ concatMap cdAlloced dump)
 
 	-- with the graph coloring allocator, show the result of each build/spill stage
 	--	  for each block in turn.
-	mapM_ (\codeGraphs
-	 -> dumpIfSet_dyn dflags
-		Opt_D_dump_asm_regalloc_stages "(asm-regalloc-stages)"
-		(vcat $ map (\(stage, stats) ->
-				 text "-- Stage " <> int stage
-				 $$ ppr stats)
-				(zip [0..] codeGraphs)))
-	 $ map ((\(Just c) -> c) . cdRegAllocStats) dump
+	when (dopt Opt_D_dump_asm_regalloc_stages dflags)
+	 $ do	mapM_ (\stats
+			 -> printDump
+			 $  vcat $ map (\(stage, stats) ->
+					 text "-- Stage " <> int stage
+					 $$ ppr stats)
+					(zip [0..] stats))
+		 $ map (fromMaybe [] . cdRegAllocStats) dump
 
 	-- Build a global register conflict graph.
 	--	If you want to see the graph for just one basic block then use asm-regalloc-stages instead.
 	dumpIfSet_dyn dflags
-		Opt_D_dump_asm_conflicts "(asm-conflicts) Register conflict graph"
+		Opt_D_dump_asm_conflicts "Register conflict graph"
 		$ Color.dotGraph Color.regDotColor trivColorable
 		$ foldl Color.union Color.initGraph
 		$ catMaybes $ map cdColoredGraph dump
 
-
-	-- Drop native code gen statistics.
-	--	This is potentially a large amount of information, so we make a new file instead
-	--	of dumping it to stdout.
+	-- Drop native code generator statistics.
+	--	This is potentially a large amount of information, and we want to be able
+	--	to collect it while running nofib. Drop a new file instead of emitting
+	--	it to stdout/stderr.
 	--
 	when (dopt Opt_D_drop_asm_stats dflags)
 	 $ do	-- make the drop file name based on the object file name
 	 	let dropFile	= (init $ ml_obj_file modLocation) ++ "drop-asm-stats"
 
-		-- slurp out the stats from all the spiller stages
-		let spillStats	= [ s	| s@RegAllocStatsSpill{}
-					<- concat [ c | Just c <- map cdRegAllocStats dump]]
-
-		-- build a map of how many spill load/stores were inserted for each vreg
-		let spillLS	= foldl' (plusUFM_C Spill.accSpillLS) emptyUFM
-				$ map (Spill.spillLoadStore . raSpillStats) spillStats
-
-		-- print the count of load/spills as a tuple so we can read back from the file easilly
-		let pprSpillLS :: (Reg, Int, Int) -> SDoc
-		    pprSpillLS	(r, loads, stores) =
-			(parens $ (hcat $ punctuate (text ", ") [doubleQuotes (ppr r), int loads, int stores]))
+		-- slurp out all the regalloc stats
+		let stats	= concat $ catMaybes $ map cdRegAllocStats dump
 
-		-- write out the file
-		let out		= showSDoc
-				(  text "-- (spills-added)"
-				$$ text "--    Spill instructions inserted for each virtual reg."
-				$$ text "--    (reg name, spill loads added, spill stores added)."
-				$$ (vcat $ map pprSpillLS $ eltsUFM spillLS)
-				$$ text "\n")
+		-- build a global conflict graph
+		let graph	= foldl Color.union Color.initGraph $ map raGraph stats
 
-		writeFile dropFile out
+		-- pretty print the various sections and write out the file.
+		let outSpills	= pprStatsSpills    stats
+		let outLife	= pprStatsLifetimes stats
+		let outConflict	= pprStatsConflict  stats
+		let outScatter	= pprStatsLifeConflict stats graph
 
-		return ()
+		writeFile dropFile
+			(showSDoc $ vcat [outSpills, outLife, outConflict, outScatter])
 
 	return ()