CmmLive.hs 8.32 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
5
--     http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
6
7
-- for details

8
module CmmLive (
9
10
        CmmLive,
        BlockEntryLiveness,
11
        cmmLiveness,
12
        cmmHintFormalsToLiveLocals,
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
167
cmmHintFormalsToLiveLocals :: CmmHintFormals -> [LocalReg]
cmmHintFormalsToLiveLocals formals = map fst 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
182
    target_liveness .
    foldr ((.) . cmmExprLive) id (map fst arguments) .
183
    addKilled (mkUniqSet $ cmmHintFormalsToLiveLocals 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
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
              (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 _) = []