CmmLive.hs 8.16 KB
Newer Older
1
module CmmLive (
2 3
        CmmLive,
        BlockEntryLiveness,
4
        cmmLiveness,
5
        cmmFormalsToLiveLocals,
6 7
  ) where

8 9
#include "HsVersions.h"

10
import BlockId
11 12 13 14 15 16 17 18 19 20 21
import Cmm
import Dataflow

import Maybes
import Panic
import UniqSet

-----------------------------------------------------------------------------
-- Calculating what variables are live on entry to a basic block
-----------------------------------------------------------------------------

22
-- | The variables live on entry to a block
23 24
type CmmLive = UniqSet LocalReg

25
-- | A mapping from block labels to the variables live on entry
26 27
type BlockEntryLiveness = BlockEnv CmmLive

28 29 30 31 32 33
-- | A mapping from block labels to the blocks that target it
type BlockSources = BlockEnv (UniqSet BlockId)

-- | A mapping from block labels to the statements in the block
type BlockStmts = BlockEnv [CmmStmt]

34
-----------------------------------------------------------------------------
35
-- | Calculated liveness info for a list of 'CmmBasicBlock'
36 37 38 39 40 41
-----------------------------------------------------------------------------
cmmLiveness :: [CmmBasicBlock] -> BlockEntryLiveness
cmmLiveness blocks =
    fixedpoint (cmmBlockDependants sources)
               (cmmBlockUpdate blocks')
               (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 51

      block_name :: CmmBasicBlock -> (BlockId, [CmmStmt])
      block_name b = (blockId b, blockStmts b)
52 53 54 55 56 57 58 59 60 61 62 63 64

{-
-- For debugging, annotate each block with a comment indicating
-- the calculated live variables
cmmLivenessComment ::
    BlockEnv (UniqSet LocalReg) -> CmmBasicBlock -> CmmBasicBlock
cmmLivenessComment live (BasicBlock ident stmts) =
    BasicBlock ident stmts' where
        stmts' = (CmmComment $ mkFastString $ showSDoc $ ppr $ live'):stmts
        live' = map CmmLocal $ uniqSetToList $ lookupWithDefaultUFM live emptyUniqSet ident
-}


65 66 67 68 69
-----------------------------------------------------------------------------
-- | Calculates a table of where one can lookup the blocks that might
-- need updating after a given block is updated in the liveness analysis
-----------------------------------------------------------------------------
cmmBlockSources :: [CmmBasicBlock] -> BlockSources
70
cmmBlockSources blocks = foldr aux emptyBlockEnv blocks
71 72
    where
      aux :: CmmBasicBlock
73 74
          -> BlockSources
          -> BlockSources
75 76 77 78 79 80
      aux block sourcesUFM =
          foldUniqSet (add_source_edges $ blockId block)
                      sourcesUFM
                      (branch_targets $ blockStmts block)

      add_source_edges :: BlockId -> BlockId
81 82
                       -> BlockSources
                       -> BlockSources
83
      add_source_edges source target ufm =
84
          addToBEnv_Acc (flip addOneToUniqSet) unitUniqSet ufm target source
85 86 87 88 89 90 91 92 93

      branch_targets :: [CmmStmt] -> UniqSet BlockId
      branch_targets stmts =
          mkUniqSet $ concatMap target stmts where
              target (CmmBranch ident) = [ident]
              target (CmmCondBranch _ ident) = [ident]
              target (CmmSwitch _ blocks) = mapMaybe id blocks
              target _ = []

94 95 96
-----------------------------------------------------------------------------
-- | Given the table calculated by 'cmmBlockSources', list all blocks
-- that depend on the result of a particular block.
97
--
98 99 100
-- Used by the call to 'fixedpoint'.
-----------------------------------------------------------------------------
cmmBlockDependants :: BlockSources -> BlockId -> [BlockId]
101
cmmBlockDependants sources ident =
102
    uniqSetToList $ lookupWithDefaultBEnv sources emptyUniqSet ident
103

104 105 106 107
-----------------------------------------------------------------------------
-- | Given the table of type 'BlockStmts' and a block that was updated,
-- calculate an updated BlockEntryLiveness
-----------------------------------------------------------------------------
108
cmmBlockUpdate ::
109
    BlockStmts
110 111 112 113 114 115 116
    -> BlockId
    -> Maybe BlockId
    -> BlockEntryLiveness
    -> Maybe BlockEntryLiveness
cmmBlockUpdate blocks node _ state =
    if (sizeUniqSet old_live) == (sizeUniqSet new_live)
      then Nothing
117
      else Just $ extendBlockEnv state node new_live
118
    where
119 120
      new_live, old_live :: CmmLive
      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 127 128
      missing_live = panic "unknown block id during liveness analysis"
      missing_block = panic "unknown block id during liveness analysis"

129 130
-----------------------------------------------------------------------------
-- Section: 
131
-----------------------------------------------------------------------------
132
-----------------------------------------------------------------------------
133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158
-- CmmBlockLive, cmmStmtListLive and helpers
-----------------------------------------------------------------------------

-- Calculate the live registers for a local block (list of statements)

cmmStmtListLive :: BlockEntryLiveness -> [CmmStmt] -> CmmLive
cmmStmtListLive other_live stmts =
    foldr ((.) . (cmmStmtLive other_live)) id stmts emptyUniqSet

-----------------------------------------------------------------------------
-- This code is written in the style of a state monad,
-- but since Control.Monad.State is not in the core
-- we can't use it in GHC, so we'll fake one here.
-- We don't need a return value so well leave it out.
-- Thus 'bind' reduces to function composition.

type CmmLivenessTransformer = CmmLive -> CmmLive

-- Helpers for the "Monad"
addLive, addKilled :: CmmLive -> CmmLivenessTransformer
addLive new_live live = live `unionUniqSets` new_live
addKilled new_killed live = live `minusUniqSet` new_killed

--------------------------------
-- Liveness of a CmmStmt
--------------------------------
159 160
cmmFormalsToLiveLocals :: HintedCmmFormals -> [LocalReg]
cmmFormalsToLiveLocals formals = map hintlessCmm formals
161

162 163 164 165 166 167 168 169 170 171 172
cmmStmtLive :: BlockEntryLiveness -> CmmStmt -> CmmLivenessTransformer
cmmStmtLive _ (CmmNop) = id
cmmStmtLive _ (CmmComment _) = id
cmmStmtLive _ (CmmAssign reg expr) =
    cmmExprLive expr . reg_liveness where
        reg_liveness =
            case reg of
              (CmmLocal reg') -> addKilled $ unitUniqSet reg'
              (CmmGlobal _) -> id
cmmStmtLive _ (CmmStore expr1 expr2) =
    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 178
        target_liveness =
            case target of
179
              (CmmCallee target _) -> cmmExprLive target
180 181
              (CmmPrim _) -> id
cmmStmtLive other_live (CmmBranch target) =
182
    addLive (lookupWithDefaultBEnv other_live emptyUniqSet target)
183 184
cmmStmtLive other_live (CmmCondBranch expr target) =
    cmmExprLive expr .
185
    addLive (lookupWithDefaultBEnv other_live emptyUniqSet target)
186 187 188
cmmStmtLive other_live (CmmSwitch expr targets) =
    cmmExprLive expr .
    (foldr ((.) . (addLive .
189
                   lookupWithDefaultBEnv other_live emptyUniqSet))
190 191 192
           id
           (mapCatMaybes id targets))
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 199 200 201 202 203 204 205 206 207

--------------------------------
-- Liveness of a CmmExpr
--------------------------------
cmmExprLive :: CmmExpr -> CmmLivenessTransformer
cmmExprLive expr = addLive (mkUniqSet $ expr_liveness expr) where
    expr_liveness :: CmmExpr -> [LocalReg]
    expr_liveness (CmmLit _) = []
    expr_liveness (CmmLoad expr _) = expr_liveness expr
    expr_liveness (CmmReg reg) = reg_liveness reg
    expr_liveness (CmmMachOp _ exprs) = concatMap expr_liveness exprs
    expr_liveness (CmmRegOff reg _) = reg_liveness reg
Ian Lynagh's avatar
Ian Lynagh committed
208
    expr_liveness (CmmStackSlot _ _) = panic "cmmExprLive CmmStackSlot"
209 210 211 212

    reg_liveness :: CmmReg -> [LocalReg]
    reg_liveness (CmmLocal reg) = [reg]
    reg_liveness (CmmGlobal _) = []