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

8
9
#include "HsVersions.h"

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

import Maybes
import Panic
import UniqFM
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
42
43
-----------------------------------------------------------------------------
cmmLiveness :: [CmmBasicBlock] -> BlockEntryLiveness
cmmLiveness blocks =
    fixedpoint (cmmBlockDependants sources)
               (cmmBlockUpdate blocks')
               (map blockId blocks)
               (listToUFM [(blockId b, emptyUniqSet) | b <- blocks])
    where
44
      sources :: BlockSources
45
      sources = cmmBlockSources blocks
46
47
48
49
50
51

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

      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
71
72
cmmBlockSources blocks = foldr aux emptyUFM blocks
    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
84
85
86
87
88
89
90
91
92
93
      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 _ = []

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
102
103
cmmBlockDependants sources ident =
    uniqSetToList $ lookupWithDefaultUFM sources emptyUniqSet ident

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
117
118
    -> 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
119
120
      new_live, old_live :: CmmLive
      new_live = cmmStmtListLive state block_stmts
121
      old_live = lookupWithDefaultUFM state missing_live node
122
123
124
125

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

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
cmmHintFormalsToLiveLocals :: CmmHintFormals -> [LocalReg]
cmmHintFormalsToLiveLocals formals = map fst 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
175
    target_liveness .
    foldr ((.) . cmmExprLive) id (map fst arguments) .
176
    addKilled (mkUniqSet $ cmmHintFormalsToLiveLocals results) where
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
        target_liveness =
            case target of
              (CmmForeignCall target _) -> cmmExprLive target
              (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) =
    const (cmmExprLive expr $ foldr ((.) . cmmExprLive) id (map fst params) $ emptyUniqSet)
cmmStmtLive _ (CmmReturn params) =
    const (foldr ((.) . cmmExprLive) id (map fst params) $ emptyUniqSet)

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