CmmLive.hs 2.67 KB
Newer Older
1 2
{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
3

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

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

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

-----------------------------------------------------------------------------
-- 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 34 35
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)
36

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

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

44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
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

gen_kill :: (DefinerOfLocalRegs a, UserOfLocalRegs a) => a -> CmmLive -> CmmLive
gen_kill a = gen a . kill a

-- | 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'
-- notations, which should be familiar from the dragon book.
gen  :: UserOfLocalRegs    a => a -> RegSet -> RegSet
gen  a live = foldRegsUsed    extendRegSet      live a
kill :: DefinerOfLocalRegs a => a -> RegSet -> RegSet
kill a live = foldRegsDefd delOneFromUniqSet live a

66
-- Testing!
67 68 69 70
xferLive :: BwdTransfer CmmNode CmmLive
xferLive = mkBTransfer3 fst mid lst
  where fst _ f = f
        mid :: CmmNode O O -> CmmLive -> CmmLive
71
        mid n f = gen_kill n f
72 73 74 75
        lst :: CmmNode O C -> FactBase CmmLive -> CmmLive
        lst n f = gen_kill n $ case n of CmmCall {}            -> emptyRegSet
                                         CmmForeignCall {}     -> emptyRegSet
                                         _                     -> joinOutFacts liveLattice n f