compiler/cmm/CmmLive.hs

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