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/Commentary/CodingStyle#Warnings
12 cmmHintFormalsToLiveLocals,
15 #include "HsVersions.h"
25 -----------------------------------------------------------------------------
26 -- Calculating what variables are live on entry to a basic block
27 -----------------------------------------------------------------------------
29 -- | The variables live on entry to a block
30 type CmmLive = UniqSet LocalReg
32 -- | A mapping from block labels to the variables live on entry
33 type BlockEntryLiveness = BlockEnv CmmLive
35 -- | A mapping from block labels to the blocks that target it
36 type BlockSources = BlockEnv (UniqSet BlockId)
38 -- | A mapping from block labels to the statements in the block
39 type BlockStmts = BlockEnv [CmmStmt]
41 -----------------------------------------------------------------------------
42 -- | Calculated liveness info for a list of 'CmmBasicBlock'
43 -----------------------------------------------------------------------------
44 cmmLiveness :: [CmmBasicBlock] -> BlockEntryLiveness
46 fixedpoint (cmmBlockDependants sources)
47 (cmmBlockUpdate blocks')
49 (listToUFM [(blockId b, emptyUniqSet) | b <- blocks])
51 sources :: BlockSources
52 sources = cmmBlockSources blocks
55 blocks' = listToUFM $ map block_name blocks
57 block_name :: CmmBasicBlock -> (BlockId, [CmmStmt])
58 block_name b = (blockId b, blockStmts b)
61 -- For debugging, annotate each block with a comment indicating
62 -- the calculated live variables
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
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
82 aux block sourcesUFM =
83 foldUniqSet (add_source_edges $ blockId block)
85 (branch_targets $ blockStmts block)
87 add_source_edges :: BlockId -> BlockId
90 add_source_edges source target ufm =
91 addToUFM_Acc (flip addOneToUniqSet) unitUniqSet ufm target source
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
101 -----------------------------------------------------------------------------
102 -- | Given the table calculated by 'cmmBlockSources', list all blocks
103 -- that depend on the result of a particular block.
105 -- Used by the call to 'fixedpoint'.
106 -----------------------------------------------------------------------------
107 cmmBlockDependants :: BlockSources -> BlockId -> [BlockId]
108 cmmBlockDependants sources ident =
109 uniqSetToList $ lookupWithDefaultUFM sources emptyUniqSet ident
111 -----------------------------------------------------------------------------
112 -- | Given the table of type 'BlockStmts' and a block that was updated,
113 -- calculate an updated BlockEntryLiveness
114 -----------------------------------------------------------------------------
119 -> BlockEntryLiveness
120 -> Maybe BlockEntryLiveness
121 cmmBlockUpdate blocks node _ state =
122 if (sizeUniqSet old_live) == (sizeUniqSet new_live)
124 else Just $ addToUFM state node new_live
126 new_live, old_live :: CmmLive
127 new_live = cmmStmtListLive state block_stmts
128 old_live = lookupWithDefaultUFM state missing_live node
130 block_stmts :: [CmmStmt]
131 block_stmts = lookupWithDefaultUFM blocks missing_block node
133 missing_live = panic "unknown block id during liveness analysis"
134 missing_block = panic "unknown block id during liveness analysis"
136 -----------------------------------------------------------------------------
138 -----------------------------------------------------------------------------
139 -----------------------------------------------------------------------------
140 -- CmmBlockLive, cmmStmtListLive and helpers
141 -----------------------------------------------------------------------------
143 -- Calculate the live registers for a local block (list of statements)
145 cmmStmtListLive :: BlockEntryLiveness -> [CmmStmt] -> CmmLive
146 cmmStmtListLive other_live stmts =
147 foldr ((.) . (cmmStmtLive other_live)) id stmts emptyUniqSet
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.
156 type CmmLivenessTransformer = CmmLive -> CmmLive
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
163 --------------------------------
164 -- Liveness of a CmmStmt
165 --------------------------------
166 cmmHintFormalsToLiveLocals :: CmmHintFormals -> [LocalReg]
167 cmmHintFormalsToLiveLocals formals = map fst formals
169 cmmStmtLive :: BlockEntryLiveness -> CmmStmt -> CmmLivenessTransformer
170 cmmStmtLive _ (CmmNop) = id
171 cmmStmtLive _ (CmmComment _) = id
172 cmmStmtLive _ (CmmAssign reg expr) =
173 cmmExprLive expr . reg_liveness where
176 (CmmLocal reg') -> addKilled $ unitUniqSet reg'
178 cmmStmtLive _ (CmmStore expr1 expr2) =
179 cmmExprLive expr2 . cmmExprLive expr1
180 cmmStmtLive _ (CmmCall target results arguments _ _) =
182 foldr ((.) . cmmExprLive) id (map fst arguments) .
183 addKilled (mkUniqSet $ cmmHintFormalsToLiveLocals results) where
186 (CmmCallee target _) -> cmmExprLive target
188 cmmStmtLive other_live (CmmBranch target) =
189 addLive (lookupWithDefaultUFM other_live emptyUniqSet target)
190 cmmStmtLive other_live (CmmCondBranch expr target) =
192 addLive (lookupWithDefaultUFM other_live emptyUniqSet target)
193 cmmStmtLive other_live (CmmSwitch expr targets) =
195 (foldr ((.) . (addLive .
196 lookupWithDefaultUFM other_live emptyUniqSet))
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)
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
216 reg_liveness :: CmmReg -> [LocalReg]
217 reg_liveness (CmmLocal reg) = [reg]
218 reg_liveness (CmmGlobal _) = []