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 cmmFormalsToLiveLocals,
15 #include "HsVersions.h"
26 -----------------------------------------------------------------------------
27 -- Calculating what variables are live on entry to a basic block
28 -----------------------------------------------------------------------------
30 -- | The variables live on entry to a block
31 type CmmLive = UniqSet LocalReg
33 -- | A mapping from block labels to the variables live on entry
34 type BlockEntryLiveness = BlockEnv CmmLive
36 -- | A mapping from block labels to the blocks that target it
37 type BlockSources = BlockEnv (UniqSet BlockId)
39 -- | A mapping from block labels to the statements in the block
40 type BlockStmts = BlockEnv [CmmStmt]
42 -----------------------------------------------------------------------------
43 -- | Calculated liveness info for a list of 'CmmBasicBlock'
44 -----------------------------------------------------------------------------
45 cmmLiveness :: [CmmBasicBlock] -> BlockEntryLiveness
47 fixedpoint (cmmBlockDependants sources)
48 (cmmBlockUpdate blocks')
50 (mkBlockEnv [(blockId b, emptyUniqSet) | b <- blocks])
52 sources :: BlockSources
53 sources = cmmBlockSources blocks
56 blocks' = mkBlockEnv $ map block_name blocks
58 block_name :: CmmBasicBlock -> (BlockId, [CmmStmt])
59 block_name b = (blockId b, blockStmts b)
62 -- For debugging, annotate each block with a comment indicating
63 -- the calculated live variables
65 BlockEnv (UniqSet LocalReg) -> CmmBasicBlock -> CmmBasicBlock
66 cmmLivenessComment live (BasicBlock ident stmts) =
67 BasicBlock ident stmts' where
68 stmts' = (CmmComment $ mkFastString $ showSDoc $ ppr $ live'):stmts
69 live' = map CmmLocal $ uniqSetToList $ lookupWithDefaultUFM live emptyUniqSet ident
73 -----------------------------------------------------------------------------
74 -- | Calculates a table of where one can lookup the blocks that might
75 -- need updating after a given block is updated in the liveness analysis
76 -----------------------------------------------------------------------------
77 cmmBlockSources :: [CmmBasicBlock] -> BlockSources
78 cmmBlockSources blocks = foldr aux emptyBlockEnv blocks
83 aux block sourcesUFM =
84 foldUniqSet (add_source_edges $ blockId block)
86 (branch_targets $ blockStmts block)
88 add_source_edges :: BlockId -> BlockId
91 add_source_edges source target ufm =
92 addToBEnv_Acc (flip addOneToUniqSet) unitUniqSet ufm target source
94 branch_targets :: [CmmStmt] -> UniqSet BlockId
95 branch_targets stmts =
96 mkUniqSet $ concatMap target stmts where
97 target (CmmBranch ident) = [ident]
98 target (CmmCondBranch _ ident) = [ident]
99 target (CmmSwitch _ blocks) = mapMaybe id blocks
102 -----------------------------------------------------------------------------
103 -- | Given the table calculated by 'cmmBlockSources', list all blocks
104 -- that depend on the result of a particular block.
106 -- Used by the call to 'fixedpoint'.
107 -----------------------------------------------------------------------------
108 cmmBlockDependants :: BlockSources -> BlockId -> [BlockId]
109 cmmBlockDependants sources ident =
110 uniqSetToList $ lookupWithDefaultBEnv sources emptyUniqSet ident
112 -----------------------------------------------------------------------------
113 -- | Given the table of type 'BlockStmts' and a block that was updated,
114 -- calculate an updated BlockEntryLiveness
115 -----------------------------------------------------------------------------
120 -> BlockEntryLiveness
121 -> Maybe BlockEntryLiveness
122 cmmBlockUpdate blocks node _ state =
123 if (sizeUniqSet old_live) == (sizeUniqSet new_live)
125 else Just $ extendBlockEnv state node new_live
127 new_live, old_live :: CmmLive
128 new_live = cmmStmtListLive state block_stmts
129 old_live = lookupWithDefaultBEnv state missing_live node
131 block_stmts :: [CmmStmt]
132 block_stmts = lookupWithDefaultBEnv blocks missing_block node
134 missing_live = panic "unknown block id during liveness analysis"
135 missing_block = panic "unknown block id during liveness analysis"
137 -----------------------------------------------------------------------------
139 -----------------------------------------------------------------------------
140 -----------------------------------------------------------------------------
141 -- CmmBlockLive, cmmStmtListLive and helpers
142 -----------------------------------------------------------------------------
144 -- Calculate the live registers for a local block (list of statements)
146 cmmStmtListLive :: BlockEntryLiveness -> [CmmStmt] -> CmmLive
147 cmmStmtListLive other_live stmts =
148 foldr ((.) . (cmmStmtLive other_live)) id stmts emptyUniqSet
150 -----------------------------------------------------------------------------
151 -- This code is written in the style of a state monad,
152 -- but since Control.Monad.State is not in the core
153 -- we can't use it in GHC, so we'll fake one here.
154 -- We don't need a return value so well leave it out.
155 -- Thus 'bind' reduces to function composition.
157 type CmmLivenessTransformer = CmmLive -> CmmLive
159 -- Helpers for the "Monad"
160 addLive, addKilled :: CmmLive -> CmmLivenessTransformer
161 addLive new_live live = live `unionUniqSets` new_live
162 addKilled new_killed live = live `minusUniqSet` new_killed
164 --------------------------------
165 -- Liveness of a CmmStmt
166 --------------------------------
167 cmmFormalsToLiveLocals :: HintedCmmFormals -> [LocalReg]
168 cmmFormalsToLiveLocals formals = map hintlessCmm formals
170 cmmStmtLive :: BlockEntryLiveness -> CmmStmt -> CmmLivenessTransformer
171 cmmStmtLive _ (CmmNop) = id
172 cmmStmtLive _ (CmmComment _) = id
173 cmmStmtLive _ (CmmAssign reg expr) =
174 cmmExprLive expr . reg_liveness where
177 (CmmLocal reg') -> addKilled $ unitUniqSet reg'
179 cmmStmtLive _ (CmmStore expr1 expr2) =
180 cmmExprLive expr2 . cmmExprLive expr1
181 cmmStmtLive _ (CmmCall target results arguments _ _) =
183 foldr ((.) . cmmExprLive) id (map hintlessCmm arguments) .
184 addKilled (mkUniqSet $ cmmFormalsToLiveLocals results) where
187 (CmmCallee target _) -> cmmExprLive target
189 cmmStmtLive other_live (CmmBranch target) =
190 addLive (lookupWithDefaultBEnv other_live emptyUniqSet target)
191 cmmStmtLive other_live (CmmCondBranch expr target) =
193 addLive (lookupWithDefaultBEnv other_live emptyUniqSet target)
194 cmmStmtLive other_live (CmmSwitch expr targets) =
196 (foldr ((.) . (addLive .
197 lookupWithDefaultBEnv other_live emptyUniqSet))
199 (mapCatMaybes id targets))
200 cmmStmtLive _ (CmmJump expr params) =
201 const (cmmExprLive expr $ foldr ((.) . cmmExprLive) id (map hintlessCmm params) $ emptyUniqSet)
202 cmmStmtLive _ (CmmReturn params) =
203 const (foldr ((.) . cmmExprLive) id (map hintlessCmm params) $ emptyUniqSet)
205 --------------------------------
206 -- Liveness of a CmmExpr
207 --------------------------------
208 cmmExprLive :: CmmExpr -> CmmLivenessTransformer
209 cmmExprLive expr = addLive (mkUniqSet $ expr_liveness expr) where
210 expr_liveness :: CmmExpr -> [LocalReg]
211 expr_liveness (CmmLit _) = []
212 expr_liveness (CmmLoad expr _) = expr_liveness expr
213 expr_liveness (CmmReg reg) = reg_liveness reg
214 expr_liveness (CmmMachOp _ exprs) = concatMap expr_liveness exprs
215 expr_liveness (CmmRegOff reg _) = reg_liveness reg
217 reg_liveness :: CmmReg -> [LocalReg]
218 reg_liveness (CmmLocal reg) = [reg]
219 reg_liveness (CmmGlobal _) = []