1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE GADTs #-}
4{-# LANGUAGE ScopedTypeVariables #-}
5
6module CmmLive
7    ( CmmLocalLive
8    , cmmLocalLiveness
9    , cmmGlobalLiveness
10    , liveLattice
11    , gen_kill
12    )
13where
14
15import GhcPrelude
16
17import DynFlags
18import BlockId
19import Cmm
20import PprCmmExpr () -- For Outputable instances
21import Hoopl.Block
22import Hoopl.Collections
23import Hoopl.Dataflow
24import Hoopl.Label
25
26import Maybes
27import Outputable
28
29-----------------------------------------------------------------------------
30-- Calculating what variables are live on entry to a basic block
31-----------------------------------------------------------------------------
32
33-- | The variables live on entry to a block
34type CmmLive r = RegSet r
35type CmmLocalLive = CmmLive LocalReg
36
37-- | The dataflow lattice
38liveLattice :: Ord r => DataflowLattice (CmmLive r)
39{-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive LocalReg) #-}
40{-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive GlobalReg) #-}
41liveLattice = DataflowLattice emptyRegSet add
42  where
43    add (OldFact old) (NewFact new) =
44        let !join = plusRegSet old new
45        in changedIf (sizeRegSet join > sizeRegSet old) join
46
47-- | A mapping from block labels to the variables live on entry
48type BlockEntryLiveness r = LabelMap (CmmLive r)
49
50-----------------------------------------------------------------------------
51-- | Calculated liveness info for a CmmGraph
52-----------------------------------------------------------------------------
53
54cmmLocalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness LocalReg
55cmmLocalLiveness dflags graph =
56    check $ analyzeCmmBwd liveLattice (xferLive dflags) graph mapEmpty
57  where
58    entry = g_entry graph
59    check facts =
60        noLiveOnEntry entry (expectJust "check" $ mapLookup entry facts) facts
61
62cmmGlobalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness GlobalReg
63cmmGlobalLiveness dflags graph =
64    analyzeCmmBwd liveLattice (xferLive dflags) graph mapEmpty
65
66-- | On entry to the procedure, there had better not be any LocalReg's live-in.
67noLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a
68noLiveOnEntry bid in_fact x =
69  if nullRegSet in_fact then x
70  else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact)
71
72gen_kill
73    :: (DefinerOfRegs r n, UserOfRegs r n)
74    => DynFlags -> n -> CmmLive r -> CmmLive r
75gen_kill dflags node set =
76    let !afterKill = foldRegsDefd dflags deleteFromRegSet set node
77    in foldRegsUsed dflags extendRegSet afterKill node
78{-# INLINE gen_kill #-}
79
80xferLive
81    :: forall r.
82       ( UserOfRegs r (CmmNode O O)
83       , DefinerOfRegs r (CmmNode O O)
84       , UserOfRegs r (CmmNode O C)
85       , DefinerOfRegs r (CmmNode O C)
86       )
87    => DynFlags -> TransferFun (CmmLive r)
88xferLive dflags (BlockCC eNode middle xNode) fBase =
89    let joined = gen_kill dflags xNode $! joinOutFacts liveLattice xNode fBase
90        !result = foldNodesBwdOO (gen_kill dflags) middle joined
91    in mapSingleton (entryLabel eNode) result
92{-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive LocalReg) #-}
93{-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive GlobalReg) #-}
94