1 module RegAlloc.Linear.Stats (
9 import RegAlloc.Linear.Base
10 import RegAlloc.Liveness
14 import Cmm (GenBasicBlock(..))
22 -- | Build a map of how many times each reg was alloced, clobbered, loaded etc.
24 :: [SpillReason] -> UniqFM [Int]
26 binSpillReasons reasons
30 (map (\reason -> case reason of
31 SpillAlloc r -> (r, [1, 0, 0, 0, 0])
32 SpillClobber r -> (r, [0, 1, 0, 0, 0])
33 SpillLoad r -> (r, [0, 0, 1, 0, 0])
34 SpillJoinRR r -> (r, [0, 0, 0, 1, 0])
35 SpillJoinRM r -> (r, [0, 0, 0, 0, 1])) reasons)
38 -- | Count reg-reg moves remaining in this code.
39 countRegRegMovesNat :: NatCmmTop -> Int
40 countRegRegMovesNat cmm
41 = execState (mapGenBlockTopM countBlock cmm) 0
43 countBlock b@(BasicBlock _ instrs)
44 = do mapM_ countInstr instrs
48 | Just _ <- isRegRegMove instr
56 -- | Pretty print some RegAllocStats
57 pprStats :: [NatCmmTop] -> [RegAllocStats] -> SDoc
59 = let -- sum up all the instrs inserted by the spiller
60 spills = foldl' (plusUFM_C (zipWith (+)))
62 $ map ra_spillInstrs statss
64 spillTotals = foldl' (zipWith (+))
68 -- count how many reg-reg-moves remain in the code
69 moves = sum $ map countRegRegMovesNat code
71 pprSpill (reg, spills)
72 = parens $ (hcat $ punctuate (text ", ") (doubleQuotes (ppr reg) : map ppr spills))
74 in ( text "-- spills-added-total"
75 $$ text "-- (allocs, clobbers, loads, joinRR, joinRM, reg_reg_moves_remaining)"
76 $$ (parens $ (hcat $ punctuate (text ", ") (map ppr spillTotals ++ [ppr moves])))
78 $$ text "-- spills-added"
79 $$ text "-- (reg_name, allocs, clobbers, loads, joinRR, joinRM)"
80 $$ (vcat $ map pprSpill