module CmmLive (
- CmmLive, BlockEntryLiveness,
+ CmmLive,
+ BlockEntryLiveness,
cmmLiveness,
- cmmFormalsToLiveLocals
+ cmmFormalsToLiveLocals,
) where
+#include "HsVersions.h"
+
+import BlockId
import Cmm
import Dataflow
import Maybes
import Panic
-import UniqFM
import UniqSet
-import Data.List
-
-----------------------------------------------------------------------------
-- Calculating what variables are live on entry to a basic block
-----------------------------------------------------------------------------
--- The variables live on entry to a block
+-- | The variables live on entry to a block
type CmmLive = UniqSet LocalReg
--- A mapping from block labels to the variables live on entry
+-- | A mapping from block labels to the variables live on entry
type BlockEntryLiveness = BlockEnv CmmLive
+-- | 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]
+
-----------------------------------------------------------------------------
--- cmmLiveness and helpers
+-- | Calculated liveness info for a list of 'CmmBasicBlock'
-----------------------------------------------------------------------------
cmmLiveness :: [CmmBasicBlock] -> BlockEntryLiveness
cmmLiveness blocks =
fixedpoint (cmmBlockDependants sources)
(cmmBlockUpdate blocks')
(map blockId blocks)
- (listToUFM [(blockId b, emptyUniqSet) | b <- blocks])
+ (mkBlockEnv [(blockId b, emptyUniqSet) | b <- blocks])
where
+ sources :: BlockSources
sources = cmmBlockSources blocks
- blocks' = cmmBlockNames blocks
+
+ blocks' :: BlockStmts
+ blocks' = mkBlockEnv $ map block_name blocks
+
+ block_name :: CmmBasicBlock -> (BlockId, [CmmStmt])
+ block_name b = (blockId b, blockStmts b)
{-
-- For debugging, annotate each block with a comment indicating
-}
---------------------------------
--- cmmBlockSources
---
--- Calculates a table of blocks
--- that might need updating after
--- a given block is updated
---------------------------------
-cmmBlockSources :: [CmmBasicBlock] -> BlockEnv (UniqSet BlockId)
-cmmBlockSources blocks = foldr aux emptyUFM blocks
+-----------------------------------------------------------------------------
+-- | 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
+cmmBlockSources blocks = foldr aux emptyBlockEnv blocks
where
aux :: CmmBasicBlock
- -> BlockEnv (UniqSet BlockId)
- -> BlockEnv (UniqSet BlockId)
+ -> BlockSources
+ -> BlockSources
aux block sourcesUFM =
foldUniqSet (add_source_edges $ blockId block)
sourcesUFM
(branch_targets $ blockStmts block)
add_source_edges :: BlockId -> BlockId
- -> BlockEnv (UniqSet BlockId)
- -> BlockEnv (UniqSet BlockId)
+ -> BlockSources
+ -> BlockSources
add_source_edges source target ufm =
- addToUFM_Acc (flip addOneToUniqSet) unitUniqSet ufm target source
+ addToBEnv_Acc (flip addOneToUniqSet) unitUniqSet ufm target source
branch_targets :: [CmmStmt] -> UniqSet BlockId
branch_targets stmts =
target (CmmSwitch _ blocks) = mapMaybe id blocks
target _ = []
---------------------------------
--- cmmBlockNames
---
--- Calculates a table that maps
--- block names to the list
--- of statements inside them
---------------------------------
-cmmBlockNames :: [CmmBasicBlock] -> BlockEnv [CmmStmt]
-cmmBlockNames blocks = listToUFM $ map block_name blocks where
- block_name b = (blockId b, blockStmts b)
-
---------------------------------
--- cmmBlockDependants
+-----------------------------------------------------------------------------
+-- | Given the table calculated by 'cmmBlockSources', list all blocks
+-- that depend on the result of a particular block.
--
--- Given the table calculated
--- by cmmBlockSources created,
--- list all blocks that depend
--- on the result of a particular
--- block.
---------------------------------
-cmmBlockDependants :: BlockEnv (UniqSet BlockId) -> BlockId -> [BlockId]
+-- Used by the call to 'fixedpoint'.
+-----------------------------------------------------------------------------
+cmmBlockDependants :: BlockSources -> BlockId -> [BlockId]
cmmBlockDependants sources ident =
- uniqSetToList $ lookupWithDefaultUFM sources emptyUniqSet ident
+ uniqSetToList $ lookupWithDefaultBEnv sources emptyUniqSet ident
---------------------------------
--- cmmBlockUpdate
---
--- Given the table from
--- cmmBlockNames and a block
--- that was updated, calculate
--- an updated BlockEntryLiveness
---------------------------------
+-----------------------------------------------------------------------------
+-- | Given the table of type 'BlockStmts' and a block that was updated,
+-- calculate an updated BlockEntryLiveness
+-----------------------------------------------------------------------------
cmmBlockUpdate ::
- BlockEnv [CmmStmt]
+ BlockStmts
-> BlockId
-> Maybe BlockId
-> BlockEntryLiveness
cmmBlockUpdate blocks node _ state =
if (sizeUniqSet old_live) == (sizeUniqSet new_live)
then Nothing
- else Just $ addToUFM state node new_live
+ else Just $ extendBlockEnv state node new_live
where
- new_live = cmmStmtListLive state block
- old_live = lookupWithDefaultUFM state missing_live node
- block = lookupWithDefaultUFM blocks missing_block node
+ new_live, old_live :: CmmLive
+ new_live = cmmStmtListLive state block_stmts
+ old_live = lookupWithDefaultBEnv state missing_live node
+
+ block_stmts :: [CmmStmt]
+ block_stmts = lookupWithDefaultBEnv blocks missing_block node
+
missing_live = panic "unknown block id during liveness analysis"
missing_block = panic "unknown block id during liveness analysis"
-----------------------------------------------------------------------------
+-- Section:
+-----------------------------------------------------------------------------
+-----------------------------------------------------------------------------
-- CmmBlockLive, cmmStmtListLive and helpers
-----------------------------------------------------------------------------
--------------------------------
-- Liveness of a CmmStmt
--------------------------------
-cmmFormalsToLiveLocals :: CmmFormals -> [LocalReg]
-cmmFormalsToLiveLocals [] = []
-cmmFormalsToLiveLocals ((CmmGlobal _,_):args) = cmmFormalsToLiveLocals args
-cmmFormalsToLiveLocals ((CmmLocal r,_):args) = r:cmmFormalsToLiveLocals args
+cmmFormalsToLiveLocals :: HintedCmmFormals -> [LocalReg]
+cmmFormalsToLiveLocals formals = map hintlessCmm formals
cmmStmtLive :: BlockEntryLiveness -> CmmStmt -> CmmLivenessTransformer
cmmStmtLive _ (CmmNop) = id
(CmmGlobal _) -> id
cmmStmtLive _ (CmmStore expr1 expr2) =
cmmExprLive expr2 . cmmExprLive expr1
-cmmStmtLive _ (CmmCall target results arguments _) =
+cmmStmtLive _ (CmmCall target results arguments _ _) =
target_liveness .
- foldr ((.) . cmmExprLive) id (map fst arguments) .
+ foldr ((.) . cmmExprLive) id (map hintlessCmm arguments) .
addKilled (mkUniqSet $ cmmFormalsToLiveLocals results) where
target_liveness =
case target of
- (CmmForeignCall target _) -> cmmExprLive target
+ (CmmCallee target _) -> cmmExprLive target
(CmmPrim _) -> id
cmmStmtLive other_live (CmmBranch target) =
- addLive (lookupWithDefaultUFM other_live emptyUniqSet target)
+ addLive (lookupWithDefaultBEnv other_live emptyUniqSet target)
cmmStmtLive other_live (CmmCondBranch expr target) =
cmmExprLive expr .
- addLive (lookupWithDefaultUFM other_live emptyUniqSet target)
+ addLive (lookupWithDefaultBEnv other_live emptyUniqSet target)
cmmStmtLive other_live (CmmSwitch expr targets) =
cmmExprLive expr .
(foldr ((.) . (addLive .
- lookupWithDefaultUFM other_live emptyUniqSet))
+ lookupWithDefaultBEnv other_live emptyUniqSet))
id
(mapCatMaybes id targets))
cmmStmtLive _ (CmmJump expr params) =
- const (cmmExprLive expr $ foldr ((.) . cmmExprLive) id (map fst params) $ emptyUniqSet)
+ const (cmmExprLive expr $ foldr ((.) . cmmExprLive) id (map hintlessCmm params) $ emptyUniqSet)
cmmStmtLive _ (CmmReturn params) =
- const (foldr ((.) . cmmExprLive) id (map fst params) $ emptyUniqSet)
+ const (foldr ((.) . cmmExprLive) id (map hintlessCmm params) $ emptyUniqSet)
--------------------------------
-- Liveness of a CmmExpr
expr_liveness (CmmReg reg) = reg_liveness reg
expr_liveness (CmmMachOp _ exprs) = concatMap expr_liveness exprs
expr_liveness (CmmRegOff reg _) = reg_liveness reg
+ expr_liveness (CmmStackSlot _ _) = panic "cmmExprLive CmmStackSlot"
reg_liveness :: CmmReg -> [LocalReg]
reg_liveness (CmmLocal reg) = [reg]