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

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

5
6
7
8
module CmmLive
    ( CmmLive
    , cmmLiveness
    , liveLattice
9
10
    , noLiveOnEntry, xferLive, gen, kill, gen_kill
    , removeDeadAssignments
11
12
    )
where
13

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

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

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

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

-- | The dataflow lattice
liveLattice :: DataflowLattice CmmLive
liveLattice = DataflowLattice "live LocalReg's" emptyRegSet add
36
37
38
39
    where add _ (OldFact old) (NewFact new) =
               (changeIf $ sizeRegSet join > sizeRegSet old, join)
              where !join = plusRegSet old new

40

41
-- | A mapping from block labels to the variables live on entry
42
43
type BlockEntryLiveness = BlockEnv CmmLive

44
-----------------------------------------------------------------------------
45
-- | Calculated liveness info for a CmmGraph
46
-----------------------------------------------------------------------------
47

48
49
cmmLiveness :: CmmGraph -> FuelUniqSM BlockEntryLiveness
cmmLiveness graph =
Simon Marlow's avatar
Simon Marlow committed
50
  liftM check $ dataflowAnalBwd graph [] $ analBwd liveLattice xferLive
51
52
53
54
55
56
  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 =
57
  if nullRegSet in_fact then x
58
59
60
  else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact)

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

67
68
69
70
gen_kill :: (DefinerOfLocalRegs a, UserOfLocalRegs a) => a -> CmmLive -> CmmLive
gen_kill a = gen a . kill a

-- | The transfer function
71
72
73
-- EZY: Bits of this analysis are duplicated in CmmSpillReload, though
-- it's not really easy to efficiently reuse all of this.  Keep in mind
-- if you need to update this analysis.
74
75
76
77
xferLive :: BwdTransfer CmmNode CmmLive
xferLive = mkBTransfer3 fst mid lst
  where fst _ f = f
        mid :: CmmNode O O -> CmmLive -> CmmLive
78
        mid n f = gen_kill n f
79
        lst :: CmmNode O C -> FactBase CmmLive -> CmmLive
80
        -- slightly inefficient: kill is unnecessary for emptyRegSet
81
82
83
84
        lst n f = gen_kill n
                $ case n of CmmCall{}        -> emptyRegSet
                            CmmForeignCall{} -> emptyRegSet
                            _                -> joinOutFacts liveLattice n f
85
86
87
88
89
90
91
92

-----------------------------------------------------------------------------
-- Removing assignments to dead variables
-----------------------------------------------------------------------------

removeDeadAssignments :: CmmGraph -> FuelUniqSM CmmGraph
removeDeadAssignments g =
   liftM fst $ dataflowPassBwd g [] $ analRewBwd liveLattice xferLive rewrites
Simon Marlow's avatar
Simon Marlow committed
93
94
   where rewrites = mkBRewrite3 nothing middle nothing
         -- SDM: no need for deepBwdRw here, we only rewrite to empty
95
96
97
98
99
100
101
102
103
104
105
         -- Beware: deepBwdRw with one polymorphic function seems more reasonable here,
         -- but GHC panics while compiling, see bug #4045.
         middle :: CmmNode O O -> Fact O CmmLive -> CmmReplGraph O O
         middle (CmmAssign (CmmLocal reg') _) live | not (reg' `elemRegSet` live) = return $ Just emptyGraph
         -- XXX maybe this should be somewhere else...
         middle (CmmAssign lhs (CmmReg rhs))   _ | lhs == rhs = return $ Just emptyGraph
         middle (CmmStore lhs (CmmLoad rhs _)) _ | lhs == rhs = return $ Just emptyGraph
         middle _ _ = return Nothing

         nothing :: CmmNode e x -> Fact x CmmLive -> CmmReplGraph e x
         nothing _ _ = return Nothing