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 BlockId
  11 import Cmm
  12 import Dataflow
  13
  14 import Maybes
  15 import Panic
  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                (mkBlockEnv [(blockId b, emptyUniqSet) | b <- blocks])
  43     where
  44       sources :: BlockSources
  45       sources = cmmBlockSources blocks
  46
  47       blocks' :: BlockStmts
  48       blocks' = mkBlockEnv $ 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 emptyBlockEnv 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           addToBEnv_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 $ lookupWithDefaultBEnv 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 $ extendBlockEnv state node new_live
 118     where
 119       new_live, old_live :: CmmLive
 120       new_live = cmmStmtListLive state block_stmts
 121       old_live = lookupWithDefaultBEnv state missing_live node
 122
 123       block_stmts :: [CmmStmt]
 124       block_stmts = lookupWithDefaultBEnv 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 :: HintedCmmFormals -> [LocalReg]
 160 cmmFormalsToLiveLocals formals = map hintlessCmm formals
 161
 162 cmmStmtLive :: BlockEntryLiveness -> CmmStmt -> CmmLivenessTransformer
 163 cmmStmtLive _ (CmmNop) = id
 164 cmmStmtLive _ (CmmComment _) = id
 165 cmmStmtLive _ (CmmAssign reg expr) =
 166     cmmExprLive expr . reg_liveness where
 167         reg_liveness =
 168             case reg of
 169               (CmmLocal reg') -> addKilled $ unitUniqSet reg'
 170               (CmmGlobal _) -> id
 171 cmmStmtLive _ (CmmStore expr1 expr2) =
 172     cmmExprLive expr2 . cmmExprLive expr1
 173 cmmStmtLive _ (CmmCall target results arguments _ _) =
 174     target_liveness .
 175     foldr ((.) . cmmExprLive) id (map hintlessCmm arguments) .
 176     addKilled (mkUniqSet $ cmmFormalsToLiveLocals results) where
 177         target_liveness =
 178             case target of
 179               (CmmCallee target _) -> cmmExprLive target
 180               (CmmPrim _) -> id
 181 cmmStmtLive other_live (CmmBranch target) =
 182     addLive (lookupWithDefaultBEnv other_live emptyUniqSet target)
 183 cmmStmtLive other_live (CmmCondBranch expr target) =
 184     cmmExprLive expr .
 185     addLive (lookupWithDefaultBEnv other_live emptyUniqSet target)
 186 cmmStmtLive other_live (CmmSwitch expr targets) =
 187     cmmExprLive expr .
 188     (foldr ((.) . (addLive .
 189                    lookupWithDefaultBEnv other_live emptyUniqSet))
 190            id
 191            (mapCatMaybes id targets))
 192 cmmStmtLive _ (CmmJump expr params) =
 193     const (cmmExprLive expr $ foldr ((.) . cmmExprLive) id (map hintlessCmm params) $ emptyUniqSet)
 194 cmmStmtLive _ (CmmReturn params) =
 195     const (foldr ((.) . cmmExprLive) id (map hintlessCmm 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     expr_liveness (CmmStackSlot _ _) = panic "cmmExprLive CmmStackSlot"
 209
 210     reg_liveness :: CmmReg -> [LocalReg]
 211     reg_liveness (CmmLocal reg) = [reg]
 212     reg_liveness (CmmGlobal _) = []