{-# LANGUAGE GADTs #-}
module GHC.Cmm.Sink (
cmmSink
) where
import GHC.Prelude
import GHC.Cmm
import GHC.Cmm.Opt
import GHC.Cmm.Liveness
import GHC.Cmm.Utils
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Graph
import GHC.Platform.Regs
import GHC.Platform
import GHC.Types.Unique
import GHC.Types.Unique.FM
import qualified Data.IntSet as IntSet
import Data.List (partition)
import qualified Data.Set as Set
import Data.Maybe
type LRegSet = IntSet.IntSet
emptyLRegSet :: LRegSet
emptyLRegSet :: LRegSet
emptyLRegSet = LRegSet
IntSet.empty
nullLRegSet :: LRegSet -> Bool
nullLRegSet :: LRegSet -> Bool
nullLRegSet = LRegSet -> Bool
IntSet.null
insertLRegSet :: LocalReg -> LRegSet -> LRegSet
insertLRegSet :: LocalReg -> LRegSet -> LRegSet
insertLRegSet LocalReg
l = Key -> LRegSet -> LRegSet
IntSet.insert (Unique -> Key
getKey (LocalReg -> Unique
forall a. Uniquable a => a -> Unique
getUnique LocalReg
l))
elemLRegSet :: LocalReg -> LRegSet -> Bool
elemLRegSet :: LocalReg -> LRegSet -> Bool
elemLRegSet LocalReg
l = Key -> LRegSet -> Bool
IntSet.member (Unique -> Key
getKey (LocalReg -> Unique
forall a. Uniquable a => a -> Unique
getUnique LocalReg
l))
type Assignment = (LocalReg, CmmExpr, AbsMem)
type Assignments = [Assignment]
cmmSink :: Platform -> CmmGraph -> CmmGraph
cmmSink :: Platform -> CmmGraph -> CmmGraph
cmmSink Platform
platform CmmGraph
graph = BlockId -> [CmmBlock] -> CmmGraph
ofBlockList (CmmGraph -> BlockId
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry CmmGraph
graph) ([CmmBlock] -> CmmGraph) -> [CmmBlock] -> CmmGraph
forall a b. (a -> b) -> a -> b
$ LabelMap Assignments -> [CmmBlock] -> [CmmBlock]
sink LabelMap Assignments
forall (map :: * -> *) a. IsMap map => map a
mapEmpty ([CmmBlock] -> [CmmBlock]) -> [CmmBlock] -> [CmmBlock]
forall a b. (a -> b) -> a -> b
$ [CmmBlock]
blocks
where
liveness :: BlockEntryLiveness LocalReg
liveness = Platform -> CmmGraph -> BlockEntryLiveness LocalReg
cmmLocalLiveness Platform
platform CmmGraph
graph
getLive :: BlockId -> Set LocalReg
getLive BlockId
l = Set LocalReg
-> KeyOf LabelMap -> BlockEntryLiveness LocalReg -> Set LocalReg
forall (map :: * -> *) a. IsMap map => a -> KeyOf map -> map a -> a
mapFindWithDefault Set LocalReg
forall a. Set a
Set.empty BlockId
KeyOf LabelMap
l BlockEntryLiveness LocalReg
liveness
blocks :: [CmmBlock]
blocks = CmmGraph -> [CmmBlock]
revPostorder CmmGraph
graph
join_pts :: LabelMap Key
join_pts = [CmmBlock] -> LabelMap Key
findJoinPoints [CmmBlock]
blocks
sink :: LabelMap Assignments -> [CmmBlock] -> [CmmBlock]
sink :: LabelMap Assignments -> [CmmBlock] -> [CmmBlock]
sink LabelMap Assignments
_ [] = []
sink LabelMap Assignments
sunk (CmmBlock
b:[CmmBlock]
bs) =
CmmNode C O -> Block CmmNode O O -> CmmNode O C -> CmmBlock
forall (n :: Extensibility -> Extensibility -> *).
n C O -> Block n O O -> n O C -> Block n C C
blockJoin CmmNode C O
first Block CmmNode O O
final_middle CmmNode O C
final_last CmmBlock -> [CmmBlock] -> [CmmBlock]
forall a. a -> [a] -> [a]
: LabelMap Assignments -> [CmmBlock] -> [CmmBlock]
sink LabelMap Assignments
sunk' [CmmBlock]
bs
where
lbl :: BlockId
lbl = CmmBlock -> BlockId
forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> BlockId
entryLabel CmmBlock
b
(CmmNode C O
first, Block CmmNode O O
middle, CmmNode O C
last) = CmmBlock -> (CmmNode C O, Block CmmNode O O, CmmNode O C)
forall (n :: Extensibility -> Extensibility -> *).
Block n C C -> (n C O, Block n O O, n O C)
blockSplit CmmBlock
b
succs :: [BlockId]
succs = CmmNode O C -> [BlockId]
forall (thing :: Extensibility -> Extensibility -> *)
(e :: Extensibility).
NonLocal thing =>
thing e C -> [BlockId]
successors CmmNode O C
last
live :: Set LocalReg
live = [Set LocalReg] -> Set LocalReg
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ((BlockId -> Set LocalReg) -> [BlockId] -> [Set LocalReg]
forall a b. (a -> b) -> [a] -> [b]
map BlockId -> Set LocalReg
getLive [BlockId]
succs)
live_middle :: Set LocalReg
live_middle = Platform -> CmmNode O C -> Set LocalReg -> Set LocalReg
forall r n.
(DefinerOfRegs r n, UserOfRegs r n) =>
Platform -> n -> CmmLive r -> CmmLive r
gen_kill Platform
platform CmmNode O C
last Set LocalReg
live
ann_middles :: [(Set LocalReg, CmmNode O O)]
ann_middles = Platform
-> Set LocalReg -> [CmmNode O O] -> [(Set LocalReg, CmmNode O O)]
annotate Platform
platform Set LocalReg
live_middle (Block CmmNode O O -> [CmmNode O O]
forall (n :: Extensibility -> Extensibility -> *).
Block n O O -> [n O O]
blockToList Block CmmNode O O
middle)
(Block CmmNode O O
middle', Assignments
assigs) = Platform
-> [(Set LocalReg, CmmNode O O)]
-> Assignments
-> (Block CmmNode O O, Assignments)
walk Platform
platform [(Set LocalReg, CmmNode O O)]
ann_middles (Assignments
-> KeyOf LabelMap -> LabelMap Assignments -> Assignments
forall (map :: * -> *) a. IsMap map => a -> KeyOf map -> map a -> a
mapFindWithDefault [] BlockId
KeyOf LabelMap
lbl LabelMap Assignments
sunk)
fold_last :: CmmNode O C
fold_last = Platform -> CmmNode O C -> CmmNode O C
forall (e :: Extensibility) (x :: Extensibility).
Platform -> CmmNode e x -> CmmNode e x
constantFoldNode Platform
platform CmmNode O C
last
(CmmNode O C
final_last, Assignments
assigs') = Platform
-> Set LocalReg
-> CmmNode O C
-> Assignments
-> (CmmNode O C, Assignments)
forall (x :: Extensibility).
Platform
-> Set LocalReg
-> CmmNode O x
-> Assignments
-> (CmmNode O x, Assignments)
tryToInline Platform
platform Set LocalReg
live CmmNode O C
fold_last Assignments
assigs
([BlockId]
joins, [BlockId]
nonjoins) = (BlockId -> Bool) -> [BlockId] -> ([BlockId], [BlockId])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (KeyOf LabelMap -> LabelMap Key -> Bool
forall (map :: * -> *) a. IsMap map => KeyOf map -> map a -> Bool
`mapMember` LabelMap Key
join_pts) [BlockId]
succs
live_in_joins :: Set LocalReg
live_in_joins = [Set LocalReg] -> Set LocalReg
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ((BlockId -> Set LocalReg) -> [BlockId] -> [Set LocalReg]
forall a b. (a -> b) -> [a] -> [b]
map BlockId -> Set LocalReg
getLive [BlockId]
joins)
init_live_sets :: [Set LocalReg]
init_live_sets = (BlockId -> Set LocalReg) -> [BlockId] -> [Set LocalReg]
forall a b. (a -> b) -> [a] -> [b]
map BlockId -> Set LocalReg
getLive [BlockId]
nonjoins
live_in_multi :: [Set a] -> a -> Bool
live_in_multi [Set a]
live_sets a
r =
case (Set a -> Bool) -> [Set a] -> [Set a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
r) [Set a]
live_sets of
(Set a
_one:Set a
_two:[Set a]
_) -> Bool
True
[Set a]
_ -> Bool
False
([CmmNode O O]
dropped_last, Assignments
assigs'') = Platform
-> (Assignment -> [Set LocalReg] -> (Bool, [Set LocalReg]))
-> [Set LocalReg]
-> Assignments
-> ([CmmNode O O], Assignments)
forall s.
Platform
-> (Assignment -> s -> (Bool, s))
-> s
-> Assignments
-> ([CmmNode O O], Assignments)
dropAssignments Platform
platform Assignment -> [Set LocalReg] -> (Bool, [Set LocalReg])
drop_if [Set LocalReg]
init_live_sets Assignments
assigs'
drop_if :: Assignment -> [Set LocalReg] -> (Bool, [Set LocalReg])
drop_if a :: Assignment
a@(LocalReg
r,CmmExpr
rhs,AbsMem
_) [Set LocalReg]
live_sets = (Bool
should_drop, [Set LocalReg]
live_sets')
where
should_drop :: Bool
should_drop = Platform -> Assignment -> CmmNode O C -> Bool
forall (x :: Extensibility).
Platform -> Assignment -> CmmNode O x -> Bool
conflicts Platform
platform Assignment
a CmmNode O C
final_last
Bool -> Bool -> Bool
|| Bool -> Bool
not (Platform -> CmmExpr -> Bool
isTrivial Platform
platform CmmExpr
rhs) Bool -> Bool -> Bool
&& [Set LocalReg] -> LocalReg -> Bool
forall a. Ord a => [Set a] -> a -> Bool
live_in_multi [Set LocalReg]
live_sets LocalReg
r
Bool -> Bool -> Bool
|| LocalReg
r LocalReg -> Set LocalReg -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set LocalReg
live_in_joins
live_sets' :: [Set LocalReg]
live_sets' | Bool
should_drop = [Set LocalReg]
live_sets
| Bool
otherwise = (Set LocalReg -> Set LocalReg) -> [Set LocalReg] -> [Set LocalReg]
forall a b. (a -> b) -> [a] -> [b]
map Set LocalReg -> Set LocalReg
upd [Set LocalReg]
live_sets
upd :: Set LocalReg -> Set LocalReg
upd Set LocalReg
set | LocalReg
r LocalReg -> Set LocalReg -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set LocalReg
set = Set LocalReg
set Set LocalReg -> Set LocalReg -> Set LocalReg
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set LocalReg
live_rhs
| Bool
otherwise = Set LocalReg
set
live_rhs :: Set LocalReg
live_rhs = Platform
-> (Set LocalReg -> LocalReg -> Set LocalReg)
-> Set LocalReg
-> CmmExpr
-> Set LocalReg
forall r a b.
UserOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsUsed Platform
platform Set LocalReg -> LocalReg -> Set LocalReg
forall r. Ord r => RegSet r -> r -> RegSet r
extendRegSet Set LocalReg
forall a. Set a
emptyRegSet CmmExpr
rhs
final_middle :: Block CmmNode O O
final_middle = (Block CmmNode O O -> CmmNode O O -> Block CmmNode O O)
-> Block CmmNode O O -> [CmmNode O O] -> Block CmmNode O O
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Block CmmNode O O -> CmmNode O O -> Block CmmNode O O
forall (n :: Extensibility -> Extensibility -> *)
(e :: Extensibility).
Block n e O -> n O O -> Block n e O
blockSnoc Block CmmNode O O
middle' [CmmNode O O]
dropped_last
sunk' :: LabelMap Assignments
sunk' = LabelMap Assignments
-> LabelMap Assignments -> LabelMap Assignments
forall (map :: * -> *) a. IsMap map => map a -> map a -> map a
mapUnion LabelMap Assignments
sunk (LabelMap Assignments -> LabelMap Assignments)
-> LabelMap Assignments -> LabelMap Assignments
forall a b. (a -> b) -> a -> b
$
[(KeyOf LabelMap, Assignments)] -> LabelMap Assignments
forall (map :: * -> *) a. IsMap map => [(KeyOf map, a)] -> map a
mapFromList [ (BlockId
KeyOf LabelMap
l, Platform -> Set LocalReg -> Assignments -> Assignments
filterAssignments Platform
platform (BlockId -> Set LocalReg
getLive BlockId
l) Assignments
assigs'')
| BlockId
l <- [BlockId]
succs ]
isTrivial :: Platform -> CmmExpr -> Bool
isTrivial :: Platform -> CmmExpr -> Bool
isTrivial Platform
_ (CmmReg (CmmLocal LocalReg
_)) = Bool
True
isTrivial Platform
platform (CmmReg (CmmGlobal GlobalReg
r)) =
if Arch -> Bool
isARM (Platform -> Arch
platformArch Platform
platform)
then Bool
True
else Maybe RealReg -> Bool
forall a. Maybe a -> Bool
isJust (Platform -> GlobalReg -> Maybe RealReg
globalRegMaybe Platform
platform GlobalReg
r)
isTrivial Platform
_ (CmmLit CmmLit
_) = Bool
True
isTrivial Platform
_ CmmExpr
_ = Bool
False
annotate :: Platform -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)]
annotate :: Platform
-> Set LocalReg -> [CmmNode O O] -> [(Set LocalReg, CmmNode O O)]
annotate Platform
platform Set LocalReg
live [CmmNode O O]
nodes = (Set LocalReg, [(Set LocalReg, CmmNode O O)])
-> [(Set LocalReg, CmmNode O O)]
forall a b. (a, b) -> b
snd ((Set LocalReg, [(Set LocalReg, CmmNode O O)])
-> [(Set LocalReg, CmmNode O O)])
-> (Set LocalReg, [(Set LocalReg, CmmNode O O)])
-> [(Set LocalReg, CmmNode O O)]
forall a b. (a -> b) -> a -> b
$ (CmmNode O O
-> (Set LocalReg, [(Set LocalReg, CmmNode O O)])
-> (Set LocalReg, [(Set LocalReg, CmmNode O O)]))
-> (Set LocalReg, [(Set LocalReg, CmmNode O O)])
-> [CmmNode O O]
-> (Set LocalReg, [(Set LocalReg, CmmNode O O)])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CmmNode O O
-> (Set LocalReg, [(Set LocalReg, CmmNode O O)])
-> (Set LocalReg, [(Set LocalReg, CmmNode O O)])
ann (Set LocalReg
live,[]) [CmmNode O O]
nodes
where ann :: CmmNode O O
-> (Set LocalReg, [(Set LocalReg, CmmNode O O)])
-> (Set LocalReg, [(Set LocalReg, CmmNode O O)])
ann CmmNode O O
n (Set LocalReg
live,[(Set LocalReg, CmmNode O O)]
nodes) = (Platform -> CmmNode O O -> Set LocalReg -> Set LocalReg
forall r n.
(DefinerOfRegs r n, UserOfRegs r n) =>
Platform -> n -> CmmLive r -> CmmLive r
gen_kill Platform
platform CmmNode O O
n Set LocalReg
live, (Set LocalReg
live,CmmNode O O
n) (Set LocalReg, CmmNode O O)
-> [(Set LocalReg, CmmNode O O)] -> [(Set LocalReg, CmmNode O O)]
forall a. a -> [a] -> [a]
: [(Set LocalReg, CmmNode O O)]
nodes)
findJoinPoints :: [CmmBlock] -> LabelMap Int
findJoinPoints :: [CmmBlock] -> LabelMap Key
findJoinPoints [CmmBlock]
blocks = (Key -> Bool) -> LabelMap Key -> LabelMap Key
forall (map :: * -> *) a.
IsMap map =>
(a -> Bool) -> map a -> map a
mapFilter (Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
>Key
1) LabelMap Key
succ_counts
where
all_succs :: [BlockId]
all_succs = (CmmBlock -> [BlockId]) -> [CmmBlock] -> [BlockId]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CmmBlock -> [BlockId]
forall (thing :: Extensibility -> Extensibility -> *)
(e :: Extensibility).
NonLocal thing =>
thing e C -> [BlockId]
successors [CmmBlock]
blocks
succ_counts :: LabelMap Int
succ_counts :: LabelMap Key
succ_counts = (BlockId -> LabelMap Key -> LabelMap Key)
-> LabelMap Key -> [BlockId] -> LabelMap Key
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\BlockId
l -> (Key -> Key -> Key)
-> KeyOf LabelMap -> Key -> LabelMap Key -> LabelMap Key
forall (map :: * -> *) a.
IsMap map =>
(a -> a -> a) -> KeyOf map -> a -> map a -> map a
mapInsertWith Key -> Key -> Key
forall a. Num a => a -> a -> a
(+) BlockId
KeyOf LabelMap
l Key
1) LabelMap Key
forall (map :: * -> *) a. IsMap map => map a
mapEmpty [BlockId]
all_succs
filterAssignments :: Platform -> LocalRegSet -> Assignments -> Assignments
filterAssignments :: Platform -> Set LocalReg -> Assignments -> Assignments
filterAssignments Platform
platform Set LocalReg
live Assignments
assigs = Assignments -> Assignments
forall a. [a] -> [a]
reverse (Assignments -> Assignments -> Assignments
go Assignments
assigs [])
where go :: Assignments -> Assignments -> Assignments
go [] Assignments
kept = Assignments
kept
go (a :: Assignment
a@(LocalReg
r,CmmExpr
_,AbsMem
_):Assignments
as) Assignments
kept | Bool
needed = Assignments -> Assignments -> Assignments
go Assignments
as (Assignment
aAssignment -> Assignments -> Assignments
forall a. a -> [a] -> [a]
:Assignments
kept)
| Bool
otherwise = Assignments -> Assignments -> Assignments
go Assignments
as Assignments
kept
where
needed :: Bool
needed = LocalReg
r LocalReg -> Set LocalReg -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set LocalReg
live
Bool -> Bool -> Bool
|| (CmmNode O O -> Bool) -> [CmmNode O O] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Platform -> Assignment -> CmmNode O O -> Bool
forall (x :: Extensibility).
Platform -> Assignment -> CmmNode O x -> Bool
conflicts Platform
platform Assignment
a) ((Assignment -> CmmNode O O) -> Assignments -> [CmmNode O O]
forall a b. (a -> b) -> [a] -> [b]
map Assignment -> CmmNode O O
toNode Assignments
kept)
walk :: Platform
-> [(LocalRegSet, CmmNode O O)]
-> Assignments
-> ( Block CmmNode O O
, Assignments
)
walk :: Platform
-> [(Set LocalReg, CmmNode O O)]
-> Assignments
-> (Block CmmNode O O, Assignments)
walk Platform
platform [(Set LocalReg, CmmNode O O)]
nodes Assignments
assigs = [(Set LocalReg, CmmNode O O)]
-> Block CmmNode O O
-> Assignments
-> (Block CmmNode O O, Assignments)
go [(Set LocalReg, CmmNode O O)]
nodes Block CmmNode O O
forall (n :: Extensibility -> Extensibility -> *). Block n O O
emptyBlock Assignments
assigs
where
go :: [(Set LocalReg, CmmNode O O)]
-> Block CmmNode O O
-> Assignments
-> (Block CmmNode O O, Assignments)
go [] Block CmmNode O O
block Assignments
as = (Block CmmNode O O
block, Assignments
as)
go ((Set LocalReg
live,CmmNode O O
node):[(Set LocalReg, CmmNode O O)]
ns) Block CmmNode O O
block Assignments
as
| CmmNode O O -> Set LocalReg -> Bool
forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> Set LocalReg -> Bool
shouldDiscard CmmNode O O
node Set LocalReg
live = [(Set LocalReg, CmmNode O O)]
-> Block CmmNode O O
-> Assignments
-> (Block CmmNode O O, Assignments)
go [(Set LocalReg, CmmNode O O)]
ns Block CmmNode O O
block Assignments
as
| Just Assignment
a <- Platform -> CmmNode O O -> Maybe Assignment
forall (e :: Extensibility) (x :: Extensibility).
Platform -> CmmNode e x -> Maybe Assignment
shouldSink Platform
platform CmmNode O O
node2 = [(Set LocalReg, CmmNode O O)]
-> Block CmmNode O O
-> Assignments
-> (Block CmmNode O O, Assignments)
go [(Set LocalReg, CmmNode O O)]
ns Block CmmNode O O
block (Assignment
a Assignment -> Assignments -> Assignments
forall a. a -> [a] -> [a]
: Assignments
as1)
| Bool
otherwise = [(Set LocalReg, CmmNode O O)]
-> Block CmmNode O O
-> Assignments
-> (Block CmmNode O O, Assignments)
go [(Set LocalReg, CmmNode O O)]
ns Block CmmNode O O
block' Assignments
as'
where
node1 :: CmmNode O O
node1 = Platform -> CmmNode O O -> CmmNode O O
forall (e :: Extensibility) (x :: Extensibility).
Platform -> CmmNode e x -> CmmNode e x
constantFoldNode Platform
platform CmmNode O O
node
(CmmNode O O
node2, Assignments
as1) = Platform
-> Set LocalReg
-> CmmNode O O
-> Assignments
-> (CmmNode O O, Assignments)
forall (x :: Extensibility).
Platform
-> Set LocalReg
-> CmmNode O x
-> Assignments
-> (CmmNode O x, Assignments)
tryToInline Platform
platform Set LocalReg
live CmmNode O O
node1 Assignments
as
([CmmNode O O]
dropped, Assignments
as') = Platform
-> (Assignment -> Bool)
-> Assignments
-> ([CmmNode O O], Assignments)
dropAssignmentsSimple Platform
platform
(\Assignment
a -> Platform -> Assignment -> CmmNode O O -> Bool
forall (x :: Extensibility).
Platform -> Assignment -> CmmNode O x -> Bool
conflicts Platform
platform Assignment
a CmmNode O O
node2) Assignments
as1
block' :: Block CmmNode O O
block' = (Block CmmNode O O -> CmmNode O O -> Block CmmNode O O)
-> Block CmmNode O O -> [CmmNode O O] -> Block CmmNode O O
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Block CmmNode O O -> CmmNode O O -> Block CmmNode O O
forall (n :: Extensibility -> Extensibility -> *)
(e :: Extensibility).
Block n e O -> n O O -> Block n e O
blockSnoc Block CmmNode O O
block [CmmNode O O]
dropped Block CmmNode O O -> CmmNode O O -> Block CmmNode O O
forall (n :: Extensibility -> Extensibility -> *)
(e :: Extensibility).
Block n e O -> n O O -> Block n e O
`blockSnoc` CmmNode O O
node2
shouldSink :: Platform -> CmmNode e x -> Maybe Assignment
shouldSink :: Platform -> CmmNode e x -> Maybe Assignment
shouldSink Platform
platform (CmmAssign (CmmLocal LocalReg
r) CmmExpr
e) | Bool
no_local_regs = Assignment -> Maybe Assignment
forall a. a -> Maybe a
Just (LocalReg
r, CmmExpr
e, Platform -> CmmExpr -> AbsMem
exprMem Platform
platform CmmExpr
e)
where no_local_regs :: Bool
no_local_regs = Bool
True
shouldSink Platform
_ CmmNode e x
_other = Maybe Assignment
forall a. Maybe a
Nothing
shouldDiscard :: CmmNode e x -> LocalRegSet -> Bool
shouldDiscard :: CmmNode e x -> Set LocalReg -> Bool
shouldDiscard CmmNode e x
node Set LocalReg
live
= case CmmNode e x
node of
CmmAssign CmmReg
r (CmmReg CmmReg
r') | CmmReg
r CmmReg -> CmmReg -> Bool
forall a. Eq a => a -> a -> Bool
== CmmReg
r' -> Bool
True
CmmAssign (CmmLocal LocalReg
r) CmmExpr
_ -> Bool -> Bool
not (LocalReg
r LocalReg -> Set LocalReg -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set LocalReg
live)
CmmNode e x
_otherwise -> Bool
False
toNode :: Assignment -> CmmNode O O
toNode :: Assignment -> CmmNode O O
toNode (LocalReg
r,CmmExpr
rhs,AbsMem
_) = CmmReg -> CmmExpr -> CmmNode O O
CmmAssign (LocalReg -> CmmReg
CmmLocal LocalReg
r) CmmExpr
rhs
dropAssignmentsSimple :: Platform -> (Assignment -> Bool) -> Assignments
-> ([CmmNode O O], Assignments)
dropAssignmentsSimple :: Platform
-> (Assignment -> Bool)
-> Assignments
-> ([CmmNode O O], Assignments)
dropAssignmentsSimple Platform
platform Assignment -> Bool
f = Platform
-> (Assignment -> () -> (Bool, ()))
-> ()
-> Assignments
-> ([CmmNode O O], Assignments)
forall s.
Platform
-> (Assignment -> s -> (Bool, s))
-> s
-> Assignments
-> ([CmmNode O O], Assignments)
dropAssignments Platform
platform (\Assignment
a ()
_ -> (Assignment -> Bool
f Assignment
a, ())) ()
dropAssignments :: Platform -> (Assignment -> s -> (Bool, s)) -> s -> Assignments
-> ([CmmNode O O], Assignments)
dropAssignments :: Platform
-> (Assignment -> s -> (Bool, s))
-> s
-> Assignments
-> ([CmmNode O O], Assignments)
dropAssignments Platform
platform Assignment -> s -> (Bool, s)
should_drop s
state Assignments
assigs
= ([CmmNode O O]
dropped, Assignments -> Assignments
forall a. [a] -> [a]
reverse Assignments
kept)
where
([CmmNode O O]
dropped,Assignments
kept) = s
-> Assignments
-> [CmmNode O O]
-> Assignments
-> ([CmmNode O O], Assignments)
go s
state Assignments
assigs [] []
go :: s
-> Assignments
-> [CmmNode O O]
-> Assignments
-> ([CmmNode O O], Assignments)
go s
_ [] [CmmNode O O]
dropped Assignments
kept = ([CmmNode O O]
dropped, Assignments
kept)
go s
state (Assignment
assig : Assignments
rest) [CmmNode O O]
dropped Assignments
kept
| Bool
conflict = s
-> Assignments
-> [CmmNode O O]
-> Assignments
-> ([CmmNode O O], Assignments)
go s
state' Assignments
rest (Assignment -> CmmNode O O
toNode Assignment
assig CmmNode O O -> [CmmNode O O] -> [CmmNode O O]
forall a. a -> [a] -> [a]
: [CmmNode O O]
dropped) Assignments
kept
| Bool
otherwise = s
-> Assignments
-> [CmmNode O O]
-> Assignments
-> ([CmmNode O O], Assignments)
go s
state' Assignments
rest [CmmNode O O]
dropped (Assignment
assigAssignment -> Assignments -> Assignments
forall a. a -> [a] -> [a]
:Assignments
kept)
where
(Bool
dropit, s
state') = Assignment -> s -> (Bool, s)
should_drop Assignment
assig s
state
conflict :: Bool
conflict = Bool
dropit Bool -> Bool -> Bool
|| (CmmNode O O -> Bool) -> [CmmNode O O] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Platform -> Assignment -> CmmNode O O -> Bool
forall (x :: Extensibility).
Platform -> Assignment -> CmmNode O x -> Bool
conflicts Platform
platform Assignment
assig) [CmmNode O O]
dropped
tryToInline
:: Platform
-> LocalRegSet
-> CmmNode O x
-> Assignments
-> (
CmmNode O x
, Assignments
)
tryToInline :: Platform
-> Set LocalReg
-> CmmNode O x
-> Assignments
-> (CmmNode O x, Assignments)
tryToInline Platform
platform Set LocalReg
live CmmNode O x
node Assignments
assigs = UniqFM LocalReg Key
-> CmmNode O x
-> LRegSet
-> Assignments
-> (CmmNode O x, Assignments)
go UniqFM LocalReg Key
usages CmmNode O x
node LRegSet
emptyLRegSet Assignments
assigs
where
usages :: UniqFM LocalReg Int
usages :: UniqFM LocalReg Key
usages = Platform
-> (UniqFM LocalReg Key -> LocalReg -> UniqFM LocalReg Key)
-> UniqFM LocalReg Key
-> CmmNode O x
-> UniqFM LocalReg Key
forall a b.
UserOfRegs LocalReg a =>
Platform -> (b -> LocalReg -> b) -> b -> a -> b
foldLocalRegsUsed Platform
platform UniqFM LocalReg Key -> LocalReg -> UniqFM LocalReg Key
addUsage UniqFM LocalReg Key
forall key elt. UniqFM key elt
emptyUFM CmmNode O x
node
go :: UniqFM LocalReg Key
-> CmmNode O x
-> LRegSet
-> Assignments
-> (CmmNode O x, Assignments)
go UniqFM LocalReg Key
_usages CmmNode O x
node LRegSet
_skipped [] = (CmmNode O x
node, [])
go UniqFM LocalReg Key
usages CmmNode O x
node LRegSet
skipped (a :: Assignment
a@(LocalReg
l,CmmExpr
rhs,AbsMem
_) : Assignments
rest)
| Bool
cannot_inline = (CmmNode O x, Assignments)
dont_inline
| Bool
occurs_none = (CmmNode O x, Assignments)
discard
| Bool
occurs_once = (CmmNode O x, Assignments)
inline_and_discard
| Platform -> CmmExpr -> Bool
isTrivial Platform
platform CmmExpr
rhs = (CmmNode O x, Assignments)
inline_and_keep
| Bool
otherwise = (CmmNode O x, Assignments)
dont_inline
where
inline_and_discard :: (CmmNode O x, Assignments)
inline_and_discard = UniqFM LocalReg Key
-> CmmNode O x
-> LRegSet
-> Assignments
-> (CmmNode O x, Assignments)
go UniqFM LocalReg Key
usages' CmmNode O x
inl_node LRegSet
skipped Assignments
rest
where usages' :: UniqFM LocalReg Key
usages' = Platform
-> (UniqFM LocalReg Key -> LocalReg -> UniqFM LocalReg Key)
-> UniqFM LocalReg Key
-> CmmExpr
-> UniqFM LocalReg Key
forall a b.
UserOfRegs LocalReg a =>
Platform -> (b -> LocalReg -> b) -> b -> a -> b
foldLocalRegsUsed Platform
platform UniqFM LocalReg Key -> LocalReg -> UniqFM LocalReg Key
addUsage UniqFM LocalReg Key
usages CmmExpr
rhs
discard :: (CmmNode O x, Assignments)
discard = UniqFM LocalReg Key
-> CmmNode O x
-> LRegSet
-> Assignments
-> (CmmNode O x, Assignments)
go UniqFM LocalReg Key
usages CmmNode O x
node LRegSet
skipped Assignments
rest
dont_inline :: (CmmNode O x, Assignments)
dont_inline = CmmNode O x -> (CmmNode O x, Assignments)
keep CmmNode O x
node
inline_and_keep :: (CmmNode O x, Assignments)
inline_and_keep = CmmNode O x -> (CmmNode O x, Assignments)
keep CmmNode O x
inl_node
keep :: CmmNode O x -> (CmmNode O x, Assignments)
keep CmmNode O x
node' = (CmmNode O x
final_node, Assignment
a Assignment -> Assignments -> Assignments
forall a. a -> [a] -> [a]
: Assignments
rest')
where (CmmNode O x
final_node, Assignments
rest') = UniqFM LocalReg Key
-> CmmNode O x
-> LRegSet
-> Assignments
-> (CmmNode O x, Assignments)
go UniqFM LocalReg Key
usages' CmmNode O x
node' (LocalReg -> LRegSet -> LRegSet
insertLRegSet LocalReg
l LRegSet
skipped) Assignments
rest
usages' :: UniqFM LocalReg Key
usages' = Platform
-> (UniqFM LocalReg Key -> LocalReg -> UniqFM LocalReg Key)
-> UniqFM LocalReg Key
-> CmmExpr
-> UniqFM LocalReg Key
forall a b.
UserOfRegs LocalReg a =>
Platform -> (b -> LocalReg -> b) -> b -> a -> b
foldLocalRegsUsed Platform
platform (\UniqFM LocalReg Key
m LocalReg
r -> UniqFM LocalReg Key -> LocalReg -> Key -> UniqFM LocalReg Key
forall key elt.
Uniquable key =>
UniqFM key elt -> key -> elt -> UniqFM key elt
addToUFM UniqFM LocalReg Key
m LocalReg
r Key
2)
UniqFM LocalReg Key
usages CmmExpr
rhs
cannot_inline :: Bool
cannot_inline = LRegSet
skipped LRegSet -> CmmExpr -> Bool
`regsUsedIn` CmmExpr
rhs
Bool -> Bool -> Bool
|| LocalReg
l LocalReg -> LRegSet -> Bool
`elemLRegSet` LRegSet
skipped
Bool -> Bool -> Bool
|| Bool -> Bool
not (Platform -> CmmExpr -> CmmNode O x -> Bool
forall (e :: Extensibility) (x :: Extensibility).
Platform -> CmmExpr -> CmmNode e x -> Bool
okToInline Platform
platform CmmExpr
rhs CmmNode O x
node)
l_usages :: Maybe Key
l_usages = UniqFM LocalReg Key -> LocalReg -> Maybe Key
forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM UniqFM LocalReg Key
usages LocalReg
l
l_live :: Bool
l_live = LocalReg
l LocalReg -> Set LocalReg -> Bool
forall a. Ord a => a -> Set a -> Bool
`elemRegSet` Set LocalReg
live
occurs_once :: Bool
occurs_once = Bool -> Bool
not Bool
l_live Bool -> Bool -> Bool
&& Maybe Key
l_usages Maybe Key -> Maybe Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key -> Maybe Key
forall a. a -> Maybe a
Just Key
1
occurs_none :: Bool
occurs_none = Bool -> Bool
not Bool
l_live Bool -> Bool -> Bool
&& Maybe Key
l_usages Maybe Key -> Maybe Key -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Key
forall a. Maybe a
Nothing
inl_node :: CmmNode O x
inl_node = CmmNode O x -> CmmNode O x
forall (x :: Extensibility). CmmNode O x -> CmmNode O x
improveConditional ((CmmExpr -> CmmExpr) -> CmmNode O x -> CmmNode O x
forall (e :: Extensibility) (x :: Extensibility).
(CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
mapExpDeep CmmExpr -> CmmExpr
inl_exp CmmNode O x
node)
inl_exp :: CmmExpr -> CmmExpr
inl_exp :: CmmExpr -> CmmExpr
inl_exp (CmmReg (CmmLocal LocalReg
l')) | LocalReg
l LocalReg -> LocalReg -> Bool
forall a. Eq a => a -> a -> Bool
== LocalReg
l' = CmmExpr
rhs
inl_exp (CmmRegOff (CmmLocal LocalReg
l') Key
off) | LocalReg
l LocalReg -> LocalReg -> Bool
forall a. Eq a => a -> a -> Bool
== LocalReg
l'
= Platform -> CmmExpr -> Key -> CmmExpr
cmmOffset Platform
platform CmmExpr
rhs Key
off
inl_exp (CmmMachOp MachOp
op [CmmExpr]
args) = Platform -> MachOp -> [CmmExpr] -> CmmExpr
cmmMachOpFold Platform
platform MachOp
op [CmmExpr]
args
inl_exp CmmExpr
other = CmmExpr
other
improveConditional :: CmmNode O x -> CmmNode O x
improveConditional :: CmmNode O x -> CmmNode O x
improveConditional
(CmmCondBranch (CmmMachOp MachOp
mop [CmmExpr
x, CmmLit (CmmInt Integer
1 Width
_)]) BlockId
t BlockId
f Maybe Bool
l)
| MachOp -> Bool
neLike MachOp
mop, CmmExpr -> Bool
isComparisonExpr CmmExpr
x
= CmmExpr -> BlockId -> BlockId -> Maybe Bool -> CmmNode O C
CmmCondBranch CmmExpr
x BlockId
f BlockId
t ((Bool -> Bool) -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not Maybe Bool
l)
where
neLike :: MachOp -> Bool
neLike (MO_Ne Width
_) = Bool
True
neLike (MO_U_Lt Width
_) = Bool
True
neLike (MO_S_Lt Width
_) = Bool
True
neLike MachOp
_ = Bool
False
improveConditional CmmNode O x
other = CmmNode O x
other
addUsage :: UniqFM LocalReg Int -> LocalReg -> UniqFM LocalReg Int
addUsage :: UniqFM LocalReg Key -> LocalReg -> UniqFM LocalReg Key
addUsage UniqFM LocalReg Key
m LocalReg
r = (Key -> Key -> Key)
-> UniqFM LocalReg Key -> LocalReg -> Key -> UniqFM LocalReg Key
forall key elt.
Uniquable key =>
(elt -> elt -> elt)
-> UniqFM key elt -> key -> elt -> UniqFM key elt
addToUFM_C Key -> Key -> Key
forall a. Num a => a -> a -> a
(+) UniqFM LocalReg Key
m LocalReg
r Key
1
regsUsedIn :: LRegSet -> CmmExpr -> Bool
regsUsedIn :: LRegSet -> CmmExpr -> Bool
regsUsedIn LRegSet
ls CmmExpr
_ | LRegSet -> Bool
nullLRegSet LRegSet
ls = Bool
False
regsUsedIn LRegSet
ls CmmExpr
e = (CmmExpr -> Bool -> Bool) -> CmmExpr -> Bool -> Bool
forall z. (CmmExpr -> z -> z) -> CmmExpr -> z -> z
wrapRecExpf CmmExpr -> Bool -> Bool
f CmmExpr
e Bool
False
where f :: CmmExpr -> Bool -> Bool
f (CmmReg (CmmLocal LocalReg
l)) Bool
_ | LocalReg
l LocalReg -> LRegSet -> Bool
`elemLRegSet` LRegSet
ls = Bool
True
f (CmmRegOff (CmmLocal LocalReg
l) Key
_) Bool
_ | LocalReg
l LocalReg -> LRegSet -> Bool
`elemLRegSet` LRegSet
ls = Bool
True
f CmmExpr
_ Bool
z = Bool
z
okToInline :: Platform -> CmmExpr -> CmmNode e x -> Bool
okToInline :: Platform -> CmmExpr -> CmmNode e x -> Bool
okToInline Platform
platform CmmExpr
expr node :: CmmNode e x
node@(CmmUnsafeForeignCall{}) =
Bool -> Bool
not (Platform -> CmmExpr -> CmmNode e x -> Bool
forall (e :: Extensibility) (x :: Extensibility).
Platform -> CmmExpr -> CmmNode e x -> Bool
globalRegistersConflict Platform
platform CmmExpr
expr CmmNode e x
node)
okToInline Platform
_ CmmExpr
_ CmmNode e x
_ = Bool
True
conflicts :: Platform -> Assignment -> CmmNode O x -> Bool
conflicts :: Platform -> Assignment -> CmmNode O x -> Bool
conflicts Platform
platform (LocalReg
r, CmmExpr
rhs, AbsMem
addr) CmmNode O x
node
| Platform -> CmmExpr -> CmmNode O x -> Bool
forall (e :: Extensibility) (x :: Extensibility).
Platform -> CmmExpr -> CmmNode e x -> Bool
globalRegistersConflict Platform
platform CmmExpr
rhs CmmNode O x
node = Bool
True
| Platform -> CmmExpr -> CmmNode O x -> Bool
forall (e :: Extensibility) (x :: Extensibility).
Platform -> CmmExpr -> CmmNode e x -> Bool
localRegistersConflict Platform
platform CmmExpr
rhs CmmNode O x
node = Bool
True
| Platform
-> (Bool -> LocalReg -> Bool) -> Bool -> CmmNode O x -> Bool
forall r a b.
UserOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsUsed Platform
platform (\Bool
b LocalReg
r' -> LocalReg
r LocalReg -> LocalReg -> Bool
forall a. Eq a => a -> a -> Bool
== LocalReg
r' Bool -> Bool -> Bool
|| Bool
b) Bool
False CmmNode O x
node = Bool
True
| CmmStore CmmExpr
addr' CmmExpr
e <- CmmNode O x
node
, AbsMem -> AbsMem -> Bool
memConflicts AbsMem
addr (Platform -> CmmExpr -> Width -> AbsMem
loadAddr Platform
platform CmmExpr
addr' (Platform -> CmmExpr -> Width
cmmExprWidth Platform
platform CmmExpr
e)) = Bool
True
| AbsMem
HeapMem <- AbsMem
addr, CmmAssign (CmmGlobal GlobalReg
Hp) CmmExpr
_ <- CmmNode O x
node = Bool
True
| AbsMem
StackMem <- AbsMem
addr, CmmAssign (CmmGlobal GlobalReg
Sp) CmmExpr
_ <- CmmNode O x
node = Bool
True
| SpMem{} <- AbsMem
addr, CmmAssign (CmmGlobal GlobalReg
Sp) CmmExpr
_ <- CmmNode O x
node = Bool
True
| CmmUnsafeForeignCall{} <- CmmNode O x
node, AbsMem -> AbsMem -> Bool
memConflicts AbsMem
addr AbsMem
AnyMem = Bool
True
| CmmCall{} <- CmmNode O x
node, AbsMem -> AbsMem -> Bool
memConflicts AbsMem
addr AbsMem
AnyMem = Bool
True
| Bool
otherwise = Bool
False
globalRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool
globalRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool
globalRegistersConflict Platform
platform CmmExpr
expr CmmNode e x
node =
Platform
-> (Bool -> GlobalReg -> Bool) -> Bool -> CmmNode e x -> Bool
forall r a b.
DefinerOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsDefd Platform
platform (\Bool
b GlobalReg
r -> Bool
b Bool -> Bool -> Bool
|| Platform -> CmmReg -> CmmExpr -> Bool
regUsedIn Platform
platform (GlobalReg -> CmmReg
CmmGlobal GlobalReg
r) CmmExpr
expr)
Bool
False CmmNode e x
node
localRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool
localRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool
localRegistersConflict Platform
platform CmmExpr
expr CmmNode e x
node =
Platform
-> (Bool -> LocalReg -> Bool) -> Bool -> CmmNode e x -> Bool
forall r a b.
DefinerOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsDefd Platform
platform (\Bool
b LocalReg
r -> Bool
b Bool -> Bool -> Bool
|| Platform -> CmmReg -> CmmExpr -> Bool
regUsedIn Platform
platform (LocalReg -> CmmReg
CmmLocal LocalReg
r) CmmExpr
expr)
Bool
False CmmNode e x
node
data AbsMem
= NoMem
| AnyMem
| HeapMem
| StackMem
| SpMem
{-# UNPACK #-} !Int
{-# UNPACK #-} !Int
bothMems :: AbsMem -> AbsMem -> AbsMem
bothMems :: AbsMem -> AbsMem -> AbsMem
bothMems AbsMem
NoMem AbsMem
x = AbsMem
x
bothMems AbsMem
x AbsMem
NoMem = AbsMem
x
bothMems AbsMem
HeapMem AbsMem
HeapMem = AbsMem
HeapMem
bothMems AbsMem
StackMem AbsMem
StackMem = AbsMem
StackMem
bothMems (SpMem Key
o1 Key
w1) (SpMem Key
o2 Key
w2)
| Key
o1 Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
o2 = Key -> Key -> AbsMem
SpMem Key
o1 (Key -> Key -> Key
forall a. Ord a => a -> a -> a
max Key
w1 Key
w2)
| Bool
otherwise = AbsMem
StackMem
bothMems SpMem{} AbsMem
StackMem = AbsMem
StackMem
bothMems AbsMem
StackMem SpMem{} = AbsMem
StackMem
bothMems AbsMem
_ AbsMem
_ = AbsMem
AnyMem
memConflicts :: AbsMem -> AbsMem -> Bool
memConflicts :: AbsMem -> AbsMem -> Bool
memConflicts AbsMem
NoMem AbsMem
_ = Bool
False
memConflicts AbsMem
_ AbsMem
NoMem = Bool
False
memConflicts AbsMem
HeapMem AbsMem
StackMem = Bool
False
memConflicts AbsMem
StackMem AbsMem
HeapMem = Bool
False
memConflicts SpMem{} AbsMem
HeapMem = Bool
False
memConflicts AbsMem
HeapMem SpMem{} = Bool
False
memConflicts (SpMem Key
o1 Key
w1) (SpMem Key
o2 Key
w2)
| Key
o1 Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Key
o2 = Key
o1 Key -> Key -> Key
forall a. Num a => a -> a -> a
+ Key
w1 Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
> Key
o2
| Bool
otherwise = Key
o2 Key -> Key -> Key
forall a. Num a => a -> a -> a
+ Key
w2 Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
> Key
o1
memConflicts AbsMem
_ AbsMem
_ = Bool
True
exprMem :: Platform -> CmmExpr -> AbsMem
exprMem :: Platform -> CmmExpr -> AbsMem
exprMem Platform
platform (CmmLoad CmmExpr
addr CmmType
w) = AbsMem -> AbsMem -> AbsMem
bothMems (Platform -> CmmExpr -> Width -> AbsMem
loadAddr Platform
platform CmmExpr
addr (CmmType -> Width
typeWidth CmmType
w)) (Platform -> CmmExpr -> AbsMem
exprMem Platform
platform CmmExpr
addr)
exprMem Platform
platform (CmmMachOp MachOp
_ [CmmExpr]
es) = (AbsMem -> AbsMem -> AbsMem) -> AbsMem -> [AbsMem] -> AbsMem
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AbsMem -> AbsMem -> AbsMem
bothMems AbsMem
NoMem ((CmmExpr -> AbsMem) -> [CmmExpr] -> [AbsMem]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmExpr -> AbsMem
exprMem Platform
platform) [CmmExpr]
es)
exprMem Platform
_ CmmExpr
_ = AbsMem
NoMem
loadAddr :: Platform -> CmmExpr -> Width -> AbsMem
loadAddr :: Platform -> CmmExpr -> Width -> AbsMem
loadAddr Platform
platform CmmExpr
e Width
w =
case CmmExpr
e of
CmmReg CmmReg
r -> Platform -> CmmReg -> Key -> Width -> AbsMem
regAddr Platform
platform CmmReg
r Key
0 Width
w
CmmRegOff CmmReg
r Key
i -> Platform -> CmmReg -> Key -> Width -> AbsMem
regAddr Platform
platform CmmReg
r Key
i Width
w
CmmExpr
_other | Platform -> CmmReg -> CmmExpr -> Bool
regUsedIn Platform
platform CmmReg
spReg CmmExpr
e -> AbsMem
StackMem
| Bool
otherwise -> AbsMem
AnyMem
regAddr :: Platform -> CmmReg -> Int -> Width -> AbsMem
regAddr :: Platform -> CmmReg -> Key -> Width -> AbsMem
regAddr Platform
_ (CmmGlobal GlobalReg
Sp) Key
i Width
w = Key -> Key -> AbsMem
SpMem Key
i (Width -> Key
widthInBytes Width
w)
regAddr Platform
_ (CmmGlobal GlobalReg
Hp) Key
_ Width
_ = AbsMem
HeapMem
regAddr Platform
_ (CmmGlobal GlobalReg
CurrentTSO) Key
_ Width
_ = AbsMem
HeapMem
regAddr Platform
platform CmmReg
r Key
_ Width
_ | CmmType -> Bool
isGcPtrType (Platform -> CmmReg -> CmmType
cmmRegType Platform
platform CmmReg
r) = AbsMem
HeapMem
regAddr Platform
_ CmmReg
_ Key
_ Width
_ = AbsMem
AnyMem