-
+{-# OPTIONS -fno-warn-missing-signatures #-}
-- Carries interesting info for debugging / profiling of the
-- graph coloring register allocator.
-
-{-# OPTIONS_GHC -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
--- for details
+--
module RegAllocStats (
RegAllocStats (..),
import RegLiveness
import RegAllocInfo
import RegSpill
+import RegSpillCost
import MachRegs
import MachInstrs
import Cmm
-- 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
+ { 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
$$ 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 { 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 (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 ""
:: [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
= do instrs' <- mapM countSRM_instr instrs
return $ BasicBlock i instrs'
-countSRM_instr li@(Instr instr live)
- | SPILL reg slot <- instr
+countSRM_instr li@(Instr instr _)
+ | SPILL _ _ <- instr
= do modify $ \(s, r, m) -> (s + 1, r, m)
return li
- | RELOAD slot reg <- instr
+ | RELOAD _ _ <- instr
= do modify $ \(s, r, m) -> (s, r + 1, m)
return li
= case regClass reg of
RcInteger -> text "blue"
RcFloat -> text "red"
+ RcDouble -> text "green"
#endif
projects / ghc-hetmet.git / blobdiff