compiler/cmm/CmmLiveZ.hs

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