X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocStats.hs;h=81578a33312701053b2bda0391562fd8d0f42f36;hb=220a12e946b80166d3fe20419091135cef01f668;hp=7e08c1cdf63537a62ad51a65980659411894d9c6;hpb=682d5e9674ec8cf94b3af815a752fa03c9a9d6fe;p=ghc-hetmet.git diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs index 7e08c1c..81578a3 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,17 @@ where import qualified GraphColor as Color import RegLiveness +import RegAllocInfo import RegSpill +import RegSpillCost import MachRegs import MachInstrs +import Cmm import Outputable import UniqFM import UniqSet +import State import Data.List @@ -34,22 +41,25 @@ 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 + , raGraph :: Color.Graph Reg RegClass Reg -- ^ the initial, uncolored graph + , raSpillCosts :: SpillCostInfo } -- ^ information to help choose which regs to spill -- 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 + , raSpillCosts :: SpillCostInfo -- ^ number of instrs each reg lives for , raSpilled :: [LiveCmmTop] } -- ^ code with spill instructions added -- a successful coloring | RegAllocStatsColored { raGraph :: Color.Graph Reg RegClass Reg -- ^ the colored graph + , 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 + , raFinal :: [NatCmmTop] -- ^ final code + , raSRMs :: (Int, Int, Int) } -- ^ spill/reload/reg-reg moves present in this code instance Outputable RegAllocStats where @@ -61,32 +71,61 @@ 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 "# Spill costs. reg uses defs lifetime degree cost" + $$ vcat (map (pprSpillCostRecord (raGraph s)) $ eltsUFM $ raSpillCosts s) + $$ text "" + $$ 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 (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 @@ -104,31 +143,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 "") @@ -137,9 +161,11 @@ pprStatsLifetimes :: [RegAllocStats] -> SDoc pprStatsLifetimes stats - = let lifeMap = foldl' plusUFM emptyUFM - [ raLifetimes s | s@RegAllocStatsStart{} <- stats ] - lifeBins = binLifetimeCount lifeMap + = let info = foldl' plusSpillCostInfo zeroSpillCostInfo + [ raSpillCosts s + | s@RegAllocStatsStart{} <- stats ] + + lifeBins = binLifetimeCount $ lifeMapFromSpillCostInfo info in ( text "-- vreg-population-lifetimes" $$ text "-- (instruction_count, number_of_vregs_that_lived_that_long)" @@ -153,7 +179,7 @@ binLifetimeCount fm $ eltsUFM fm in addListToUFM_C - (\(l1, c1) (l2, c2) -> (l1, c1 + c2)) + (\(l1, c1) (_, c2) -> (l1, c1 + c2)) emptyUFM lifes @@ -163,7 +189,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 ] @@ -182,8 +208,9 @@ pprStatsLifeConflict -> SDoc pprStatsLifeConflict stats graph - = let lifeMap = foldl' plusUFM emptyUFM - [ raLifetimes s | s@RegAllocStatsStart{} <- stats ] + = let lifeMap = lifeMapFromSpillCostInfo + $ foldl' plusSpillCostInfo zeroSpillCostInfo + $ [ raSpillCosts s | s@RegAllocStatsStart{} <- stats ] scatter = map (\r -> let lifetime = case lookupUFM lifeMap r of Just (_, l) -> l @@ -203,6 +230,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.