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 Instruction
import RegClass
import Reg
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
{ raGraph :: Color.Graph VirtualReg RegClass RealReg
, raCoalesced :: UniqFM VirtualReg
, raSpillStats :: SpillStats
, raSpillCosts :: SpillCostInfo
, raSpilled :: [LiveCmmTop instr] }
| RegAllocStatsColored
{ raGraph :: Color.Graph VirtualReg RegClass RealReg
, raGraphColored :: Color.Graph VirtualReg RegClass RealReg
, raCoalesced :: UniqFM VirtualReg
, 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 ""
ppr (s@RegAllocStatsSpill{})
= text "# Spill"
$$ (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"
$$ (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 ""
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
| SPILL _ _ <- li
= do modify $ \(s, r, m) -> (s + 1, r, m)
return li
| RELOAD _ _ <- li
= do modify $ \(s, r, m) -> (s, r + 1, m)
return li
| Instr 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)