Stats.hs 2.68 KB
Newer Older
Sylvain Henry's avatar
Sylvain Henry committed
1
module GHC.CmmToAsm.Reg.Linear.Stats (
benl's avatar
benl committed
2 3 4
        binSpillReasons,
        countRegRegMovesNat,
        pprStats
5 6 7 8
)

where

9 10
import GhcPrelude

Sylvain Henry's avatar
Sylvain Henry committed
11 12 13
import GHC.CmmToAsm.Reg.Linear.Base
import GHC.CmmToAsm.Reg.Liveness
import GHC.CmmToAsm.Instr
14

15 16 17 18 19 20 21
import UniqFM
import Outputable

import State

-- | Build a map of how many times each reg was alloced, clobbered, loaded etc.
binSpillReasons
benl's avatar
benl committed
22
        :: [SpillReason] -> UniqFM [Int]
23 24

binSpillReasons reasons
benl's avatar
benl committed
25 26 27 28 29 30 31 32 33
        = 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)
34 35 36


-- | Count reg-reg moves remaining in this code.
37
countRegRegMovesNat
benl's avatar
benl committed
38 39
        :: Instruction instr
        => NatCmmDecl statics instr -> Int
40

41
countRegRegMovesNat cmm
benl's avatar
benl committed
42
        = execState (mapGenBlockTopM countBlock cmm) 0
43
 where
benl's avatar
benl committed
44 45 46
        countBlock b@(BasicBlock _ instrs)
         = do   mapM_ countInstr instrs
                return  b
47

benl's avatar
benl committed
48 49 50 51
        countInstr instr
                | Just _        <- takeRegRegMoveInstr instr
                = do    modify (+ 1)
                        return instr
52

benl's avatar
benl committed
53 54
                | otherwise
                =       return instr
55 56 57


-- | Pretty print some RegAllocStats
58 59
pprStats
        :: Instruction instr
benl's avatar
benl committed
60
        => [NatCmmDecl statics instr] -> [RegAllocStats] -> SDoc
61

62
pprStats code statss
benl's avatar
benl committed
63 64 65 66 67 68 69
 = 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]
70 71
                        $ nonDetEltsUFM spills
                        -- See Note [Unique Determinism and code generation]
benl's avatar
benl committed
72 73 74 75 76 77 78 79 80 81 82 83 84

        -- 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)"
niteria's avatar
niteria committed
85
        $$ (pprUFMWithKeys spills (vcat . map pprSpill))
benl's avatar
benl committed
86
        $$ text "")
87