module GHC.CmmToAsm.Reg.Linear.Stats (
        binSpillReasons,
        countRegRegMovesNat,
        pprStats
)

where

import GHC.Prelude

import GHC.CmmToAsm.Reg.Linear.Base
import GHC.CmmToAsm.Reg.Liveness
import GHC.CmmToAsm.Instr
import GHC.Types.Unique (Unique)
import GHC.CmmToAsm.Types

import GHC.Types.Unique.FM

import GHC.Utils.Outputable
import GHC.Utils.Monad.State

-- | Build a map of how many times each reg was alloced, clobbered, loaded etc.
binSpillReasons
        :: [SpillReason] -> UniqFM Unique [Int]
        -- See Note [UniqFM and the register allocator]
binSpillReasons :: [SpillReason] -> UniqFM Unique [Int]
binSpillReasons [SpillReason]
reasons
        = forall key elt.
Uniquable key =>
(elt -> elt -> elt)
-> UniqFM key elt -> [(key, elt)] -> UniqFM key elt
addListToUFM_C
                (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(+))
                forall key elt. UniqFM key elt
emptyUFM
                (forall a b. (a -> b) -> [a] -> [b]
map (\SpillReason
reason -> case SpillReason
reason of
                        SpillAlloc Unique
r    -> (Unique
r, [Int
1, Int
0, Int
0, Int
0, Int
0])
                        SpillClobber Unique
r  -> (Unique
r, [Int
0, Int
1, Int
0, Int
0, Int
0])
                        SpillLoad Unique
r     -> (Unique
r, [Int
0, Int
0, Int
1, Int
0, Int
0])
                        SpillJoinRR Unique
r   -> (Unique
r, [Int
0, Int
0, Int
0, Int
1, Int
0])
                        SpillJoinRM Unique
r   -> (Unique
r, [Int
0, Int
0, Int
0, Int
0, Int
1])) [SpillReason]
reasons)


-- | Count reg-reg moves remaining in this code.
countRegRegMovesNat
        :: Instruction instr
        => NatCmmDecl statics instr -> Int

countRegRegMovesNat :: forall instr statics.
Instruction instr =>
NatCmmDecl statics instr -> Int
countRegRegMovesNat NatCmmDecl statics instr
cmm
        = forall s a. State s a -> s -> s
execState (forall (m :: * -> *) i d h.
Monad m =>
(GenBasicBlock i -> m (GenBasicBlock i))
-> GenCmmDecl d h (ListGraph i) -> m (GenCmmDecl d h (ListGraph i))
mapGenBlockTopM forall {b} {s}.
(Instruction b, Num s) =>
GenBasicBlock b -> State s (GenBasicBlock b)
countBlock NatCmmDecl statics instr
cmm) Int
0
 where
        countBlock :: GenBasicBlock b -> State s (GenBasicBlock b)
countBlock b :: GenBasicBlock b
b@(BasicBlock BlockId
_ [b]
instrs)
         = do   forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {b} {s}. (Instruction b, Num s) => b -> State s b
countInstr [b]
instrs
                forall (m :: * -> *) a. Monad m => a -> m a
return  GenBasicBlock b
b

        countInstr :: b -> State s b
countInstr b
instr
                | Just (Reg, Reg)
_        <- forall instr. Instruction instr => instr -> Maybe (Reg, Reg)
takeRegRegMoveInstr b
instr
                = do    forall s. (s -> s) -> State s ()
modify (forall a. Num a => a -> a -> a
+ s
1)
                        forall (m :: * -> *) a. Monad m => a -> m a
return b
instr

                | Bool
otherwise
                =       forall (m :: * -> *) a. Monad m => a -> m a
return b
instr


-- | Pretty print some RegAllocStats
pprStats
        :: Instruction instr
        => [NatCmmDecl statics instr] -> [RegAllocStats] -> SDoc

pprStats :: forall instr statics.
Instruction instr =>
[NatCmmDecl statics instr] -> [RegAllocStats] -> SDoc
pprStats [NatCmmDecl statics instr]
code [RegAllocStats]
statss
 = let  -- sum up all the instrs inserted by the spiller
        -- See Note [UniqFM and the register allocator]
        spills :: UniqFM Unique [Int]
        spills :: UniqFM Unique [Int]
spills          = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall elt key.
(elt -> elt -> elt)
-> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
plusUFM_C (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(+)))
                                forall key elt. UniqFM key elt
emptyUFM
                        forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map RegAllocStats -> UniqFM Unique [Int]
ra_spillInstrs [RegAllocStats]
statss

        spillTotals :: [Int]
spillTotals     = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(+))
                                [Int
0, Int
0, Int
0, Int
0, Int
0]
                        forall a b. (a -> b) -> a -> b
$ forall key elt. UniqFM key elt -> [elt]
nonDetEltsUFM UniqFM Unique [Int]
spills
                        -- See Note [Unique Determinism and code generation]

        -- count how many reg-reg-moves remain in the code
        moves :: Int
moves           = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall instr statics.
Instruction instr =>
NatCmmDecl statics instr -> Int
countRegRegMovesNat [NatCmmDecl statics instr]
code

        pprSpill :: (a, [a]) -> SDoc
pprSpill (a
reg, [a]
spills)
                = SDoc -> SDoc
parens forall a b. (a -> b) -> a -> b
$ ([SDoc] -> SDoc
hcat forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
punctuate (String -> SDoc
text String
", ")  (SDoc -> SDoc
doubleQuotes (forall a. Outputable a => a -> SDoc
ppr a
reg) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [a]
spills))

   in   (  String -> SDoc
text String
"-- spills-added-total"
        SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"--    (allocs, clobbers, loads, joinRR, joinRM, reg_reg_moves_remaining)"
        SDoc -> SDoc -> SDoc
$$ (SDoc -> SDoc
parens forall a b. (a -> b) -> a -> b
$ ([SDoc] -> SDoc
hcat forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
punctuate (String -> SDoc
text String
", ") (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [Int]
spillTotals forall a. [a] -> [a] -> [a]
++ [forall a. Outputable a => a -> SDoc
ppr Int
moves])))
        SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
""
        SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"-- spills-added"
        SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"--    (reg_name, allocs, clobbers, loads, joinRR, joinRM)"
        SDoc -> SDoc -> SDoc
$$ (forall key a. UniqFM key a -> ([(Unique, a)] -> SDoc) -> SDoc
pprUFMWithKeys UniqFM Unique [Int]
spills ([SDoc] -> SDoc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. (Outputable a, Outputable a) => (a, [a]) -> SDoc
pprSpill))
        SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
"")