-
+{-# OPTIONS -fno-warn-missing-signatures #-}
-- Carries interesting info for debugging / profiling of the
-- graph coloring register allocator.
+--
module RegAllocStats (
RegAllocStats (..),
pprStatsSpills,
pprStatsLifetimes,
pprStatsConflict,
- pprStatsLifeConflict
+ pprStatsLifeConflict,
+
+ countSRMs, addSRM
)
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
-- 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
- , raFinalCmm :: [NatCmmTop] } -- ^ final code
+ { 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
$$ 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 "# 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
:: [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]))
+ = let
+ finals = [ s | s@RegAllocStatsColored{} <- stats]
- -- 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 "")
:: [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)"
$ eltsUFM fm
in addListToUFM_C
- (\(l1, c1) (l2, c2) -> (l1, c1 + c2))
+ (\(l1, c1) (_, c2) -> (l1, c1 + c2))
emptyUFM
lifes
:: [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 ]
-> 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
$$ 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.
, (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
, (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