Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
3de1c72b
Commit
3de1c72b
authored
May 21, 2007
by
Michael D. Adams
Browse files
Added forgotten ./compiler/cmm/CmmLive.hs
parent
43f5591b
Changes
1
Hide whitespace changes
Inline
Side-by-side
compiler/cmm/CmmLive.hs
0 → 100644
View file @
3de1c72b
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
_
)
=
[]
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment