compiler/cmm/CmmLiveZ.hs

   1 {-# OPTIONS -Wall -fno-warn-name-shadowing #-}
   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 Maybes
  15 import PprCmm()
  16 import PprCmmZ()
  17 import UniqSet
  18 import ZipDataflow
  19 import ZipCfgCmm
  20
  21 -----------------------------------------------------------------------------
  22 -- Calculating what variables are live on entry to a basic block
  23 -----------------------------------------------------------------------------
  24
  25 -- | The variables live on entry to a block
  26 type CmmLive = RegSet
  27
  28 -- | The dataflow lattice
  29 liveLattice :: DataflowLattice CmmLive
  30 liveLattice = DataflowLattice "live LocalReg's" emptyUniqSet add False
  31     where add new old =
  32             let join = unionUniqSets new old in
  33             (if sizeUniqSet join > sizeUniqSet old then aTx else noTx) join
  34
  35 -- | A mapping from block labels to the variables live on entry
  36 type BlockEntryLiveness = BlockEnv CmmLive
  37
  38 -----------------------------------------------------------------------------
  39 -- | Calculated liveness info for a CmmGraph
  40 -----------------------------------------------------------------------------
  41 cmmLivenessZ :: CmmGraph -> BlockEntryLiveness
  42 cmmLivenessZ g = env
  43     where env = runDFA liveLattice $
  44                 do run_b_anal transfer g
  45                    allFacts
  46           transfer = BComp "liveness analysis" exit last middle first
  47           exit         = emptyUniqSet
  48           first live _ = live
  49           middle       = flip middleLiveness
  50           last         = flip lastLiveness
  51
  52 -- | The transfer equations use the traditional 'gen' and 'kill'
  53 -- notations, which should be familiar from the dragon book.
  54 gen, kill :: UserOfLocalRegs a => a -> RegSet -> RegSet
  55 gen  a live = foldRegsUsed extendRegSet      live a
  56 kill a live = foldRegsUsed delOneFromUniqSet live a
  57
  58 middleLiveness :: Middle -> CmmLive -> CmmLive
  59 middleLiveness m = middle m
  60   where middle (MidNop)                      = id
  61         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 (CopyIn _ formals _)          = kill formals
  66         middle (CopyOut _ formals)           = gen formals
  67
  68 lastLiveness :: Last -> (BlockId -> CmmLive) -> CmmLive
  69 lastLiveness l env = last l
  70   where last (LastReturn ress)             = gen ress emptyUniqSet
  71         last (LastJump e args)             = gen e $ gen args emptyUniqSet
  72         last (LastBranch id args)          = gen args $ env id
  73         last (LastCall tgt args (Just k))  = gen tgt $ gen args $ env k
  74         last (LastCall tgt args Nothing)   = gen tgt $ gen args $ emptyUniqSet
  75         last (LastCondBranch e t f)        = gen e $ unionUniqSets (env t) (env f)
  76         last (LastSwitch e tbl) = gen e $ unionManyUniqSets $ map env (catMaybes tbl)