{-# 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 () -- For Outputable instances
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

-----------------------------------------------------------------------------
-- 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 = 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

-- | 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 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

-- | On entry to the procedure, there had better not be any LocalReg's live-in.
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) #-}

-----------------------------------------------------------------------------
-- | Specialization that only retains the keys for local variables.
--
-- Local variablas 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 = 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

-- | 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 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
        -- We convert the int's to uniques so that the printing matches that
        -- of registers.
        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