CmmLive.hs 3.86 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

-----------------------------------------------------------------------------
-- 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
type CmmLive = RegSet

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

39

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

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

47 48
cmmLiveness :: CmmGraph -> FuelUniqSM BlockEntryLiveness
cmmLiveness graph =
Simon Marlow's avatar
Simon Marlow committed
49
  liftM check $ dataflowAnalBwd graph [] $ analBwd liveLattice xferLive
50 51 52 53 54 55
  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 =
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 68 69
gen_kill :: (DefinerOfLocalRegs a, UserOfLocalRegs a) => a -> CmmLive -> CmmLive
gen_kill a = gen a . kill a

-- | The transfer function
70 71 72
-- 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.
73 74 75 76
xferLive :: BwdTransfer CmmNode CmmLive
xferLive = mkBTransfer3 fst mid lst
  where fst _ f = f
        mid :: CmmNode O O -> CmmLive -> CmmLive
77
        mid n f = gen_kill n f
78
        lst :: CmmNode O C -> FactBase CmmLive -> CmmLive
Simon Marlow's avatar
Simon Marlow committed
79
        lst n f = gen_kill n $ joinOutFacts liveLattice n f
80 81 82 83 84 85 86 87

-----------------------------------------------------------------------------
-- 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
88 89
   where rewrites = mkBRewrite3 nothing middle nothing
         -- SDM: no need for deepBwdRw here, we only rewrite to empty
90 91 92 93 94 95 96 97 98 99 100
         -- 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