CmmLive.hs 3.76 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 UniqSupply
15
import BlockId
16
import Cmm
17
import CmmUtils
18
import PprCmmExpr ()
19

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

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

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

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

38

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

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

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

-- | 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 =
56
  if nullRegSet in_fact then x
57 58 59
  else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact)

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

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

-- | The transfer function
71 72 73 74
xferLive :: BwdTransfer CmmNode CmmLive
xferLive = mkBTransfer3 fst mid lst
  where fst _ f = f
        mid :: CmmNode O O -> CmmLive -> CmmLive
75
        mid n f = gen_kill n f
76
        lst :: CmmNode O C -> FactBase CmmLive -> CmmLive
Simon Marlow's avatar
Simon Marlow committed
77
        lst n f = gen_kill n $ joinOutFacts liveLattice n f
78 79 80 81 82

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

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

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