Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Glasgow Haskell Compiler
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
0
Merge Requests
0
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Package Registry
Container Registry
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
3de1c72b
Commit
3de1c72b
authored
May 21, 2007
by
Michael D. Adams
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Added forgotten ./compiler/cmm/CmmLive.hs
parent
43f5591b
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
211 additions
and
0 deletions
+211
-0
compiler/cmm/CmmLive.hs
compiler/cmm/CmmLive.hs
+211
-0
No files found.
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
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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