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