{-# LANGUAGE GADTs #-}

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.Dataflow.Block
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

-----------------------------------------------------------------------------
-- Calculating what variables are live on entry to a basic block
-----------------------------------------------------------------------------

-- | The variables live on entry to a block
type CmmLive r = RegSet r
type CmmLocalLive = CmmLive LocalReg

-- | The dataflow lattice
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 = CmmLive r -> JoinFun (CmmLive r) -> DataflowLattice (CmmLive r)
forall a. a -> JoinFun a -> DataflowLattice a
DataflowLattice CmmLive r
forall r. RegSet r
emptyRegSet JoinFun (CmmLive r)
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 = RegSet r -> RegSet r -> RegSet r
forall r. Ord r => RegSet r -> RegSet r -> RegSet r
plusRegSet RegSet r
old RegSet r
new
        in Bool -> RegSet r -> JoinedFact (RegSet r)
forall a. Bool -> a -> JoinedFact a
changedIf (RegSet r -> Int
forall r. RegSet r -> Int
sizeRegSet RegSet r
join Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> RegSet r -> Int
forall r. RegSet r -> Int
sizeRegSet RegSet r
old) RegSet r
join

-- | A mapping from block labels to the variables live on entry
type BlockEntryLiveness r = LabelMap (CmmLive r)

-----------------------------------------------------------------------------
-- | Calculated liveness info for a CmmGraph
-----------------------------------------------------------------------------

cmmLocalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness LocalReg
cmmLocalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness LocalReg
cmmLocalLiveness Platform
platform CmmGraph
graph =
    BlockEntryLiveness LocalReg -> BlockEntryLiveness LocalReg
check (BlockEntryLiveness LocalReg -> BlockEntryLiveness LocalReg)
-> BlockEntryLiveness LocalReg -> BlockEntryLiveness LocalReg
forall a b. (a -> b) -> a -> b
$ DataflowLattice (CmmLive LocalReg)
-> TransferFun' CmmNode (CmmLive LocalReg)
-> CmmGraph
-> BlockEntryLiveness LocalReg
-> BlockEntryLiveness LocalReg
forall (node :: Extensibility -> Extensibility -> *) f.
NonLocal node =>
DataflowLattice f
-> TransferFun' node f
-> GenCmmGraph node
-> FactBase f
-> FactBase f
analyzeCmmBwd DataflowLattice (CmmLive LocalReg)
forall r. Ord r => DataflowLattice (CmmLive r)
liveLattice (Platform -> TransferFun' CmmNode (CmmLive LocalReg)
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 BlockEntryLiveness LocalReg
forall v. LabelMap v
mapEmpty
  where
    entry :: BlockId
entry = CmmGraph -> BlockId
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry CmmGraph
graph
    check :: BlockEntryLiveness LocalReg -> BlockEntryLiveness LocalReg
check BlockEntryLiveness LocalReg
facts =
        BlockId
-> CmmLive LocalReg
-> BlockEntryLiveness LocalReg
-> BlockEntryLiveness LocalReg
forall a. BlockId -> CmmLive LocalReg -> a -> a
noLiveOnEntry BlockId
entry (String -> Maybe (CmmLive LocalReg) -> CmmLive LocalReg
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"check" (Maybe (CmmLive LocalReg) -> CmmLive LocalReg)
-> Maybe (CmmLive LocalReg) -> CmmLive LocalReg
forall a b. (a -> b) -> a -> b
$ BlockId -> BlockEntryLiveness LocalReg -> Maybe (CmmLive LocalReg)
forall a. BlockId -> LabelMap 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 =
    DataflowLattice (CmmLive GlobalReg)
-> TransferFun' CmmNode (CmmLive GlobalReg)
-> CmmGraph
-> BlockEntryLiveness GlobalReg
-> BlockEntryLiveness GlobalReg
forall (node :: Extensibility -> Extensibility -> *) f.
NonLocal node =>
DataflowLattice f
-> TransferFun' node f
-> GenCmmGraph node
-> FactBase f
-> FactBase f
analyzeCmmBwd DataflowLattice (CmmLive GlobalReg)
forall r. Ord r => DataflowLattice (CmmLive r)
liveLattice (Platform -> TransferFun' CmmNode (CmmLive GlobalReg)
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 BlockEntryLiveness GlobalReg
forall v. LabelMap v
mapEmpty

-- | On entry to the procedure, there had better not be any LocalReg's live-in.
-- If you see this error it most likely means you are trying to use a variable
-- without it being defined in the given scope.
noLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a
noLiveOnEntry :: forall a. BlockId -> CmmLive LocalReg -> a -> a
noLiveOnEntry BlockId
bid CmmLive LocalReg
in_fact a
x =
  if CmmLive LocalReg -> Bool
forall r. RegSet r -> Bool
nullRegSet CmmLive LocalReg
in_fact then a
x
  else String -> SDoc -> a
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"LocalReg's live-in to graph" (BlockId -> SDoc
forall a. Outputable a => a -> SDoc
ppr BlockId
bid SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> CmmLive LocalReg -> 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 = Platform
-> (CmmLive r -> r -> CmmLive r) -> CmmLive r -> n -> CmmLive r
forall b. Platform -> (b -> r -> b) -> b -> n -> b
forall r a b.
DefinerOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsDefd Platform
platform CmmLive r -> r -> CmmLive r
forall r. Ord r => RegSet r -> r -> RegSet r
deleteFromRegSet CmmLive r
set n
node
    in Platform
-> (CmmLive r -> r -> CmmLive r) -> CmmLive r -> n -> CmmLive r
forall b. Platform -> (b -> r -> b) -> b -> n -> b
forall r a b.
UserOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsUsed Platform
platform CmmLive r -> r -> CmmLive r
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 = Platform -> CmmNode O C -> CmmLive r -> CmmLive r
forall r n.
(DefinerOfRegs r n, UserOfRegs r n) =>
Platform -> n -> CmmLive r -> CmmLive r
gen_kill Platform
platform CmmNode O C
xNode (CmmLive r -> CmmLive r) -> CmmLive r -> CmmLive r
forall a b. (a -> b) -> a -> b
$! DataflowLattice (CmmLive r)
-> CmmNode O C -> FactBase (CmmLive r) -> CmmLive r
forall (n :: Extensibility -> Extensibility -> *) f
       (e :: Extensibility).
NonLocal n =>
DataflowLattice f -> n e C -> FactBase f -> f
joinOutFacts DataflowLattice (CmmLive r)
forall r. Ord r => DataflowLattice (CmmLive r)
liveLattice CmmNode O C
xNode FactBase (CmmLive r)
fBase
        !result :: CmmLive r
result = (CmmNode O O -> CmmLive r -> CmmLive r)
-> Block CmmNode O O -> CmmLive r -> CmmLive r
forall (node :: Extensibility -> Extensibility -> *) f.
(node O O -> f -> f) -> Block node O O -> f -> f
foldNodesBwdOO (Platform -> CmmNode O O -> CmmLive r -> CmmLive r
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 BlockId -> CmmLive r -> FactBase (CmmLive r)
forall v. BlockId -> v -> LabelMap v
mapSingleton (CmmNode C O -> BlockId
forall (x :: Extensibility). CmmNode C x -> BlockId
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) #-}

-----------------------------------------------------------------------------
-- | Specialization that only retains the keys for local variables.
--
-- Local variables are mostly glorified Ints, and some parts of the compiler
-- really don't care about anything but the Int part. So we can avoid some
-- overhead by computing a IntSet instead of a Set LocalReg which (unsurprisingly)
-- is quite a bit faster.
-----------------------------------------------------------------------------

type BlockEntryLivenessL  = LabelMap LRegSet

-- | The dataflow lattice
liveLatticeL :: DataflowLattice LRegSet
liveLatticeL :: DataflowLattice LRegSet
liveLatticeL = LRegSet -> JoinFun LRegSet -> DataflowLattice LRegSet
forall a. a -> JoinFun a -> DataflowLattice a
DataflowLattice LRegSet
emptyLRegSet JoinFun LRegSet
add
  where
    add :: JoinFun LRegSet
add (OldFact LRegSet
old) (NewFact LRegSet
new) =
        let !join :: LRegSet
join = LRegSet -> LRegSet -> LRegSet
plusLRegSet LRegSet
old LRegSet
new
        in Bool -> LRegSet -> JoinedFact LRegSet
forall a. Bool -> a -> JoinedFact a
changedIf (LRegSet -> Int
sizeLRegSet LRegSet
join Int -> Int -> Bool
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 (BlockEntryLivenessL -> BlockEntryLivenessL)
-> BlockEntryLivenessL -> BlockEntryLivenessL
forall a b. (a -> b) -> a -> b
$ DataflowLattice LRegSet
-> TransferFun' CmmNode LRegSet
-> CmmGraph
-> BlockEntryLivenessL
-> BlockEntryLivenessL
forall (node :: Extensibility -> Extensibility -> *) f.
NonLocal node =>
DataflowLattice f
-> TransferFun' node f
-> GenCmmGraph node
-> FactBase f
-> FactBase f
analyzeCmmBwd DataflowLattice LRegSet
liveLatticeL (Platform -> TransferFun' CmmNode LRegSet
(UserOfRegs LocalReg (CmmNode O O),
 DefinerOfRegs LocalReg (CmmNode O O),
 UserOfRegs LocalReg (CmmNode O C),
 DefinerOfRegs LocalReg (CmmNode O C)) =>
Platform -> TransferFun' CmmNode LRegSet
xferLiveL Platform
platform) CmmGraph
graph BlockEntryLivenessL
forall v. LabelMap v
mapEmpty
  where
    entry :: BlockId
entry = CmmGraph -> BlockId
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry CmmGraph
graph
    check :: BlockEntryLivenessL -> BlockEntryLivenessL
check BlockEntryLivenessL
facts =
        BlockId -> LRegSet -> BlockEntryLivenessL -> BlockEntryLivenessL
forall a. BlockId -> LRegSet -> a -> a
noLiveOnEntryL BlockId
entry (String -> Maybe LRegSet -> LRegSet
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"check" (Maybe LRegSet -> LRegSet) -> Maybe LRegSet -> LRegSet
forall a b. (a -> b) -> a -> b
$ BlockId -> BlockEntryLivenessL -> Maybe LRegSet
forall a. BlockId -> LabelMap a -> Maybe a
mapLookup BlockId
entry BlockEntryLivenessL
facts) BlockEntryLivenessL
facts

-- | On entry to the procedure, there had better not be any LocalReg's live-in.
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 String -> SDoc -> a
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"LocalReg's live-in to graph" (BlockId -> SDoc
forall a. Outputable a => a -> SDoc
ppr BlockId
bid SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Unique] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Unique]
reg_uniques)
    where
        -- We convert the int's to uniques so that the printing matches that
        -- of registers.
        reg_uniques :: [Unique]
reg_uniques = (Word64 -> Unique) -> [Word64] -> [Unique]
forall a b. (a -> b) -> [a] -> [b]
map Word64 -> Unique
mkUniqueGrimily ([Word64] -> [Unique]) -> [Word64] -> [Unique]
forall a b. (a -> b) -> a -> b
$ LRegSet -> [Word64]
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 = Platform
-> (LRegSet -> LocalReg -> LRegSet) -> LRegSet -> n -> LRegSet
forall b. Platform -> (b -> LocalReg -> b) -> b -> n -> b
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 Platform
-> (LRegSet -> LocalReg -> LRegSet) -> LRegSet -> n -> LRegSet
forall b. Platform -> (b -> LocalReg -> b) -> b -> n -> b
forall r a b.
UserOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsUsed Platform
platform ((LocalReg -> LRegSet -> LRegSet) -> LRegSet -> LocalReg -> LRegSet
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' CmmNode LRegSet
xferLiveL Platform
platform (BlockCC CmmNode C O
eNode Block CmmNode O O
middle CmmNode O C
xNode) BlockEntryLivenessL
fBase =
    let joined :: LRegSet
joined = Platform -> CmmNode O C -> LRegSet -> LRegSet
forall n.
(DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) =>
Platform -> n -> LRegSet -> LRegSet
gen_killL Platform
platform CmmNode O C
xNode (LRegSet -> LRegSet) -> LRegSet -> LRegSet
forall a b. (a -> b) -> a -> b
$! DataflowLattice LRegSet
-> CmmNode O C -> BlockEntryLivenessL -> LRegSet
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 = (CmmNode O O -> LRegSet -> LRegSet)
-> Block CmmNode O O -> LRegSet -> LRegSet
forall (node :: Extensibility -> Extensibility -> *) f.
(node O O -> f -> f) -> Block node O O -> f -> f
foldNodesBwdOO (Platform -> CmmNode O O -> LRegSet -> LRegSet
forall n.
(DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) =>
Platform -> n -> LRegSet -> LRegSet
gen_killL Platform
platform) Block CmmNode O O
middle LRegSet
joined
    in BlockId -> LRegSet -> BlockEntryLivenessL
forall v. BlockId -> v -> LabelMap v
mapSingleton (CmmNode C O -> BlockId
forall (x :: Extensibility). CmmNode C x -> BlockId
forall (thing :: Extensibility -> Extensibility -> *)
       (x :: Extensibility).
NonLocal thing =>
thing C x -> BlockId
entryLabel CmmNode C O
eNode) LRegSet
result