From: Ben.Lippmeier@anu.edu.au Date: Mon, 20 Aug 2007 09:39:19 +0000 (+0000) Subject: Add vreg-conflicts and vreg-conflict-lifetimes to drop-asm-stats X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=44da8b0ac437e0cd6d85a63a389ca15735f153c0 Add vreg-conflicts and vreg-conflict-lifetimes to drop-asm-stats --- diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index c9779ee..29ffb89 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 @@ -404,6 +403,7 @@ cmmNativeGenDump dflags mod modLocation dump (zip [0..] codeGraphs))) $ map ((\(Just c) -> c) . 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 @@ -416,7 +416,6 @@ cmmNativeGenDump dflags mod modLocation 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. - -- 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" @@ -424,41 +423,17 @@ cmmNativeGenDump dflags mod modLocation dump -- 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{} <- stats] - - -- 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])) - - - 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 + -- build a global conflict graph + let graph = foldl Color.union Color.initGraph $ map raGraph stats - 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") + -- 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 - -- write out the file writeFile dropFile - (showSDoc $ vcat [outSpill, outLife]) + (showSDoc $ vcat [outSpills, outLife, outConflict, outScatter]) return () diff --git a/compiler/nativeGen/GraphOps.hs b/compiler/nativeGen/GraphOps.hs index 86bf6bd..92058e93 100644 --- a/compiler/nativeGen/GraphOps.hs +++ b/compiler/nativeGen/GraphOps.hs @@ -10,7 +10,8 @@ module GraphOps ( addExclusion, addPreference, setColor, - verify + verify, + slurpNodeConflictCount ) where @@ -275,6 +276,24 @@ verify graph else False +-- | Slurp out a map of how many nodes had a certain number of conflict neighbours + +slurpNodeConflictCount + :: Uniquable k + => Graph k cls color + -> UniqFM (Int, Int) -- ^ (conflict neighbours, num nodes with that many conflicts) + +slurpNodeConflictCount graph + = addListToUFM_C + (\(c1, n1) (c2, n2) -> (c1, n1 + n2)) + emptyUFM + $ map (\node + -> let count = sizeUniqSet $ nodeConflicts node + in (count, (count, 1))) + $ eltsUFM + $ graphMap graph + + -- | Set the color of a certain node setColor :: Uniquable k diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs index 844ffcd..ae5f106 100644 --- a/compiler/nativeGen/RegAllocStats.hs +++ b/compiler/nativeGen/RegAllocStats.hs @@ -5,7 +5,11 @@ module RegAllocStats ( RegAllocStats (..), regDotColor, - binLifetimeCount + + pprStatsSpills, + pprStatsLifetimes, + pprStatsConflict, + pprStatsLifeConflict ) where @@ -19,7 +23,9 @@ import MachRegs import Outputable import UniqFM +import UniqSet +import Data.List data RegAllocStats @@ -68,7 +74,43 @@ instance Outputable RegAllocStats where $$ ppr (raPatchedCmm s) ------ +-- | Dump a table of how many spill loads / stores were inserted for each vreg. +pprStatsSpills + :: [RegAllocStats] -> SDoc + +pprStatsSpills stats + = let -- slurp out the stats from all the spiller stages + spillStats = [ s | s@RegAllocStatsSpill{} <- stats] + + -- build a map of how many spill load/stores were inserted for each vreg + spillLS = foldl' (plusUFM_C accSpillLS) emptyUFM + $ map (spillLoadStore . raSpillStats) spillStats + + -- print the count of load/spills as a tuple so we can read back from the file easilly + pprSpillLS (r, loads, stores) + = (parens $ (hcat $ punctuate (text ", ") [doubleQuotes (ppr r), int loads, int stores])) + + + in ( text "-- spills-added" + $$ text "-- (reg_name, spill_loads_added, spill_stores_added)." + $$ (vcat $ map pprSpillLS $ eltsUFM spillLS) + $$ text "\n") + + + +-- | Dump a table of how long vregs tend to live for. +pprStatsLifetimes + :: [RegAllocStats] -> SDoc + +pprStatsLifetimes stats + = let lifeMap = foldl' plusUFM emptyUFM $ map raLifetimes stats + lifeBins = binLifetimeCount lifeMap + + in ( text "-- vreg-population-lifetimes" + $$ text "-- (instruction_count, number_of_vregs_that_lived_that_long)" + $$ (vcat $ map ppr $ eltsUFM lifeBins) + $$ text "\n") + binLifetimeCount :: UniqFM (Reg, Int) -> UniqFM (Int, Int) binLifetimeCount fm = let lifes = map (\l -> (l, (l, 1))) @@ -80,6 +122,46 @@ binLifetimeCount fm emptyUFM lifes + +-- | Dump a table of how many conflicts vregs tend to have. +pprStatsConflict + :: [RegAllocStats] -> SDoc + +pprStatsConflict stats + = let confMap = foldl' (plusUFM_C (\(c1, n1) (c2, n2) -> (c1, n1 + n2))) + emptyUFM + $ map Color.slurpNodeConflictCount + $ map raGraph stats + + in ( text "-- vreg-conflicts" + $$ text "-- (conflict_count, number_of_vregs_that_had_that_many_conflicts)" + $$ (vcat $ map ppr $ eltsUFM confMap) + $$ text "\n") + + +-- | For every vreg, dump it's how many conflicts it has and its lifetime +-- good for making a scatter plot. +pprStatsLifeConflict + :: [RegAllocStats] -> Color.Graph Reg RegClass Reg -> SDoc + +pprStatsLifeConflict stats graph + = let lifeMap = foldl' plusUFM emptyUFM $ map raLifetimes stats + scatter = map (\r -> let Just (_, lifetime) = lookupUFM lifeMap r + Just node = Color.lookupNode graph r + in parens $ hcat $ punctuate (text ", ") + [ doubleQuotes $ ppr $ Color.nodeId node + , ppr $ sizeUniqSet (Color.nodeConflicts node) + , ppr $ lifetime ]) + $ map Color.nodeId + $ eltsUFM + $ Color.graphMap graph + + in ( text "-- vreg-conflict-lifetime" + $$ text "-- (vreg, vreg_conflicts, vreg_lifetime)" + $$ (vcat scatter) + $$ text "\n") + + ----- -- Register colors for drawing conflict graphs -- Keep this out of MachRegs.hs because it's specific to the graph coloring allocator.