compiler/cmm/CmmLive.hs

   1 module CmmLive (
   2         CmmLive,
   3         BlockEntryLiveness,
   4         cmmLiveness,
   5         cmmFormalsToLiveLocals,
   6   ) where
   7
   8 #include "HsVersions.h"
   9
  10 import Cmm
  11 import Dataflow
  12
  13 import Maybes
  14 import Panic
  15 import UniqFM
  16 import UniqSet
  17
  18 -----------------------------------------------------------------------------
  19 -- Calculating what variables are live on entry to a basic block
  20 -----------------------------------------------------------------------------
  21
  22 -- | The variables live on entry to a block
  23 type CmmLive = UniqSet LocalReg
  24
  25 -- | A mapping from block labels to the variables live on entry
  26 type BlockEntryLiveness = BlockEnv CmmLive
  27
  28 -- | A mapping from block labels to the blocks that target it
  29 type BlockSources = BlockEnv (UniqSet BlockId)
  30
  31 -- | A mapping from block labels to the statements in the block
  32 type BlockStmts = BlockEnv [CmmStmt]
  33
  34 -----------------------------------------------------------------------------
  35 -- | Calculated liveness info for a list of 'CmmBasicBlock'
  36 -----------------------------------------------------------------------------
  37 cmmLiveness :: [CmmBasicBlock] -> BlockEntryLiveness
  38 cmmLiveness blocks =
  39     fixedpoint (cmmBlockDependants sources)
  40                (cmmBlockUpdate blocks')
  41                (map blockId blocks)
  42                (listToUFM [(blockId b, emptyUniqSet) | b <- blocks])
  43     where
  44       sources :: BlockSources
  45       sources = cmmBlockSources blocks
  46
  47       blocks' :: BlockStmts
  48       blocks' = listToUFM $ map block_name blocks
  49
  50       block_name :: CmmBasicBlock -> (BlockId, [CmmStmt])
  51       block_name b = (blockId b, blockStmts b)
  52
  53 {-
  54 -- For debugging, annotate each block with a comment indicating
  55 -- the calculated live variables
  56 cmmLivenessComment ::
  57     BlockEnv (UniqSet LocalReg) -> CmmBasicBlock -> CmmBasicBlock
  58 cmmLivenessComment live (BasicBlock ident stmts) =
  59     BasicBlock ident stmts' where
  60         stmts' = (CmmComment $ mkFastString $ showSDoc $ ppr $ live'):stmts
  61         live' = map CmmLocal $ uniqSetToList $ lookupWithDefaultUFM live emptyUniqSet ident
  62 -}
  63
  64
  65 -----------------------------------------------------------------------------
  66 -- | Calculates a table of where one can lookup the blocks that might
  67 -- need updating after a given block is updated in the liveness analysis
  68 -----------------------------------------------------------------------------
  69 cmmBlockSources :: [CmmBasicBlock] -> BlockSources
  70 cmmBlockSources blocks = foldr aux emptyUFM blocks
  71     where
  72       aux :: CmmBasicBlock
  73           -> BlockSources
  74           -> BlockSources
  75       aux block sourcesUFM =
  76           foldUniqSet (add_source_edges $ blockId block)
  77                       sourcesUFM
  78                       (branch_targets $ blockStmts block)
  79
  80       add_source_edges :: BlockId -> BlockId
  81                        -> BlockSources
  82                        -> BlockSources
  83       add_source_edges source target ufm =
  84           addToUFM_Acc (flip addOneToUniqSet) unitUniqSet ufm target source
  85
  86       branch_targets :: [CmmStmt] -> UniqSet BlockId
  87       branch_targets stmts =
  88           mkUniqSet $ concatMap target stmts where
  89               target (CmmBranch ident) = [ident]
  90               target (CmmCondBranch _ ident) = [ident]
  91               target (CmmSwitch _ blocks) = mapMaybe id blocks
  92               target _ = []
  93
  94 -----------------------------------------------------------------------------
  95 -- | Given the table calculated by 'cmmBlockSources', list all blocks
  96 -- that depend on the result of a particular block.
  97 --
  98 -- Used by the call to 'fixedpoint'.
  99 -----------------------------------------------------------------------------
 100 cmmBlockDependants :: BlockSources -> BlockId -> [BlockId]
 101 cmmBlockDependants sources ident =
 102     uniqSetToList $ lookupWithDefaultUFM sources emptyUniqSet ident
 103
 104 -----------------------------------------------------------------------------
 105 -- | Given the table of type 'BlockStmts' and a block that was updated,
 106 -- calculate an updated BlockEntryLiveness
 107 -----------------------------------------------------------------------------
 108 cmmBlockUpdate ::
 109     BlockStmts
 110     -> BlockId
 111     -> Maybe BlockId
 112     -> BlockEntryLiveness
 113     -> Maybe BlockEntryLiveness
 114 cmmBlockUpdate blocks node _ state =
 115     if (sizeUniqSet old_live) == (sizeUniqSet new_live)
 116       then Nothing
 117       else Just $ addToUFM state node new_live
 118     where
 119       new_live, old_live :: CmmLive
 120       new_live = cmmStmtListLive state block_stmts
 121       old_live = lookupWithDefaultUFM state missing_live node
 122
 123       block_stmts :: [CmmStmt]
 124       block_stmts = lookupWithDefaultUFM blocks missing_block node
 125
 126       missing_live = panic "unknown block id during liveness analysis"
 127       missing_block = panic "unknown block id during liveness analysis"
 128
 129 -----------------------------------------------------------------------------
 130 -- Section:
 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 cmmFormalsToLiveLocals :: CmmFormals -> [LocalReg]
 160 cmmFormalsToLiveLocals [] = []
 161 cmmFormalsToLiveLocals ((CmmGlobal _,_):args) = cmmFormalsToLiveLocals args
 162 cmmFormalsToLiveLocals ((CmmLocal r,_):args) = r:cmmFormalsToLiveLocals args
 163
 164 cmmStmtLive :: BlockEntryLiveness -> CmmStmt -> CmmLivenessTransformer
 165 cmmStmtLive _ (CmmNop) = id
 166 cmmStmtLive _ (CmmComment _) = id
 167 cmmStmtLive _ (CmmAssign reg expr) =
 168     cmmExprLive expr . reg_liveness where
 169         reg_liveness =
 170             case reg of
 171               (CmmLocal reg') -> addKilled $ unitUniqSet reg'
 172               (CmmGlobal _) -> id
 173 cmmStmtLive _ (CmmStore expr1 expr2) =
 174     cmmExprLive expr2 . cmmExprLive expr1
 175 cmmStmtLive _ (CmmCall target results arguments) =
 176     target_liveness .
 177     foldr ((.) . cmmExprLive) id (map fst arguments) .
 178     addKilled (mkUniqSet $ cmmFormalsToLiveLocals results) where
 179         target_liveness =
 180             case target of
 181               (CmmForeignCall target _) -> cmmExprLive target
 182               (CmmPrim _) -> id
 183 cmmStmtLive other_live (CmmBranch target) =
 184     addLive (lookupWithDefaultUFM other_live emptyUniqSet target)
 185 cmmStmtLive other_live (CmmCondBranch expr target) =
 186     cmmExprLive expr .
 187     addLive (lookupWithDefaultUFM other_live emptyUniqSet target)
 188 cmmStmtLive other_live (CmmSwitch expr targets) =
 189     cmmExprLive expr .
 190     (foldr ((.) . (addLive .
 191                    lookupWithDefaultUFM other_live emptyUniqSet))
 192            id
 193            (mapCatMaybes id targets))
 194 cmmStmtLive _ (CmmJump expr params) =
 195     const (cmmExprLive expr $ foldr ((.) . cmmExprLive) id (map fst params) $ emptyUniqSet)
 196 cmmStmtLive _ (CmmReturn params) =
 197     const (foldr ((.) . cmmExprLive) id (map fst params) $ emptyUniqSet)
 198
 199 --------------------------------
 200 -- Liveness of a CmmExpr
 201 --------------------------------
 202 cmmExprLive :: CmmExpr -> CmmLivenessTransformer
 203 cmmExprLive expr = addLive (mkUniqSet $ expr_liveness expr) where
 204     expr_liveness :: CmmExpr -> [LocalReg]
 205     expr_liveness (CmmLit _) = []
 206     expr_liveness (CmmLoad expr _) = expr_liveness expr
 207     expr_liveness (CmmReg reg) = reg_liveness reg
 208     expr_liveness (CmmMachOp _ exprs) = concatMap expr_liveness exprs
 209     expr_liveness (CmmRegOff reg _) = reg_liveness reg
 210
 211     reg_liveness :: CmmReg -> [LocalReg]
 212     reg_liveness (CmmLocal reg) = [reg]
 213     reg_liveness (CmmGlobal _) = []