CmmLive.hs 3.7 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 13
    ( CmmLocalLive
    , CmmGlobalLive
    , cmmLocalLiveness
    , cmmGlobalLiveness
14
    , liveLattice
15
    , noLiveOnEntry, xferLive, gen, kill, gen_kill
16 17
    )
where
18

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

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

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

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

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

47

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

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

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

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

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

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

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

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