1 module RegAlloc.Linear.Stats (
9 import RegAlloc.Linear.Base
13 import Cmm (GenBasicBlock(..))
21 -- | Build a map of how many times each reg was alloced, clobbered, loaded etc.
23 :: [SpillReason] -> UniqFM [Int]
25 binSpillReasons reasons
29 (map (\reason -> case reason of
30 SpillAlloc r -> (r, [1, 0, 0, 0, 0])
31 SpillClobber r -> (r, [0, 1, 0, 0, 0])
32 SpillLoad r -> (r, [0, 0, 1, 0, 0])
33 SpillJoinRR r -> (r, [0, 0, 0, 1, 0])
34 SpillJoinRM r -> (r, [0, 0, 0, 0, 1])) reasons)
37 -- | Count reg-reg moves remaining in this code.
38 countRegRegMovesNat :: NatCmmTop -> Int
39 countRegRegMovesNat cmm
40 = execState (mapGenBlockTopM countBlock cmm) 0
42 countBlock b@(BasicBlock _ instrs)
43 = do mapM_ countInstr instrs
47 | Just _ <- isRegRegMove instr
55 -- | Pretty print some RegAllocStats
56 pprStats :: [NatCmmTop] -> [RegAllocStats] -> SDoc
58 = let -- sum up all the instrs inserted by the spiller
59 spills = foldl' (plusUFM_C (zipWith (+)))
61 $ map ra_spillInstrs statss
63 spillTotals = foldl' (zipWith (+))
67 -- count how many reg-reg-moves remain in the code
68 moves = sum $ map countRegRegMovesNat code
70 pprSpill (reg, spills)
71 = parens $ (hcat $ punctuate (text ", ") (doubleQuotes (ppr reg) : map ppr spills))
73 in ( text "-- spills-added-total"
74 $$ text "-- (allocs, clobbers, loads, joinRR, joinRM, reg_reg_moves_remaining)"
75 $$ (parens $ (hcat $ punctuate (text ", ") (map ppr spillTotals ++ [ppr moves])))
77 $$ text "-- spills-added"
78 $$ text "-- (reg_name, allocs, clobbers, loads, joinRR, joinRM)"
79 $$ (vcat $ map pprSpill