module RegAlloc.Graph.Stats (
RegAllocStats (..),
pprStats,
pprStatsSpills,
pprStatsLifetimes,
pprStatsConflict,
pprStatsLifeConflict,
countSRMs, addSRM
)
where
#include "nativeGen/NCG.h"
import qualified GraphColor as Color
import RegAlloc.Liveness
import RegAlloc.Graph.Spill
import RegAlloc.Graph.SpillCost
import RegAlloc.Graph.TrivColorable
import Instruction
import RegClass
import Reg
import TargetReg
import Cmm
import Outputable
import UniqFM
import UniqSet
import State
import Data.List
data RegAllocStats instr
= RegAllocStatsStart
{ raLiveCmm :: [LiveCmmTop instr]
, raGraph :: Color.Graph VirtualReg RegClass RealReg
, raSpillCosts :: SpillCostInfo }
| RegAllocStatsSpill
{ raCode :: [LiveCmmTop instr]
, raGraph :: Color.Graph VirtualReg RegClass RealReg
, raCoalesced :: UniqFM VirtualReg
, raSpillStats :: SpillStats
, raSpillCosts :: SpillCostInfo
, raSpilled :: [LiveCmmTop instr] }
| RegAllocStatsColored
{ raCode :: [LiveCmmTop instr]
, raGraph :: Color.Graph VirtualReg RegClass RealReg
, raGraphColored :: Color.Graph VirtualReg RegClass RealReg
, raCoalesced :: UniqFM VirtualReg
, raCodeCoalesced :: [LiveCmmTop instr]
, raPatched :: [LiveCmmTop instr]
, raSpillClean :: [LiveCmmTop instr]
, raFinal :: [NatCmmTop instr]
, raSRMs :: (Int, Int, Int) }
instance Outputable instr => Outputable (RegAllocStats instr) where
ppr (s@RegAllocStatsStart{})
= text "# Start"
$$ text "# Native code with liveness information."
$$ ppr (raLiveCmm s)
$$ text ""
$$ text "# Initial register conflict graph."
$$ Color.dotGraph
targetRegDotColor
(trivColorable
targetVirtualRegSqueeze
targetRealRegSqueeze)
(raGraph s)
ppr (s@RegAllocStatsSpill{})
= text "# Spill"
$$ text "# Code with liveness information."
$$ (ppr (raCode 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 { raSRMs = (spills, reloads, moves) })
= text "# Colored"
$$ text "# Code with liveness information."
$$ (ppr (raCode s))
$$ text ""
$$ text "# Register conflict graph (colored)."
$$ Color.dotGraph
targetRegDotColor
(trivColorable
targetVirtualRegSqueeze
targetRealRegSqueeze)
(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 coalescings applied."
$$ ppr (raCodeCoalesced s)
$$ text ""
$$ 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 ""
pprStats
:: [RegAllocStats instr]
-> Color.Graph VirtualReg RegClass RealReg
-> SDoc
pprStats stats graph
= let outSpills = pprStatsSpills stats
outLife = pprStatsLifetimes stats
outConflict = pprStatsConflict stats
outScatter = pprStatsLifeConflict stats graph
in vcat [outSpills, outLife, outConflict, outScatter]
pprStatsSpills
:: [RegAllocStats instr] -> SDoc
pprStatsSpills stats
= let
finals = [ s | s@RegAllocStatsColored{} <- stats]
total = foldl' addSRM (0, 0, 0)
$ map raSRMs finals
in ( text "-- spills-added-total"
$$ text "-- (stores, loads, reg_reg_moves_remaining)"
$$ ppr total
$$ text "")
pprStatsLifetimes
:: [RegAllocStats instr] -> SDoc
pprStatsLifetimes stats
= 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)"
$$ (vcat $ map ppr $ eltsUFM lifeBins)
$$ text "\n")
binLifetimeCount :: UniqFM (VirtualReg, Int) -> UniqFM (Int, Int)
binLifetimeCount fm
= let lifes = map (\l -> (l, (l, 1)))
$ map snd
$ eltsUFM fm
in addListToUFM_C
(\(l1, c1) (_, c2) -> (l1, c1 + c2))
emptyUFM
lifes
pprStatsConflict
:: [RegAllocStats instr] -> SDoc
pprStatsConflict stats
= let confMap = foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
emptyUFM
$ map Color.slurpNodeConflictCount
[ raGraph s | s@RegAllocStatsStart{} <- stats ]
in ( text "-- vreg-conflicts"
$$ text "-- (conflict_count, number_of_vregs_that_had_that_many_conflicts)"
$$ (vcat $ map ppr $ eltsUFM confMap)
$$ text "\n")
pprStatsLifeConflict
:: [RegAllocStats instr]
-> Color.Graph VirtualReg RegClass RealReg
-> SDoc
pprStatsLifeConflict stats graph
= let lifeMap = lifeMapFromSpillCostInfo
$ foldl' plusSpillCostInfo zeroSpillCostInfo
$ [ raSpillCosts s | s@RegAllocStatsStart{} <- stats ]
scatter = map (\r -> let lifetime = case lookupUFM lifeMap r of
Just (_, l) -> l
Nothing -> 0
Just node = Color.lookupNode graph r
in parens $ hcat $ punctuate (text ", ")
[ doubleQuotes $ ppr $ Color.nodeId node
, ppr $ sizeUniqSet (Color.nodeConflicts node)
, ppr $ lifetime ])
$ map Color.nodeId
$ eltsUFM
$ Color.graphMap graph
in ( text "-- vreg-conflict-lifetime"
$$ text "-- (vreg, vreg_conflicts, vreg_lifetime)"
$$ (vcat scatter)
$$ text "\n")
countSRMs
:: Instruction instr
=> LiveCmmTop instr -> (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
| LiveInstr SPILL{} _ <- li
= do modify $ \(s, r, m) -> (s + 1, r, m)
return li
| LiveInstr RELOAD{} _ <- li
= do modify $ \(s, r, m) -> (s, r + 1, m)
return li
| LiveInstr instr _ <- li
, Just _ <- takeRegRegMoveInstr instr
= do modify $ \(s, r, m) -> (s, r, m + 1)
return li
| otherwise
= return li
addSRM (s1, r1, m1) (s2, r2, m2)
= (s1+s2, r1+r2, m1+m2)