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

Jan Stolarek's avatar
Jan Stolarek committed
5
-- See Note [Deprecations in Hoopl] in Hoopl module
6
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
7

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

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

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

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

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

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

46

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

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

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

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

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

-- | The transfer equations use the traditional 'gen' and 'kill'
72
-- notations, which should be familiar from the Dragon Book.
73 74 75 76 77 78 79
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
80

81 82 83 84
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
85 86

-- | The transfer function
87 88 89 90 91 92 93 94
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
95
  where fst _ f = f
96 97 98 99
        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