compiler/cmm/CmmLive.hs

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