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

diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 177ef0e..c9779ee 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -421,9 +421,12 @@ cmmNativeGenDump dflags mod modLocation dump
 	 $ do	-- make the drop file name based on the object file name
 	 	let dropFile	= (init $ ml_obj_file modLocation) ++ "drop-asm-stats"
 
+		-- slurp out all the regalloc stats
+		let stats	= concat $ catMaybes $ map cdRegAllocStats dump
+
+		---- Spiller
 		-- slurp out the stats from all the spiller stages
-		let spillStats	= [ s	| s@RegAllocStatsSpill{}
-					<- concat [ c | Just c <- map cdRegAllocStats dump]]
+		let spillStats	= [ s	| s@RegAllocStatsSpill{} <- stats]
 
 		-- build a map of how many spill load/stores were inserted for each vreg
 		let spillLS	= foldl' (plusUFM_C Spill.accSpillLS) emptyUFM
@@ -434,15 +437,28 @@ cmmNativeGenDump dflags mod modLocation dump
 		    pprSpillLS	(r, loads, stores) =
 			(parens $ (hcat $ punctuate (text ", ") [doubleQuotes (ppr r), int loads, int stores]))
 
-		-- 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)
+
+		let outSpill	= ( 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")
+
+		---- Lifetimes
+		-- slurp out the maps of all the reg lifetimes
+		let lifetimes	= map raLifetimes stats
+		let lifeMap	= foldl' plusUFM emptyUFM $ map raLifetimes stats
+		let lifeBins	= binLifetimeCount lifeMap
+
+		let outLife	= ( text "-- (vreg-population-lifetimes)"
+				$$  text "--   Number of vregs which lived for a certain number of instructions"
+				$$  text "--   (instruction_count, number_of_vregs_that_lived_that_long)"
+				$$ (vcat $ map ppr $ eltsUFM lifeBins)
 				$$ text "\n")
 
-		writeFile dropFile out
+		-- write out the file
+		writeFile dropFile
+			(showSDoc $ vcat [outSpill, outLife])
 
 		return ()