CmmLive.hs 3.62 KB
Newer Older
1
{-# LANGUAGE FlexibleContexts #-}
2
{-# LANGUAGE GADTs #-}
3
{-# LANGUAGE ScopedTypeVariables #-}
4

5
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
6

7
module CmmLive
8 9 10 11
    ( CmmLocalLive
    , CmmGlobalLive
    , cmmLocalLiveness
    , cmmGlobalLiveness
12
    , liveLattice
13
    , noLiveOnEntry, xferLive, gen, kill, gen_kill
14 15
    )
where
16

17
import DynFlags
18
import BlockId
19
import Cmm
20
import CmmUtils
21
import PprCmmExpr ()
22

Simon Marlow's avatar
Simon Marlow committed
23
import Hoopl
24
import Maybes
25
import Outputable
26 27 28 29 30

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

31
-- | The variables live on entry to a block
32 33 34
type CmmLive r = RegSet r
type CmmLocalLive = CmmLive LocalReg
type CmmGlobalLive = CmmLive GlobalReg
35 36

-- | The dataflow lattice
37 38 39
liveLattice :: Ord r => DataflowLattice (CmmLive r)
{-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive LocalReg) #-}
{-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive GlobalReg) #-}
40
liveLattice = DataflowLattice "live LocalReg's" emptyRegSet add
41 42 43 44
    where add _ (OldFact old) (NewFact new) =
               (changeIf $ sizeRegSet join > sizeRegSet old, join)
              where !join = plusRegSet old new

45

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

49
-----------------------------------------------------------------------------
50
-- | Calculated liveness info for a CmmGraph
51
-----------------------------------------------------------------------------
52

53 54 55
cmmLocalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness LocalReg
cmmLocalLiveness dflags graph =
  check $ dataflowAnalBwd graph [] $ analBwd liveLattice (xferLive dflags)
56
  where entry = g_entry graph
57 58
        check facts = noLiveOnEntry entry
                        (expectJust "check" $ mapLookup entry facts) facts
59

60 61 62 63
cmmGlobalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness GlobalReg
cmmGlobalLiveness dflags graph =
  dataflowAnalBwd graph [] $ analBwd liveLattice (xferLive dflags)

64
-- | On entry to the procedure, there had better not be any LocalReg's live-in.
65
noLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a
66
noLiveOnEntry bid in_fact x =
67
  if nullRegSet in_fact then x
68 69 70
  else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact)

-- | The transfer equations use the traditional 'gen' and 'kill'
71
-- notations, which should be familiar from the Dragon Book.
72 73 74 75 76 77 78
gen  :: UserOfRegs r a => DynFlags -> a -> RegSet r -> RegSet r
{-# INLINE gen #-}
gen dflags a live = foldRegsUsed dflags extendRegSet live a

kill :: DefinerOfRegs r a => DynFlags -> a -> RegSet r -> RegSet r
{-# INLINE kill #-}
kill dflags a live = foldRegsDefd dflags deleteFromRegSet live a
79

80 81 82 83
gen_kill :: (DefinerOfRegs r a, UserOfRegs r a)
          => DynFlags -> a -> CmmLive r -> CmmLive r
{-# INLINE gen_kill #-}
gen_kill dflags a = gen dflags a . kill dflags a
84 85

-- | The transfer function
86 87 88 89 90 91 92 93
xferLive :: forall r . ( UserOfRegs    r (CmmNode O O)
                       , DefinerOfRegs r (CmmNode O O)
                       , UserOfRegs    r (CmmNode O C)
                       , DefinerOfRegs r (CmmNode O C))
         => DynFlags -> BwdTransfer CmmNode (CmmLive r)
{-# SPECIALIZE xferLive :: DynFlags -> BwdTransfer CmmNode (CmmLive LocalReg) #-}
{-# SPECIALIZE xferLive :: DynFlags -> BwdTransfer CmmNode (CmmLive GlobalReg) #-}
xferLive dflags = mkBTransfer3 fst mid lst
94
  where fst _ f = f
95 96 97 98
        mid :: CmmNode O O -> CmmLive r -> CmmLive r
        mid n f = gen_kill dflags n f
        lst :: CmmNode O C -> FactBase (CmmLive r) -> CmmLive r
        lst n f = gen_kill dflags n $ joinOutFacts liveLattice n f