CmmLive.hs 2.66 KB
Newer Older
1
{-# LANGUAGE GADTs #-}
2

3
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
4

5
6
7
8
9
10
11
module CmmLive
    ( CmmLive
    , cmmLiveness
    , liveLattice
    , noLiveOnEntry, xferLive
    )
where
12

13
import BlockId
14
import Cmm
15
16
17
18
import CmmExpr
import Control.Monad
import OptimizationFuel
import PprCmmExpr ()
19

20
import Compiler.Hoopl
21
import Maybes
22
import Outputable
23
24
25
26
27
28
import UniqSet

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

29
-- | The variables live on entry to a block
30
31
32
33
34
35
36
type CmmLive = RegSet

-- | The dataflow lattice
liveLattice :: DataflowLattice CmmLive
liveLattice = DataflowLattice "live LocalReg's" emptyRegSet add
    where add _ (OldFact old) (NewFact new) = case unionUniqSets old new of
            join -> (changeIf $ sizeUniqSet join > sizeUniqSet old, join)
37

38
-- | A mapping from block labels to the variables live on entry
39
40
type BlockEntryLiveness = BlockEnv CmmLive

41
-----------------------------------------------------------------------------
42
-- | Calculated liveness info for a CmmGraph
43
-----------------------------------------------------------------------------
44

45
46
47
48
49
50
51
52
53
54
55
56
57
cmmLiveness :: CmmGraph -> FuelUniqSM BlockEntryLiveness
cmmLiveness graph =
  liftM check $ liftM snd $ dataflowPassBwd graph [] $ analBwd liveLattice xferLive
  where entry = g_entry graph
        check facts = noLiveOnEntry entry (expectJust "check" $ mapLookup entry facts) facts

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

-- | The transfer equations use the traditional 'gen' and 'kill'
58
59
60
-- notations, which should be familiar from the Dragon Book.
gen  :: UserOfLocalRegs a    => a -> RegSet -> RegSet
gen  a live = foldRegsUsed extendRegSet      live a
61
62
63
kill :: DefinerOfLocalRegs a => a -> RegSet -> RegSet
kill a live = foldRegsDefd delOneFromUniqSet live a

64
65
66
67
gen_kill :: (DefinerOfLocalRegs a, UserOfLocalRegs a) => a -> CmmLive -> CmmLive
gen_kill a = gen a . kill a

-- | The transfer function
68
69
70
71
xferLive :: BwdTransfer CmmNode CmmLive
xferLive = mkBTransfer3 fst mid lst
  where fst _ f = f
        mid :: CmmNode O O -> CmmLive -> CmmLive
72
        mid n f = gen_kill n f
73
        lst :: CmmNode O C -> FactBase CmmLive -> CmmLive
74
75
76
77
        lst n f = gen_kill n
                $ case n of CmmCall{}        -> emptyRegSet
                            CmmForeignCall{} -> emptyRegSet
                            _                -> joinOutFacts liveLattice n f