module GHC.CmmToAsm.Reg.Linear.Stats (
binSpillReasons,
countRegRegMovesNat,
pprStats
)
where
import GHC.Prelude
import GHC.CmmToAsm.Reg.Linear.Base
import GHC.CmmToAsm.Reg.Liveness
import GHC.CmmToAsm.Instr
import GHC.Types.Unique (Unique)
import GHC.Types.Unique.FM
import GHC.Utils.Outputable
import GHC.Utils.Monad.State
binSpillReasons
:: [SpillReason] -> UniqFM Unique [Int]
binSpillReasons reasons
= addListToUFM_C
(zipWith (+))
emptyUFM
(map (\reason -> case reason of
SpillAlloc r -> (r, [1, 0, 0, 0, 0])
SpillClobber r -> (r, [0, 1, 0, 0, 0])
SpillLoad r -> (r, [0, 0, 1, 0, 0])
SpillJoinRR r -> (r, [0, 0, 0, 1, 0])
SpillJoinRM r -> (r, [0, 0, 0, 0, 1])) reasons)
countRegRegMovesNat
:: Instruction instr
=> NatCmmDecl statics instr -> Int
countRegRegMovesNat cmm
= execState (mapGenBlockTopM countBlock cmm) 0
where
countBlock b@(BasicBlock _ instrs)
= do mapM_ countInstr instrs
return b
countInstr instr
| Just _ <- takeRegRegMoveInstr instr
= do modify (+ 1)
return instr
| otherwise
= return instr
pprStats
:: Instruction instr
=> [NatCmmDecl statics instr] -> [RegAllocStats] -> SDoc
pprStats code statss
= let
spills :: UniqFM Unique [Int]
spills = foldl' (plusUFM_C (zipWith (+)))
emptyUFM
$ map ra_spillInstrs statss
spillTotals = foldl' (zipWith (+))
[0, 0, 0, 0, 0]
$ nonDetEltsUFM spills
moves = sum $ map countRegRegMovesNat code
pprSpill (reg, spills)
= parens $ (hcat $ punctuate (text ", ") (doubleQuotes (ppr reg) : map ppr spills))
in ( text "-- spills-added-total"
$$ text "-- (allocs, clobbers, loads, joinRR, joinRM, reg_reg_moves_remaining)"
$$ (parens $ (hcat $ punctuate (text ", ") (map ppr spillTotals ++ [ppr moves])))
$$ text ""
$$ text "-- spills-added"
$$ text "-- (reg_name, allocs, clobbers, loads, joinRR, joinRM)"
$$ (pprUFMWithKeys spills (vcat . map pprSpill))
$$ text "")