compiler/cmm/CmmLiveZ.hs

   1
   2 module CmmLiveZ
   3     ( CmmLive
   4     , cmmLivenessZ
   5     , liveLattice
   6     , middleLiveness, lastLiveness
   7     )
   8 where
   9
  10 import BlockId
  11 import CmmExpr
  12 import CmmTx
  13 import DFMonad
  14 import Monad
  15 import PprCmm()
  16 import PprCmmZ()
  17 import ZipCfg
  18 import ZipDataflow
  19 import ZipCfgCmmRep
  20
  21 import Maybes
  22 import UniqSet
  23
  24 -----------------------------------------------------------------------------
  25 -- Calculating what variables are live on entry to a basic block
  26 -----------------------------------------------------------------------------
  27
  28 -- | The variables live on entry to a block
  29 type CmmLive = RegSet
  30
  31 -- | The dataflow lattice
  32 liveLattice :: DataflowLattice CmmLive
  33 liveLattice = DataflowLattice "live LocalReg's" emptyUniqSet add False
  34     where add new old =
  35             let join = unionUniqSets new old in
  36             (if sizeUniqSet join > sizeUniqSet old then aTx else noTx) join
  37
  38 -- | A mapping from block labels to the variables live on entry
  39 type BlockEntryLiveness = BlockEnv CmmLive
  40
  41 -----------------------------------------------------------------------------
  42 -- | Calculated liveness info for a CmmGraph
  43 -----------------------------------------------------------------------------
  44 cmmLivenessZ :: CmmGraph -> FuelMonad BlockEntryLiveness
  45 cmmLivenessZ g = liftM zdfFpFacts $ (res :: FuelMonad (CmmBackwardFixedPoint CmmLive))
  46   where res = zdfSolveFrom emptyBlockEnv "liveness analysis" liveLattice transfers
  47                            emptyUniqSet (graphOfLGraph g)
  48         transfers = BackwardTransfers first middle last
  49         first live _ = live
  50         middle       = flip middleLiveness
  51         last         = flip lastLiveness
  52
  53 -- | The transfer equations use the traditional 'gen' and 'kill'
  54 -- notations, which should be familiar from the dragon book.
  55 gen, kill :: UserOfLocalRegs a => a -> RegSet -> RegSet
  56 gen  a live = foldRegsUsed extendRegSet      live a
  57 kill a live = foldRegsUsed delOneFromUniqSet live a
  58
  59 middleLiveness :: Middle -> CmmLive -> CmmLive
  60 middleLiveness m = middle m
  61   where middle (MidComment {})               = id
  62         middle (MidAssign lhs expr)          = gen expr . kill lhs
  63         middle (MidStore addr rval)          = gen addr . gen rval
  64         middle (MidUnsafeCall tgt ress args) = gen tgt . gen args . kill ress
  65         middle (MidAddToContext ra args)     = gen ra . gen args
  66         middle (CopyIn _ formals _)          = kill formals
  67         middle (CopyOut _ actuals)           = gen actuals
  68
  69 lastLiveness :: Last -> (BlockId -> CmmLive) -> CmmLive
  70 lastLiveness l env = last l
  71   where last (LastReturn)            = emptyUniqSet
  72         last (LastJump e)            = gen e $ emptyUniqSet
  73         last (LastBranch id)         = env id
  74         last (LastCall tgt (Just k)) = gen tgt $ env k
  75         last (LastCall tgt Nothing)  = gen tgt $ emptyUniqSet
  76         last (LastCondBranch e t f)  = gen e $ unionUniqSets (env t) (env f)
  77         last (LastSwitch e tbl) = gen e $ unionManyUniqSets $ map env (catMaybes tbl)