compiler/cmm/CmmLive.hs

   1 module CmmLive (
   2         CmmLive, BlockEntryLiveness,
   3         cmmLiveness
   4   ) where
   5
   6 import Cmm
   7 import Dataflow
   8
   9 import Maybes
  10 import Panic
  11 import UniqFM
  12 import UniqSet
  13
  14 import Data.List
  15
  16 -----------------------------------------------------------------------------
  17 -- Calculating what variables are live on entry to a basic block
  18 -----------------------------------------------------------------------------
  19
  20 -- The variables live on entry to a block
  21 type CmmLive = UniqSet LocalReg
  22
  23 -- A mapping from block labels to the variables live on entry
  24 type BlockEntryLiveness = BlockEnv CmmLive
  25
  26 -----------------------------------------------------------------------------
  27 -- cmmLiveness and helpers
  28 -----------------------------------------------------------------------------
  29 cmmLiveness :: [CmmBasicBlock] -> BlockEntryLiveness
  30 cmmLiveness blocks =
  31     fixedpoint (cmmBlockDependants sources)
  32                (cmmBlockUpdate blocks')
  33                (map blockId blocks)
  34                (listToUFM [(blockId b, emptyUniqSet) | b <- blocks])
  35     where
  36       sources = cmmBlockSources blocks
  37       blocks' = cmmBlockNames blocks
  38
  39 {-
  40 -- For debugging, annotate each block with a comment indicating
  41 -- the calculated live variables
  42 cmmLivenessComment ::
  43     BlockEnv (UniqSet LocalReg) -> CmmBasicBlock -> CmmBasicBlock
  44 cmmLivenessComment live (BasicBlock ident stmts) =
  45     BasicBlock ident stmts' where
  46         stmts' = (CmmComment $ mkFastString $ showSDoc $ ppr $ live'):stmts
  47         live' = map CmmLocal $ uniqSetToList $ lookupWithDefaultUFM live emptyUniqSet ident
  48 -}
  49
  50
  51 --------------------------------
  52 -- cmmBlockSources
  53 --
  54 -- Calculates a table of blocks
  55 -- that might need updating after
  56 -- a given block is updated
  57 --------------------------------
  58 cmmBlockSources :: [CmmBasicBlock] -> BlockEnv (UniqSet BlockId)
  59 cmmBlockSources blocks = foldr aux emptyUFM blocks
  60     where
  61       aux :: CmmBasicBlock
  62           -> BlockEnv (UniqSet BlockId)
  63           -> BlockEnv (UniqSet BlockId)
  64       aux block sourcesUFM =
  65           foldUniqSet (add_source_edges $ blockId block)
  66                       sourcesUFM
  67                       (branch_targets $ blockStmts block)
  68
  69       add_source_edges :: BlockId -> BlockId
  70                        -> BlockEnv (UniqSet BlockId)
  71                        -> BlockEnv (UniqSet BlockId)
  72       add_source_edges source target ufm =
  73           addToUFM_Acc (flip addOneToUniqSet) unitUniqSet ufm target source
  74
  75       branch_targets :: [CmmStmt] -> UniqSet BlockId
  76       branch_targets stmts =
  77           mkUniqSet $ concatMap target stmts where
  78               target (CmmBranch ident) = [ident]
  79               target (CmmCondBranch _ ident) = [ident]
  80               target (CmmSwitch _ blocks) = mapMaybe id blocks
  81               target _ = []
  82
  83 --------------------------------
  84 -- cmmBlockNames
  85 --
  86 -- Calculates a table that maps
  87 -- block names to the list
  88 -- of statements inside them
  89 --------------------------------
  90 cmmBlockNames :: [CmmBasicBlock] -> BlockEnv [CmmStmt]
  91 cmmBlockNames blocks = listToUFM $ map block_name blocks where
  92     block_name b = (blockId b, blockStmts b)
  93
  94 --------------------------------
  95 -- cmmBlockDependants
  96 --
  97 -- Given the table calculated
  98 -- by cmmBlockSources created,
  99 -- list all blocks that depend
 100 -- on the result of a particular
 101 -- block.
 102 --------------------------------
 103 cmmBlockDependants :: BlockEnv (UniqSet BlockId) -> BlockId -> [BlockId]
 104 cmmBlockDependants sources ident =
 105     uniqSetToList $ lookupWithDefaultUFM sources emptyUniqSet ident
 106
 107 --------------------------------
 108 -- cmmBlockUpdate
 109 --
 110 -- Given the table from
 111 -- cmmBlockNames and a block
 112 -- that was updated, calculate
 113 -- an updated BlockEntryLiveness
 114 --------------------------------
 115 cmmBlockUpdate ::
 116     BlockEnv [CmmStmt]
 117     -> BlockId
 118     -> Maybe BlockId
 119     -> BlockEntryLiveness
 120     -> Maybe BlockEntryLiveness
 121 cmmBlockUpdate blocks node _ state =
 122     if (sizeUniqSet old_live) == (sizeUniqSet new_live)
 123       then Nothing
 124       else Just $ addToUFM state node new_live
 125     where
 126       new_live = cmmStmtListLive state block
 127       old_live = lookupWithDefaultUFM state missing_live node
 128       block = lookupWithDefaultUFM blocks missing_block node
 129       missing_live = panic "unknown block id during liveness analysis"
 130       missing_block = panic "unknown block id during liveness analysis"
 131
 132 -----------------------------------------------------------------------------
 133 -- CmmBlockLive, cmmStmtListLive and helpers
 134 -----------------------------------------------------------------------------
 135
 136 -- Calculate the live registers for a local block (list of statements)
 137
 138 cmmStmtListLive :: BlockEntryLiveness -> [CmmStmt] -> CmmLive
 139 cmmStmtListLive other_live stmts =
 140     foldr ((.) . (cmmStmtLive other_live)) id stmts emptyUniqSet
 141
 142 -----------------------------------------------------------------------------
 143 -- This code is written in the style of a state monad,
 144 -- but since Control.Monad.State is not in the core
 145 -- we can't use it in GHC, so we'll fake one here.
 146 -- We don't need a return value so well leave it out.
 147 -- Thus 'bind' reduces to function composition.
 148
 149 type CmmLivenessTransformer = CmmLive -> CmmLive
 150
 151 -- Helpers for the "Monad"
 152 addLive, addKilled :: CmmLive -> CmmLivenessTransformer
 153 addLive new_live live = live `unionUniqSets` new_live
 154 addKilled new_killed live = live `minusUniqSet` new_killed
 155
 156 --------------------------------
 157 -- Liveness of a CmmStmt
 158 --------------------------------
 159 cmmStmtLive :: BlockEntryLiveness -> CmmStmt -> CmmLivenessTransformer
 160 cmmStmtLive _ (CmmNop) = id
 161 cmmStmtLive _ (CmmComment _) = id
 162 cmmStmtLive _ (CmmAssign reg expr) =
 163     cmmExprLive expr . reg_liveness where
 164         reg_liveness =
 165             case reg of
 166               (CmmLocal reg') -> addKilled $ unitUniqSet reg'
 167               (CmmGlobal _) -> id
 168 cmmStmtLive _ (CmmStore expr1 expr2) =
 169     cmmExprLive expr2 . cmmExprLive expr1
 170 cmmStmtLive _ (CmmCall target results arguments _) =
 171     target_liveness .
 172     foldr ((.) . cmmExprLive) id (map fst arguments) .
 173     addKilled (mkUniqSet $ only_local_regs results) where
 174         only_local_regs [] = []
 175         only_local_regs ((CmmGlobal _,_):args) = only_local_regs args
 176         only_local_regs ((CmmLocal r,_):args) = r:only_local_regs args
 177         target_liveness =
 178             case target of
 179               (CmmForeignCall target _) -> cmmExprLive target
 180               (CmmPrim _) -> id
 181 cmmStmtLive other_live (CmmBranch target) =
 182     addLive (lookupWithDefaultUFM other_live emptyUniqSet target)
 183 cmmStmtLive other_live (CmmCondBranch expr target) =
 184     cmmExprLive expr .
 185     addLive (lookupWithDefaultUFM other_live emptyUniqSet target)
 186 cmmStmtLive other_live (CmmSwitch expr targets) =
 187     cmmExprLive expr .
 188     (foldr ((.) . (addLive .
 189                    lookupWithDefaultUFM other_live emptyUniqSet))
 190            id
 191            (mapCatMaybes id targets))
 192 cmmStmtLive _ (CmmJump expr params) =
 193     const (cmmExprLive expr $ foldr ((.) . cmmExprLive) id (map fst params) $ emptyUniqSet)
 194 cmmStmtLive _ (CmmReturn params) =
 195     const (foldr ((.) . cmmExprLive) id (map fst params) $ emptyUniqSet)
 196
 197 --------------------------------
 198 -- Liveness of a CmmExpr
 199 --------------------------------
 200 cmmExprLive :: CmmExpr -> CmmLivenessTransformer
 201 cmmExprLive expr = addLive (mkUniqSet $ expr_liveness expr) where
 202     expr_liveness :: CmmExpr -> [LocalReg]
 203     expr_liveness (CmmLit _) = []
 204     expr_liveness (CmmLoad expr _) = expr_liveness expr
 205     expr_liveness (CmmReg reg) = reg_liveness reg
 206     expr_liveness (CmmMachOp _ exprs) = concatMap expr_liveness exprs
 207     expr_liveness (CmmRegOff reg _) = reg_liveness reg
 208
 209     reg_liveness :: CmmReg -> [LocalReg]
 210     reg_liveness (CmmLocal reg) = [reg]
 211     reg_liveness (CmmGlobal _) = []