{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
module GHC.Cmm.Liveness
( CmmLocalLive
, cmmLocalLiveness
, cmmLocalLivenessL
, cmmGlobalLiveness
, liveLattice
, liveLatticeL
, gen_kill
, gen_killL
)
where
import GHC.Prelude
import GHC.Platform
import GHC.Cmm.BlockId
import GHC.Cmm
import GHC.Cmm.Ppr.Expr ()
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.LRegSet
import GHC.Data.Maybe
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Types.Unique
type CmmLive r = RegSet r
type CmmLocalLive = CmmLive LocalReg
liveLattice :: Ord r => DataflowLattice (CmmLive r)
{-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive LocalReg) #-}
{-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive GlobalReg) #-}
liveLattice :: forall r. Ord r => DataflowLattice (CmmLive r)
liveLattice = forall a. a -> JoinFun a -> DataflowLattice a
DataflowLattice forall r. RegSet r
emptyRegSet forall {r}.
Ord r =>
OldFact (RegSet r) -> NewFact (RegSet r) -> JoinedFact (RegSet r)
add
where
add :: OldFact (RegSet r) -> NewFact (RegSet r) -> JoinedFact (RegSet r)
add (OldFact RegSet r
old) (NewFact RegSet r
new) =
let !join :: RegSet r
join = forall r. Ord r => RegSet r -> RegSet r -> RegSet r
plusRegSet RegSet r
old RegSet r
new
in forall a. Bool -> a -> JoinedFact a
changedIf (forall r. RegSet r -> Int
sizeRegSet RegSet r
join forall a. Ord a => a -> a -> Bool
> forall r. RegSet r -> Int
sizeRegSet RegSet r
old) RegSet r
join
type BlockEntryLiveness r = LabelMap (CmmLive r)
cmmLocalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness LocalReg
cmmLocalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness LocalReg
cmmLocalLiveness Platform
platform CmmGraph
graph =
BlockEntryLiveness LocalReg -> BlockEntryLiveness LocalReg
check forall a b. (a -> b) -> a -> b
$ forall f.
DataflowLattice f
-> TransferFun f -> CmmGraph -> FactBase f -> FactBase f
analyzeCmmBwd forall r. Ord r => DataflowLattice (CmmLive r)
liveLattice (forall r.
(UserOfRegs r (CmmNode O O), DefinerOfRegs r (CmmNode O O),
UserOfRegs r (CmmNode O C), DefinerOfRegs r (CmmNode O C)) =>
Platform -> TransferFun (CmmLive r)
xferLive Platform
platform) CmmGraph
graph forall (map :: * -> *) a. IsMap map => map a
mapEmpty
where
entry :: BlockId
entry = forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry CmmGraph
graph
check :: BlockEntryLiveness LocalReg -> BlockEntryLiveness LocalReg
check BlockEntryLiveness LocalReg
facts =
forall a. BlockId -> CmmLive LocalReg -> a -> a
noLiveOnEntry BlockId
entry (forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"check" forall a b. (a -> b) -> a -> b
$ forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup BlockId
entry BlockEntryLiveness LocalReg
facts) BlockEntryLiveness LocalReg
facts
cmmGlobalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness GlobalReg
cmmGlobalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness GlobalReg
cmmGlobalLiveness Platform
platform CmmGraph
graph =
forall f.
DataflowLattice f
-> TransferFun f -> CmmGraph -> FactBase f -> FactBase f
analyzeCmmBwd forall r. Ord r => DataflowLattice (CmmLive r)
liveLattice (forall r.
(UserOfRegs r (CmmNode O O), DefinerOfRegs r (CmmNode O O),
UserOfRegs r (CmmNode O C), DefinerOfRegs r (CmmNode O C)) =>
Platform -> TransferFun (CmmLive r)
xferLive Platform
platform) CmmGraph
graph forall (map :: * -> *) a. IsMap map => map a
mapEmpty
noLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a
noLiveOnEntry :: forall a. BlockId -> CmmLive LocalReg -> a -> a
noLiveOnEntry BlockId
bid CmmLive LocalReg
in_fact a
x =
if forall r. RegSet r -> Bool
nullRegSet CmmLive LocalReg
in_fact then a
x
else forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"LocalReg's live-in to graph" (forall a. Outputable a => a -> SDoc
ppr BlockId
bid SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr CmmLive LocalReg
in_fact)
gen_kill
:: (DefinerOfRegs r n, UserOfRegs r n)
=> Platform -> n -> CmmLive r -> CmmLive r
gen_kill :: forall r n.
(DefinerOfRegs r n, UserOfRegs r n) =>
Platform -> n -> CmmLive r -> CmmLive r
gen_kill Platform
platform n
node CmmLive r
set =
let !afterKill :: CmmLive r
afterKill = forall r a b.
DefinerOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsDefd Platform
platform forall r. Ord r => RegSet r -> r -> RegSet r
deleteFromRegSet CmmLive r
set n
node
in forall r a b.
UserOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsUsed Platform
platform forall r. Ord r => RegSet r -> r -> RegSet r
extendRegSet CmmLive r
afterKill n
node
{-# INLINE gen_kill #-}
xferLive
:: forall r.
( UserOfRegs r (CmmNode O O)
, DefinerOfRegs r (CmmNode O O)
, UserOfRegs r (CmmNode O C)
, DefinerOfRegs r (CmmNode O C)
)
=> Platform -> TransferFun (CmmLive r)
xferLive :: forall r.
(UserOfRegs r (CmmNode O O), DefinerOfRegs r (CmmNode O O),
UserOfRegs r (CmmNode O C), DefinerOfRegs r (CmmNode O C)) =>
Platform -> TransferFun (CmmLive r)
xferLive Platform
platform (BlockCC CmmNode C O
eNode Block CmmNode O O
middle CmmNode O C
xNode) FactBase (CmmLive r)
fBase =
let joined :: CmmLive r
joined = forall r n.
(DefinerOfRegs r n, UserOfRegs r n) =>
Platform -> n -> CmmLive r -> CmmLive r
gen_kill Platform
platform CmmNode O C
xNode forall a b. (a -> b) -> a -> b
$! forall (n :: Extensibility -> Extensibility -> *) f
(e :: Extensibility).
NonLocal n =>
DataflowLattice f -> n e C -> FactBase f -> f
joinOutFacts forall r. Ord r => DataflowLattice (CmmLive r)
liveLattice CmmNode O C
xNode FactBase (CmmLive r)
fBase
!result :: CmmLive r
result = forall f. (CmmNode O O -> f -> f) -> Block CmmNode O O -> f -> f
foldNodesBwdOO (forall r n.
(DefinerOfRegs r n, UserOfRegs r n) =>
Platform -> n -> CmmLive r -> CmmLive r
gen_kill Platform
platform) Block CmmNode O O
middle CmmLive r
joined
in forall (map :: * -> *) a. IsMap map => KeyOf map -> a -> map a
mapSingleton (forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> BlockId
entryLabel CmmNode C O
eNode) CmmLive r
result
{-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive LocalReg) #-}
{-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive GlobalReg) #-}
type BlockEntryLivenessL = LabelMap LRegSet
liveLatticeL :: DataflowLattice LRegSet
liveLatticeL :: DataflowLattice LRegSet
liveLatticeL = forall a. a -> JoinFun a -> DataflowLattice a
DataflowLattice LRegSet
emptyLRegSet OldFact LRegSet -> NewFact LRegSet -> JoinedFact LRegSet
add
where
add :: OldFact LRegSet -> NewFact LRegSet -> JoinedFact LRegSet
add (OldFact LRegSet
old) (NewFact LRegSet
new) =
let !join :: LRegSet
join = LRegSet -> LRegSet -> LRegSet
plusLRegSet LRegSet
old LRegSet
new
in forall a. Bool -> a -> JoinedFact a
changedIf (LRegSet -> Int
sizeLRegSet LRegSet
join forall a. Ord a => a -> a -> Bool
> LRegSet -> Int
sizeLRegSet LRegSet
old) LRegSet
join
cmmLocalLivenessL :: Platform -> CmmGraph -> BlockEntryLivenessL
cmmLocalLivenessL :: Platform -> CmmGraph -> BlockEntryLivenessL
cmmLocalLivenessL Platform
platform CmmGraph
graph =
BlockEntryLivenessL -> BlockEntryLivenessL
check forall a b. (a -> b) -> a -> b
$ forall f.
DataflowLattice f
-> TransferFun f -> CmmGraph -> FactBase f -> FactBase f
analyzeCmmBwd DataflowLattice LRegSet
liveLatticeL ((UserOfRegs LocalReg (CmmNode O O),
DefinerOfRegs LocalReg (CmmNode O O),
UserOfRegs LocalReg (CmmNode O C),
DefinerOfRegs LocalReg (CmmNode O C)) =>
Platform -> TransferFun LRegSet
xferLiveL Platform
platform) CmmGraph
graph forall (map :: * -> *) a. IsMap map => map a
mapEmpty
where
entry :: BlockId
entry = forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry CmmGraph
graph
check :: BlockEntryLivenessL -> BlockEntryLivenessL
check BlockEntryLivenessL
facts =
forall a. BlockId -> LRegSet -> a -> a
noLiveOnEntryL BlockId
entry (forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"check" forall a b. (a -> b) -> a -> b
$ forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup BlockId
entry BlockEntryLivenessL
facts) BlockEntryLivenessL
facts
noLiveOnEntryL :: BlockId -> LRegSet -> a -> a
noLiveOnEntryL :: forall a. BlockId -> LRegSet -> a -> a
noLiveOnEntryL BlockId
bid LRegSet
in_fact a
x =
if LRegSet -> Bool
nullLRegSet LRegSet
in_fact then a
x
else forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"LocalReg's live-in to graph" (forall a. Outputable a => a -> SDoc
ppr BlockId
bid SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr [Unique]
reg_uniques)
where
reg_uniques :: [Unique]
reg_uniques = forall a b. (a -> b) -> [a] -> [b]
map Int -> Unique
mkUniqueGrimily forall a b. (a -> b) -> a -> b
$ LRegSet -> [Int]
elemsLRegSet LRegSet
in_fact
gen_killL
:: (DefinerOfRegs LocalReg n, UserOfRegs LocalReg n)
=> Platform -> n -> LRegSet -> LRegSet
gen_killL :: forall n.
(DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) =>
Platform -> n -> LRegSet -> LRegSet
gen_killL Platform
platform n
node LRegSet
set =
let !afterKill :: LRegSet
afterKill = forall r a b.
DefinerOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsDefd Platform
platform LRegSet -> LocalReg -> LRegSet
deleteFromLRegSet LRegSet
set n
node
in forall r a b.
UserOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsUsed Platform
platform (forall a b c. (a -> b -> c) -> b -> a -> c
flip LocalReg -> LRegSet -> LRegSet
insertLRegSet) LRegSet
afterKill n
node
{-# INLINE gen_killL #-}
xferLiveL
:: ( UserOfRegs LocalReg (CmmNode O O)
, DefinerOfRegs LocalReg (CmmNode O O)
, UserOfRegs LocalReg (CmmNode O C)
, DefinerOfRegs LocalReg (CmmNode O C)
)
=> Platform -> TransferFun LRegSet
xferLiveL :: (UserOfRegs LocalReg (CmmNode O O),
DefinerOfRegs LocalReg (CmmNode O O),
UserOfRegs LocalReg (CmmNode O C),
DefinerOfRegs LocalReg (CmmNode O C)) =>
Platform -> TransferFun LRegSet
xferLiveL Platform
platform (BlockCC CmmNode C O
eNode Block CmmNode O O
middle CmmNode O C
xNode) BlockEntryLivenessL
fBase =
let joined :: LRegSet
joined = forall n.
(DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) =>
Platform -> n -> LRegSet -> LRegSet
gen_killL Platform
platform CmmNode O C
xNode forall a b. (a -> b) -> a -> b
$! forall (n :: Extensibility -> Extensibility -> *) f
(e :: Extensibility).
NonLocal n =>
DataflowLattice f -> n e C -> FactBase f -> f
joinOutFacts DataflowLattice LRegSet
liveLatticeL CmmNode O C
xNode BlockEntryLivenessL
fBase
!result :: LRegSet
result = forall f. (CmmNode O O -> f -> f) -> Block CmmNode O O -> f -> f
foldNodesBwdOO (forall n.
(DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) =>
Platform -> n -> LRegSet -> LRegSet
gen_killL Platform
platform) Block CmmNode O O
middle LRegSet
joined
in forall (map :: * -> *) a. IsMap map => KeyOf map -> a -> map a
mapSingleton (forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> BlockId
entryLabel CmmNode C O
eNode) LRegSet
result