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.Strict
import GHC.Platform (Platform)
binSpillReasons
:: [SpillReason] -> UniqFM Unique [Int]
binSpillReasons :: [SpillReason] -> UniqFM Unique [Int]
binSpillReasons [SpillReason]
reasons
= ([Int] -> [Int] -> [Int])
-> UniqFM Unique [Int] -> [(Unique, [Int])] -> UniqFM Unique [Int]
forall key elt.
Uniquable key =>
(elt -> elt -> elt)
-> UniqFM key elt -> [(key, elt)] -> UniqFM key elt
addListToUFM_C
((Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+))
UniqFM Unique [Int]
forall {k} (key :: k) elt. UniqFM key elt
emptyUFM
((SpillReason -> (Unique, [Int]))
-> [SpillReason] -> [(Unique, [Int])]
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)
countRegRegMovesNat
:: Instruction instr
=> Platform
-> NatCmmDecl statics instr -> Int
countRegRegMovesNat :: forall instr statics.
Instruction instr =>
Platform -> NatCmmDecl statics instr -> Int
countRegRegMovesNat Platform
platform NatCmmDecl statics instr
cmm
= State Int (NatCmmDecl statics instr) -> Int -> Int
forall s a. State s a -> s -> s
execState ((GenBasicBlock instr -> State Int (GenBasicBlock instr))
-> NatCmmDecl statics instr -> State Int (NatCmmDecl statics instr)
forall (m :: * -> *) i d h.
Monad m =>
(GenBasicBlock i -> m (GenBasicBlock i))
-> GenCmmDecl d h (ListGraph i) -> m (GenCmmDecl d h (ListGraph i))
mapGenBlockTopM GenBasicBlock instr -> State Int (GenBasicBlock instr)
countBlock NatCmmDecl statics instr
cmm) Int
0
where
countBlock :: GenBasicBlock instr -> State Int (GenBasicBlock instr)
countBlock b :: GenBasicBlock instr
b@(BasicBlock BlockId
_ [instr]
instrs)
= do (instr -> State Int instr) -> [instr] -> State Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ instr -> State Int instr
countInstr [instr]
instrs
GenBasicBlock instr -> State Int (GenBasicBlock instr)
forall a. a -> State Int a
forall (m :: * -> *) a. Monad m => a -> m a
return GenBasicBlock instr
b
countInstr :: instr -> State Int instr
countInstr instr
instr
| Just (Reg, Reg)
_ <- Platform -> instr -> Maybe (Reg, Reg)
forall instr.
Instruction instr =>
Platform -> instr -> Maybe (Reg, Reg)
takeRegRegMoveInstr Platform
platform instr
instr
= do (Int -> Int) -> State Int ()
forall s. (s -> s) -> State s ()
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
instr -> State Int instr
forall a. a -> State Int a
forall (m :: * -> *) a. Monad m => a -> m a
return instr
instr
| Bool
otherwise
= instr -> State Int instr
forall a. a -> State Int a
forall (m :: * -> *) a. Monad m => a -> m a
return instr
instr
pprStats
:: Instruction instr
=> Platform -> [NatCmmDecl statics instr] -> [RegAllocStats] -> SDoc
pprStats :: forall instr statics.
Instruction instr =>
Platform -> [NatCmmDecl statics instr] -> [RegAllocStats] -> SDoc
pprStats Platform
platform [NatCmmDecl statics instr]
code [RegAllocStats]
statss
= let
spills :: UniqFM Unique [Int]
spills :: UniqFM Unique [Int]
spills = (UniqFM Unique [Int] -> UniqFM Unique [Int] -> UniqFM Unique [Int])
-> UniqFM Unique [Int]
-> [UniqFM Unique [Int]]
-> UniqFM Unique [Int]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (([Int] -> [Int] -> [Int])
-> UniqFM Unique [Int]
-> UniqFM Unique [Int]
-> UniqFM Unique [Int]
forall {k} elt (key :: k).
(elt -> elt -> elt)
-> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
plusUFM_C ((Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)))
UniqFM Unique [Int]
forall {k} (key :: k) elt. UniqFM key elt
emptyUFM
([UniqFM Unique [Int]] -> UniqFM Unique [Int])
-> [UniqFM Unique [Int]] -> UniqFM Unique [Int]
forall a b. (a -> b) -> a -> b
$ (RegAllocStats -> UniqFM Unique [Int])
-> [RegAllocStats] -> [UniqFM Unique [Int]]
forall a b. (a -> b) -> [a] -> [b]
map RegAllocStats -> UniqFM Unique [Int]
ra_spillInstrs [RegAllocStats]
statss
spillTotals :: [Int]
spillTotals = ([Int] -> [Int] -> [Int]) -> [Int] -> [[Int]] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+))
[Int
0, Int
0, Int
0, Int
0, Int
0]
([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
$ UniqFM Unique [Int] -> [[Int]]
forall {k} (key :: k) elt. UniqFM key elt -> [elt]
nonDetEltsUFM UniqFM Unique [Int]
spills
moves :: Int
moves = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (NatCmmDecl statics instr -> Int)
-> [NatCmmDecl statics instr] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> NatCmmDecl statics instr -> Int
forall instr statics.
Instruction instr =>
Platform -> NatCmmDecl statics instr -> Int
countRegRegMovesNat Platform
platform) [NatCmmDecl statics instr]
code
pprSpill :: (a, [a]) -> SDoc
pprSpill (a
reg, [a]
spills)
= SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
", ") (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
doubleQuotes (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
reg) SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (a -> SDoc) -> [a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map a -> SDoc
forall a. Outputable a => a -> SDoc
ppr [a]
spills))
in ( String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-- spills-added-total"
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-- (allocs, clobbers, loads, joinRR, joinRM, reg_reg_moves_remaining)"
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
", ") ((Int -> SDoc) -> [Int] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Int]
spillTotals [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
moves])))
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
""
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-- spills-added"
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-- (reg_name, allocs, clobbers, loads, joinRR, joinRM)"
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ (UniqFM Unique [Int] -> ([(Unique, [Int])] -> SDoc) -> SDoc
forall {k} (key :: k) a.
UniqFM key a -> ([(Unique, a)] -> SDoc) -> SDoc
pprUFMWithKeys UniqFM Unique [Int]
spills ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc)
-> ([(Unique, [Int])] -> [SDoc]) -> [(Unique, [Int])] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Unique, [Int]) -> SDoc) -> [(Unique, [Int])] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Unique, [Int]) -> SDoc
forall {a} {a}. (Outputable a, Outputable a) => (a, [a]) -> SDoc
pprSpill))
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"")