1 module RegAlloc.Linear.Stats (
9 import RegAlloc.Linear.Base
10 import RegAlloc.Liveness
13 import OldCmm (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.
40 => NatCmmTop instr -> Int
42 countRegRegMovesNat cmm
43 = execState (mapGenBlockTopM countBlock cmm) 0
45 countBlock b@(BasicBlock _ instrs)
46 = do mapM_ countInstr instrs
50 | Just _ <- takeRegRegMoveInstr instr
58 -- | Pretty print some RegAllocStats
61 => [NatCmmTop instr] -> [RegAllocStats] -> SDoc
64 = let -- sum up all the instrs inserted by the spiller
65 spills = foldl' (plusUFM_C (zipWith (+)))
67 $ map ra_spillInstrs statss
69 spillTotals = foldl' (zipWith (+))
73 -- count how many reg-reg-moves remain in the code
74 moves = sum $ map countRegRegMovesNat code
76 pprSpill (reg, spills)
77 = parens $ (hcat $ punctuate (text ", ") (doubleQuotes (ppr reg) : map ppr spills))
79 in ( text "-- spills-added-total"
80 $$ text "-- (allocs, clobbers, loads, joinRR, joinRM, reg_reg_moves_remaining)"
81 $$ (parens $ (hcat $ punctuate (text ", ") (map ppr spillTotals ++ [ppr moves])))
83 $$ text "-- spills-added"
84 $$ text "-- (reg_name, allocs, clobbers, loads, joinRR, joinRM)"
85 $$ (vcat $ map pprSpill