Commit 3de1c72b authored by Michael D. Adams's avatar Michael D. Adams
Browse files

Added forgotten ./compiler/cmm/CmmLive.hs

parent 43f5591b
module CmmLive (
CmmLive, BlockEntryLiveness,
cmmLiveness
) where
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
type CmmLive = UniqSet LocalReg
-- A mapping from block labels to the variables live on entry
type BlockEntryLiveness = BlockEnv CmmLive
-----------------------------------------------------------------------------
-- cmmLiveness and helpers
-----------------------------------------------------------------------------
cmmLiveness :: [CmmBasicBlock] -> BlockEntryLiveness
cmmLiveness blocks =
fixedpoint (cmmBlockDependants sources)
(cmmBlockUpdate blocks')
(map blockId blocks)
(listToUFM [(blockId b, emptyUniqSet) | b <- blocks])
where
sources = cmmBlockSources blocks
blocks' = cmmBlockNames blocks
{-
-- 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
-}
--------------------------------
-- 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
where
aux :: CmmBasicBlock
-> BlockEnv (UniqSet BlockId)
-> BlockEnv (UniqSet BlockId)
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)
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 _ = []
--------------------------------
-- 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 created,
-- list all blocks that depend
-- on the result of a particular
-- block.
--------------------------------
cmmBlockDependants :: BlockEnv (UniqSet BlockId) -> 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
--------------------------------
cmmBlockUpdate ::
BlockEnv [CmmStmt]
-> 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
new_live = cmmStmtListLive state block
old_live = lookupWithDefaultUFM state missing_live node
block = lookupWithDefaultUFM blocks missing_block node
missing_live = panic "unknown block id during liveness analysis"
missing_block = panic "unknown block id during liveness analysis"
-----------------------------------------------------------------------------
-- 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
--------------------------------
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
cmmStmtLive _ (CmmCall target results arguments _) =
target_liveness .
foldr ((.) . cmmExprLive) id (map fst arguments) .
addKilled (mkUniqSet $ only_local_regs results) where
only_local_regs [] = []
only_local_regs ((CmmGlobal _,_):args) = only_local_regs args
only_local_regs ((CmmLocal r,_):args) = r:only_local_regs args
target_liveness =
case target of
(CmmForeignCall target _) -> cmmExprLive target
(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 _) = []
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment