X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocStats.hs;h=a762f832a7438b7393f727cfca529c2cc571ecc2;hb=4839f119310cd82dec679239e0897e4a2a26ee92;hp=844ffcd4469367bb5a3ff145dbcc039875a0fbe9;hpb=83a47256f9914c1bd15841dd1806981793b50c7e;p=ghc-hetmet.git diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs index 844ffcd..a762f83 100644 --- a/compiler/nativeGen/RegAllocStats.hs +++ b/compiler/nativeGen/RegAllocStats.hs @@ -5,7 +5,12 @@ module RegAllocStats ( RegAllocStats (..), regDotColor, - binLifetimeCount + + pprStats, + pprStatsSpills, + pprStatsLifetimes, + pprStatsConflict, + pprStatsLifeConflict ) where @@ -16,59 +21,127 @@ import qualified GraphColor as Color import RegLiveness import RegSpill import MachRegs +import MachInstrs import Outputable import UniqFM +import UniqSet +import Data.List data RegAllocStats + -- initial graph + = RegAllocStatsStart + { raLiveCmm :: [LiveCmmTop] -- ^ initial code, with liveness + , raGraph :: Color.Graph Reg RegClass Reg -- ^ the initial, uncolored graph + , raLifetimes :: UniqFM (Reg, Int) } -- ^ number of instrs each reg lives for + -- a spill stage - = RegAllocStatsSpill - { raLiveCmm :: [LiveCmmTop] -- ^ code we tried to allocate regs for - , raGraph :: Color.Graph Reg RegClass Reg -- ^ the partially colored graph + | RegAllocStatsSpill + { raGraph :: Color.Graph Reg RegClass Reg -- ^ the partially colored graph , raSpillStats :: SpillStats -- ^ spiller stats - , raLifetimes :: UniqFM (Reg, Int) } -- ^ number of instrs each reg lives for + , raLifetimes :: UniqFM (Reg, Int) -- ^ number of instrs each reg lives for + , raSpilled :: [LiveCmmTop] } -- ^ code with spill instructions added -- a successful coloring | RegAllocStatsColored - { raLiveCmm :: [LiveCmmTop] -- ^ the code we allocated regs for - , raGraph :: Color.Graph Reg RegClass Reg -- ^ the colored graph - , raPatchedCmm :: [LiveCmmTop] -- ^ code with register allocation - , raLifetimes :: UniqFM (Reg, Int) } -- ^ number of instrs each reg lives for - + { raGraph :: Color.Graph Reg RegClass Reg -- ^ the colored graph + , raPatchedCmm :: [LiveCmmTop] -- ^ code after register allocation + , raFinalCmm :: [NatCmmTop] } -- ^ final code instance Outputable RegAllocStats where - ppr (s@RegAllocStatsSpill{}) - = text "-- Spill" - - $$ text "-- Native code with liveness information." + ppr (s@RegAllocStatsStart{}) + = text "# Start" + $$ text "# Native code with liveness information." $$ ppr (raLiveCmm s) - $$ text " " - - $$ text "-- Register conflict graph." + $$ text "" + $$ text "# Initial register conflict graph." $$ Color.dotGraph regDotColor trivColorable (raGraph s) - $$ text "-- Spill statistics." + ppr (s@RegAllocStatsSpill{}) + = text "# Spill" + $$ text "# Register conflict graph." + $$ Color.dotGraph regDotColor trivColorable (raGraph s) + $$ text "" + $$ text "# Spills inserted." $$ ppr (raSpillStats s) - + $$ text "" + $$ text "# Code with spills inserted." + $$ (ppr (raSpilled s)) ppr (s@RegAllocStatsColored{}) - = text "-- Colored" - - $$ text "-- Native code with liveness information." - $$ ppr (raLiveCmm s) - $$ text " " - - $$ text "-- Register conflict graph." + = text "# Colored" + $$ text "# Register conflict graph." $$ Color.dotGraph regDotColor trivColorable (raGraph s) - - $$ text "-- Native code after register allocation." + $$ text "" + $$ text "# Native code after register allocation." $$ ppr (raPatchedCmm s) + $$ text "" + $$ text "# Final code, after rewriting spill/rewrite pseudo instrs." + $$ ppr (raFinalCmm s) + $$ text "" + + +-- | Do all the different analysis on this list of RegAllocStats +pprStats :: [RegAllocStats] -> Color.Graph Reg RegClass Reg -> SDoc +pprStats stats graph + = let outSpills = pprStatsSpills stats + outLife = pprStatsLifetimes stats + outConflict = pprStatsConflict stats + outScatter = pprStatsLifeConflict stats graph + + in vcat [outSpills, outLife, outConflict, outScatter] + + +-- | 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 + spillSL = foldl' (plusUFM_C accSpillSL) emptyUFM + $ map (spillStoreLoad . raSpillStats) spillStats + + -- print the count of load/spills as a tuple so we can read back from the file easilly + pprSpillSL (r, loads, stores) + = (parens $ (hcat $ punctuate (text ", ") [doubleQuotes (ppr r), int loads, int stores])) + + -- sum up the total number of spill instructions inserted + spillList = eltsUFM spillSL + spillTotal = foldl' (\(s1, l1) (s2, l2) -> (s1 + s2, l1 + l2)) + (0, 0) + $ map (\(n, s, l) -> (s, l)) + $ spillList + + in ( text "-- spills-added-total" + $$ text "-- (stores, loads)" + $$ (ppr spillTotal) + $$ text "" + $$ text "-- spills-added" + $$ text "-- (reg_name, stores, loads)" + $$ (vcat $ map pprSpillSL $ spillList) + $$ text "") + + +-- | Dump a table of how long vregs tend to live for in the initial code. +pprStatsLifetimes + :: [RegAllocStats] -> SDoc + +pprStatsLifetimes stats + = let lifeMap = foldl' plusUFM emptyUFM + [ raLifetimes s | s@RegAllocStatsStart{} <- 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 +153,52 @@ binLifetimeCount fm emptyUFM lifes + +-- | Dump a table of how many conflicts vregs tend to have in the initial code. +pprStatsConflict + :: [RegAllocStats] -> SDoc + +pprStatsConflict stats + = let confMap = foldl' (plusUFM_C (\(c1, n1) (c2, n2) -> (c1, n1 + n2))) + emptyUFM + $ map Color.slurpNodeConflictCount + [ raGraph s | s@RegAllocStatsStart{} <- 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 -- ^ global register conflict graph + -> SDoc + +pprStatsLifeConflict stats graph + = let lifeMap = foldl' plusUFM emptyUFM + [ raLifetimes s | s@RegAllocStatsStart{} <- stats ] + + scatter = map (\r -> let lifetime = case lookupUFM lifeMap r of + Just (_, l) -> l + Nothing -> 0 + 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.