compiler/cmm/CmmLiveZ.hs

   1
   2 module CmmLiveZ
   3     ( CmmLive
   4     , cmmLivenessZ
   5     , liveLattice
   6     , middleLiveness, noLiveOnEntry
   7     )
   8 where
   9
  10 import BlockId
  11 import CmmExpr
  12 import CmmTx
  13 import DFMonad
  14 import Control.Monad
  15 import PprCmm()
  16 import PprCmmZ()
  17 import ZipCfg
  18 import ZipDataflow
  19 import ZipCfgCmmRep
  20
  21 import Maybes
  22 import Outputable
  23 import UniqSet
  24
  25 -----------------------------------------------------------------------------
  26 -- Calculating what variables are live on entry to a basic block
  27 -----------------------------------------------------------------------------
  28
  29 -- | The variables live on entry to a block
  30 type CmmLive = RegSet
  31
  32 -- | The dataflow lattice
  33 liveLattice :: DataflowLattice CmmLive
  34 liveLattice = DataflowLattice "live LocalReg's" emptyUniqSet add False
  35     where add new old =
  36             let join = unionUniqSets new old in
  37             (if sizeUniqSet join > sizeUniqSet old then aTx else noTx) join
  38
  39 -- | A mapping from block labels to the variables live on entry
  40 type BlockEntryLiveness = BlockEnv CmmLive
  41
  42 -----------------------------------------------------------------------------
  43 -- | Calculated liveness info for a CmmGraph
  44 -----------------------------------------------------------------------------
  45 cmmLivenessZ :: CmmGraph -> FuelMonad BlockEntryLiveness
  46 cmmLivenessZ g@(LGraph entry _) =
  47   liftM (check . zdfFpFacts) (res :: FuelMonad (CmmBackwardFixedPoint CmmLive))
  48   where res = zdfSolveFrom emptyBlockEnv "liveness analysis" liveLattice transfers
  49                            emptyUniqSet (graphOfLGraph g)
  50         transfers = BackwardTransfers (flip const) mid last
  51         mid  m = gen_kill m . midLive  m
  52         last l = gen_kill l . lastLive l
  53         check facts   =
  54           noLiveOnEntry entry (expectJust "check" $ lookupBlockEnv facts entry) facts
  55
  56 gen_kill :: (DefinerOfLocalRegs a, UserOfLocalRegs a) => a -> CmmLive -> CmmLive
  57 gen_kill a = gen a . kill a
  58
  59 middleLiveness :: Middle -> CmmLive -> CmmLive
  60 middleLiveness = gen_kill
  61
  62 -- | On entry to the procedure, there had better not be any LocalReg's live-in.
  63 noLiveOnEntry :: BlockId -> CmmLive -> a -> a
  64 noLiveOnEntry bid in_fact x =
  65   if isEmptyUniqSet in_fact then x
  66   else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact)
  67
  68 -- | The transfer equations use the traditional 'gen' and 'kill'
  69 -- notations, which should be familiar from the dragon book.
  70 gen  :: UserOfLocalRegs    a => a -> RegSet -> RegSet
  71 gen  a live = foldRegsUsed    extendRegSet      live a
  72 kill :: DefinerOfLocalRegs a => a -> RegSet -> RegSet
  73 kill a live = foldRegsDefd delOneFromUniqSet live a
  74
  75 midLive :: Middle -> CmmLive -> CmmLive
  76 midLive (MidForeignCall {}) _ = emptyUniqSet
  77 midLive _                live = live
  78
  79 lastLive :: Last -> (BlockId -> CmmLive) -> CmmLive
  80 lastLive l env = last l
  81   where last (LastBranch id)        = env id
  82         last (LastCall _ _  _ _ _)  = emptyUniqSet
  83         last (LastCondBranch _ t f) = unionUniqSets (env t) (env f)
  84         last (LastSwitch _ tbl)     = unionManyUniqSets $ map env (catMaybes tbl)