compiler/cmm/CmmLive.hs

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