CmmLive.hs 8.34 KB
Newer Older
1
{-# OPTIONS -w #-}
2 3 4
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
Ian Lynagh's avatar
Ian Lynagh committed
5
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
6 7
-- for details

8
module CmmLive (
9 10
        CmmLive,
        BlockEntryLiveness,
11
        cmmLiveness,
12
        cmmFormalsToLiveLocals,
13 14
  ) where

15 16
#include "HsVersions.h"

17 18 19 20 21 22 23 24 25 26 27 28
import Cmm
import Dataflow

import Maybes
import Panic
import UniqFM
import UniqSet

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

29
-- | The variables live on entry to a block
30 31
type CmmLive = UniqSet LocalReg

32
-- | A mapping from block labels to the variables live on entry
33 34
type BlockEntryLiveness = BlockEnv CmmLive

35 36 37 38 39 40
-- | 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]

41
-----------------------------------------------------------------------------
42
-- | Calculated liveness info for a list of 'CmmBasicBlock'
43 44 45 46 47 48 49 50
-----------------------------------------------------------------------------
cmmLiveness :: [CmmBasicBlock] -> BlockEntryLiveness
cmmLiveness blocks =
    fixedpoint (cmmBlockDependants sources)
               (cmmBlockUpdate blocks')
               (map blockId blocks)
               (listToUFM [(blockId b, emptyUniqSet) | b <- blocks])
    where
51
      sources :: BlockSources
52
      sources = cmmBlockSources blocks
53 54 55 56 57 58

      blocks' :: BlockStmts
      blocks' = listToUFM $ map block_name blocks

      block_name :: CmmBasicBlock -> (BlockId, [CmmStmt])
      block_name b = (blockId b, blockStmts b)
59 60 61 62 63 64 65 66 67 68 69 70 71

{-
-- 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
-}


72 73 74 75 76
-----------------------------------------------------------------------------
-- | 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
77 78 79
cmmBlockSources blocks = foldr aux emptyUFM blocks
    where
      aux :: CmmBasicBlock
80 81
          -> BlockSources
          -> BlockSources
82 83 84 85 86 87
      aux block sourcesUFM =
          foldUniqSet (add_source_edges $ blockId block)
                      sourcesUFM
                      (branch_targets $ blockStmts block)

      add_source_edges :: BlockId -> BlockId
88 89
                       -> BlockSources
                       -> BlockSources
90 91 92 93 94 95 96 97 98 99 100
      add_source_edges source target ufm =
          addToUFM_Acc (flip addOneToUniqSet) unitUniqSet ufm target source

      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 _ = []

101 102 103
-----------------------------------------------------------------------------
-- | Given the table calculated by 'cmmBlockSources', list all blocks
-- that depend on the result of a particular block.
104
--
105 106 107
-- Used by the call to 'fixedpoint'.
-----------------------------------------------------------------------------
cmmBlockDependants :: BlockSources -> BlockId -> [BlockId]
108 109 110
cmmBlockDependants sources ident =
    uniqSetToList $ lookupWithDefaultUFM sources emptyUniqSet ident

111 112 113 114
-----------------------------------------------------------------------------
-- | Given the table of type 'BlockStmts' and a block that was updated,
-- calculate an updated BlockEntryLiveness
-----------------------------------------------------------------------------
115
cmmBlockUpdate ::
116
    BlockStmts
117 118 119 120 121 122 123 124 125
    -> BlockId
    -> Maybe BlockId
    -> BlockEntryLiveness
    -> Maybe BlockEntryLiveness
cmmBlockUpdate blocks node _ state =
    if (sizeUniqSet old_live) == (sizeUniqSet new_live)
      then Nothing
      else Just $ addToUFM state node new_live
    where
126 127
      new_live, old_live :: CmmLive
      new_live = cmmStmtListLive state block_stmts
128
      old_live = lookupWithDefaultUFM state missing_live node
129 130 131 132

      block_stmts :: [CmmStmt]
      block_stmts = lookupWithDefaultUFM blocks missing_block node

133 134 135
      missing_live = panic "unknown block id during liveness analysis"
      missing_block = panic "unknown block id during liveness analysis"

136 137
-----------------------------------------------------------------------------
-- Section: 
138
-----------------------------------------------------------------------------
139
-----------------------------------------------------------------------------
140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165
-- 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
--------------------------------
166
cmmFormalsToLiveLocals :: CmmFormals -> [LocalReg]
167
cmmFormalsToLiveLocals formals = map kindlessCmm formals
168

169 170 171 172 173 174 175 176 177 178 179
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
180
cmmStmtLive _ (CmmCall target results arguments _ _) =
181
    target_liveness .
182
    foldr ((.) . cmmExprLive) id (map kindlessCmm arguments) .
183
    addKilled (mkUniqSet $ cmmFormalsToLiveLocals results) where
184 185
        target_liveness =
            case target of
186
              (CmmCallee target _) -> cmmExprLive target
187 188 189 190 191 192 193 194 195 196 197 198 199
              (CmmPrim _) -> id
cmmStmtLive other_live (CmmBranch target) =
    addLive (lookupWithDefaultUFM other_live emptyUniqSet target)
cmmStmtLive other_live (CmmCondBranch expr target) =
    cmmExprLive expr .
    addLive (lookupWithDefaultUFM other_live emptyUniqSet target)
cmmStmtLive other_live (CmmSwitch expr targets) =
    cmmExprLive expr .
    (foldr ((.) . (addLive .
                   lookupWithDefaultUFM other_live emptyUniqSet))
           id
           (mapCatMaybes id targets))
cmmStmtLive _ (CmmJump expr params) =
200
    const (cmmExprLive expr $ foldr ((.) . cmmExprLive) id (map kindlessCmm params) $ emptyUniqSet)
201
cmmStmtLive _ (CmmReturn params) =
202
    const (foldr ((.) . cmmExprLive) id (map kindlessCmm params) $ emptyUniqSet)
203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218

--------------------------------
-- 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

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