X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocStats.hs;h=728225abb938120b1e7071cac936670f4cb86561;hb=272f0ba89eca1d9fc700cf4c27b9f8c3e23d6fe8;hp=a762f832a7438b7393f727cfca529c2cc571ecc2;hpb=4839f119310cd82dec679239e0897e4a2a26ee92;p=ghc-hetmet.git diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs index a762f83..728225a 100644 --- a/compiler/nativeGen/RegAllocStats.hs +++ b/compiler/nativeGen/RegAllocStats.hs @@ -1,6 +1,7 @@ - -- Carries interesting info for debugging / profiling of the -- graph coloring register allocator. +-- +{-# OPTIONS -fno-warn-missing-signatures #-} module RegAllocStats ( RegAllocStats (..), @@ -10,7 +11,9 @@ module RegAllocStats ( pprStatsSpills, pprStatsLifetimes, pprStatsConflict, - pprStatsLifeConflict + pprStatsLifeConflict, + + countSRMs, addSRM ) where @@ -19,13 +22,16 @@ 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 @@ -40,6 +46,7 @@ data RegAllocStats -- a spill stage | RegAllocStatsSpill { raGraph :: Color.Graph Reg RegClass Reg -- ^ the partially colored graph + , raCoalesced :: UniqFM Reg -- ^ the regs that were coaleced , raSpillStats :: SpillStats -- ^ spiller stats , raLifetimes :: UniqFM (Reg, Int) -- ^ number of instrs each reg lives for , raSpilled :: [LiveCmmTop] } -- ^ code with spill instructions added @@ -47,8 +54,11 @@ data RegAllocStats -- a successful coloring | RegAllocStatsColored { raGraph :: Color.Graph Reg RegClass Reg -- ^ the colored graph - , raPatchedCmm :: [LiveCmmTop] -- ^ code after register allocation - , raFinalCmm :: [NatCmmTop] } -- ^ final code + , raCoalesced :: UniqFM Reg -- ^ the regs that were coaleced + , 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 @@ -60,29 +70,57 @@ instance Outputable RegAllocStats where $$ text "# Initial register conflict graph." $$ Color.dotGraph regDotColor trivColorable (raGraph s) + ppr (s@RegAllocStatsSpill{}) = text "# Spill" + $$ text "# Register conflict graph." $$ Color.dotGraph regDotColor trivColorable (raGraph s) $$ text "" + + $$ (if (not $ isNullUFM $ raCoalesced s) + then text "# Registers coalesced." + $$ (vcat $ map ppr $ ufmToList $ raCoalesced s) + $$ text "" + else empty) + $$ text "# Spills inserted." $$ ppr (raSpillStats s) $$ text "" + $$ text "# Code with spills inserted." $$ (ppr (raSpilled s)) - ppr (s@RegAllocStatsColored{}) + + ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) }) = text "# Colored" + $$ text "# Register conflict graph." $$ Color.dotGraph regDotColor trivColorable (raGraph s) $$ text "" + + $$ (if (not $ isNullUFM $ raCoalesced s) + then text "# Registers coalesced." + $$ (vcat $ map ppr $ ufmToList $ raCoalesced s) + $$ text "" + else empty) + $$ text "# Native code after register allocation." - $$ ppr (raPatchedCmm s) + $$ ppr (raPatched s) $$ text "" - $$ text "# Final code, after rewriting spill/rewrite pseudo instrs." - $$ ppr (raFinalCmm s) + + $$ 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 @@ -100,31 +138,16 @@ 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 + = let + finals = [ s | s@RegAllocStatsColored{} <- stats] - -- 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 + -- 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)" - $$ (ppr spillTotal) - $$ text "" - $$ text "-- spills-added" - $$ text "-- (reg_name, stores, loads)" - $$ (vcat $ map pprSpillSL $ spillList) + $$ text "-- (stores, loads, reg_reg_moves_remaining)" + $$ ppr total $$ text "") @@ -149,7 +172,7 @@ binLifetimeCount fm $ eltsUFM fm in addListToUFM_C - (\(l1, c1) (l2, c2) -> (l1, c1 + c2)) + (\(l1, c1) (_, c2) -> (l1, c1 + c2)) emptyUFM lifes @@ -159,7 +182,7 @@ pprStatsConflict :: [RegAllocStats] -> SDoc pprStatsConflict stats - = let confMap = foldl' (plusUFM_C (\(c1, n1) (c2, n2) -> (c1, n1 + n2))) + = let confMap = foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2))) emptyUFM $ map Color.slurpNodeConflictCount [ raGraph s | s@RegAllocStatsStart{} <- stats ] @@ -199,6 +222,37 @@ pprStatsLifeConflict stats graph $$ 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 _) + | SPILL _ _ <- instr + = do modify $ \(s, r, m) -> (s + 1, r, m) + return li + + | RELOAD _ _ <- 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.