X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocStats.hs;h=a38db1d88edbe6ae2ff840753e6b098e140a657f;hb=f8c572418898d4c0e703f6d67510c9c37b51cc6e;hp=844ffcd4469367bb5a3ff145dbcc039875a0fbe9;hpb=83a47256f9914c1bd15841dd1806981793b50c7e;p=ghc-hetmet.git diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs index 844ffcd..a38db1d 100644 --- a/compiler/nativeGen/RegAllocStats.hs +++ b/compiler/nativeGen/RegAllocStats.hs @@ -5,7 +5,14 @@ module RegAllocStats ( RegAllocStats (..), regDotColor, - binLifetimeCount + + pprStats, + pprStatsSpills, + pprStatsLifetimes, + pprStatsConflict, + pprStatsLifeConflict, + + countSRMs, addSRM ) where @@ -14,61 +21,126 @@ where import qualified GraphColor as Color import RegLiveness +import RegAllocInfo import RegSpill import MachRegs +import MachInstrs +import Cmm import Outputable import UniqFM +import UniqSet +import State +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 + , raPatched :: [LiveCmmTop] -- ^ code with vregs replaced by hregs + , raSpillClean :: [LiveCmmTop] -- ^ code with unneeded spill/reloads cleaned out + , raFinal :: [NatCmmTop] -- ^ final code + , raSRMs :: (Int, Int, Int) } -- ^ spill/reload/reg-reg moves present in this 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." + ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) }) + = text "# Colored" + $$ text "# Register conflict graph." $$ Color.dotGraph regDotColor trivColorable (raGraph s) + $$ text "" + $$ text "# Native code after register allocation." + $$ ppr (raPatched s) + $$ text "" + $$ text "# Clean out unneeded spill/reloads." + $$ ppr (raSpillClean s) + $$ text "" + $$ text "# Final code, after rewriting spill/rewrite pseudo instrs." + $$ ppr (raFinal s) + $$ text "" + $$ text "# Score:" + $$ (text "# spills inserted: " <> int spills) + $$ (text "# reloads inserted: " <> int reloads) + $$ (text "# reg-reg moves remaining: " <> int moves) + $$ 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 + finals = [ s | s@RegAllocStatsColored{} <- stats] + + -- sum up how many stores/loads/reg-reg-moves were left in the code + total = foldl' addSRM (0, 0, 0) + $ map raSRMs finals + + in ( text "-- spills-added-total" + $$ text "-- (stores, loads, reg_reg_moves_remaining)" + $$ ppr total + $$ 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") - $$ text "-- Native code after register allocation." - $$ ppr (raPatchedCmm s) - - ------ binLifetimeCount :: UniqFM (Reg, Int) -> UniqFM (Int, Int) binLifetimeCount fm = let lifes = map (\l -> (l, (l, 1))) @@ -80,6 +152,83 @@ 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") + + +-- | Count spill/reload/reg-reg moves. +-- Lets us see how well the register allocator has done. +-- +countSRMs :: LiveCmmTop -> (Int, Int, Int) +countSRMs cmm + = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0) + +countSRM_block (BasicBlock i instrs) + = do instrs' <- mapM countSRM_instr instrs + return $ BasicBlock i instrs' + +countSRM_instr li@(Instr instr live) + | SPILL reg slot <- instr + = do modify $ \(s, r, m) -> (s + 1, r, m) + return li + + | RELOAD slot reg <- instr + = do modify $ \(s, r, m) -> (s, r + 1, m) + return li + + | Just _ <- isRegRegMove instr + = do modify $ \(s, r, m) -> (s, r, m + 1) + return li + + | otherwise + = return li + +-- sigh.. +addSRM (s1, r1, m1) (s2, r2, m2) + = (s1+s2, r1+r2, m1+m2) + ----- -- Register colors for drawing conflict graphs -- Keep this out of MachRegs.hs because it's specific to the graph coloring allocator.