+{-# OPTIONS -w #-}
+-- 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
+-- http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
+-- for details
+
module CmmLive (
- CmmLive, BlockEntryLiveness,
+ CmmLive,
+ BlockEntryLiveness,
cmmLiveness,
- cmmFormalsToLiveLocals
+ cmmHintFormalsToLiveLocals,
) where
+#include "HsVersions.h"
+
import Cmm
import Dataflow
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 =
(map blockId blocks)
(listToUFM [(blockId b, emptyUniqSet) | b <- blocks])
where
+ sources :: BlockSources
sources = cmmBlockSources blocks
- blocks' = cmmBlockNames blocks
+
+ blocks' :: BlockStmts
+ blocks' = listToUFM $ 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)
+-----------------------------------------------------------------------------
+-- | 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 emptyUFM 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
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
---------------------------------
--- 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
then Nothing
else Just $ addToUFM state node new_live
where
- new_live = cmmStmtListLive state block
+ new_live, old_live :: CmmLive
+ new_live = cmmStmtListLive state block_stmts
old_live = lookupWithDefaultUFM state missing_live node
- block = lookupWithDefaultUFM blocks missing_block node
+
+ block_stmts :: [CmmStmt]
+ block_stmts = lookupWithDefaultUFM 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
+cmmHintFormalsToLiveLocals :: CmmHintFormals -> [LocalReg]
+cmmHintFormalsToLiveLocals formals = map fst 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) .
- addKilled (mkUniqSet $ cmmFormalsToLiveLocals results) where
+ addKilled (mkUniqSet $ cmmHintFormalsToLiveLocals 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)
projects / ghc-hetmet.git / blobdiff