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

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

9
module CmmLive
10 11 12
    ( CmmLocalLive
    , cmmLocalLiveness
    , cmmGlobalLiveness
13
    , liveLattice
14
    , 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
type CmmLive r = RegSet r
type CmmLocalLive = CmmLive LocalReg
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