1 files changed, 87 insertions, 0 deletions
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs b/compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs
new file mode 100644
index 0000000000..1176b220a3
--- /dev/null
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs
@@ -0,0 +1,87 @@
+module GHC.CmmToAsm.Reg.Linear.Stats (
+        binSpillReasons,
+        countRegRegMovesNat,
+        pprStats
+)
+
+where
+
+import GhcPrelude
+
+import GHC.CmmToAsm.Reg.Linear.Base
+import GHC.CmmToAsm.Reg.Liveness
+import GHC.CmmToAsm.Instr
+
+import UniqFM
+import Outputable
+
+import State
+
+-- | Build a map of how many times each reg was alloced, clobbered, loaded etc.
+binSpillReasons
+        :: [SpillReason] -> UniqFM [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)
+
+
+-- | Count reg-reg moves remaining in this code.
+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
+
+
+-- | Pretty print some RegAllocStats
+pprStats
+        :: Instruction instr
+        => [NatCmmDecl statics instr] -> [RegAllocStats] -> SDoc
+
+pprStats code statss
+ = let  -- sum up all the instrs inserted by the spiller
+        spills          = foldl' (plusUFM_C (zipWith (+)))
+                                emptyUFM
+                        $ map ra_spillInstrs statss
+
+        spillTotals     = foldl' (zipWith (+))
+                                [0, 0, 0, 0, 0]
+                        $ nonDetEltsUFM spills
+                        -- See Note [Unique Determinism and code generation]
+
+        -- count how many reg-reg-moves remain in the code
+        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 "")
+