X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocStats.hs;h=58a69fa76e92ce8c2f3200c95b11084271ecee89;hb=08652e67c4d5d9a40687f93c286021a867c1bca0;hp=798af0265abd335116edcf0f9a33d28557421045;hpb=77b99dc38036e2908101984c8394ac16f6daa4e0;p=ghc-hetmet.git diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs index 798af02..58a69fa 100644 --- a/compiler/nativeGen/RegAllocStats.hs +++ b/compiler/nativeGen/RegAllocStats.hs @@ -1,6 +1,7 @@ - +{-# OPTIONS -fno-warn-missing-signatures #-} -- Carries interesting info for debugging / profiling of the -- graph coloring register allocator. +-- module RegAllocStats ( RegAllocStats (..), @@ -10,7 +11,9 @@ module RegAllocStats ( pprStatsSpills, pprStatsLifetimes, pprStatsConflict, - pprStatsLifeConflict + pprStatsLifeConflict, + + countSRMs, addSRM ) where @@ -19,12 +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 @@ -33,21 +41,26 @@ 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 - , raPatchedCmm :: [LiveCmmTop] } -- ^ code after register allocation - + { raGraph :: Color.Graph Reg RegClass Reg -- ^ the uncolored graph + , raGraphColored :: Color.Graph Reg RegClass Reg -- ^ the coalesced and 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 + , raSRMs :: (Int, Int, Int) } -- ^ spill/reload/reg-reg moves present in this code instance Outputable RegAllocStats where @@ -59,25 +72,65 @@ 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." + + $$ text "# Register conflict graph (initial)." $$ Color.dotGraph regDotColor trivColorable (raGraph s) $$ text "" + + $$ text "# Register conflict graph (colored)." + $$ Color.dotGraph regDotColor trivColorable (raGraphColored 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 "# 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 @@ -95,31 +148,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 "") @@ -128,9 +166,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)" @@ -144,7 +184,7 @@ binLifetimeCount fm $ eltsUFM fm in addListToUFM_C - (\(l1, c1) (l2, c2) -> (l1, c1 + c2)) + (\(l1, c1) (_, c2) -> (l1, c1 + c2)) emptyUFM lifes @@ -154,7 +194,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 ] @@ -173,8 +213,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 @@ -194,6 +235,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. @@ -219,11 +291,10 @@ regColors , (fake3, "#aa00aa") , (fake4, "#ff0055") , (fake5, "#5500ff") ] -#endif -- reg colors for x86_64 -#if x86_64_TARGET_ARCH +#elif x86_64_TARGET_ARCH regDotColor :: Reg -> SDoc regDotColor reg = let Just str = lookupUFM regColors reg @@ -245,16 +316,19 @@ regColors , (r15, "#002080") ] ++ zip (map RealReg [16..31]) (repeat "red") -#endif -- reg colors for ppc -#if powerpc_TARGET_ARCH +#elif powerpc_TARGET_ARCH regDotColor :: Reg -> SDoc regDotColor reg = case regClass reg of RcInteger -> text "blue" RcFloat -> text "red" + RcDouble -> text "green" + +#else +#error ToDo: regDotColor #endif