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