{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiWayIf #-}
module GHC.Cmm.Sink (
cmmSink
) where
import GHC.Prelude
import GHC.Cmm
import GHC.Cmm.Opt
import GHC.Cmm.Liveness
import GHC.Cmm.LRegSet
import GHC.Cmm.Utils
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.Dataflow.Graph
import GHC.Platform.Regs
import GHC.Platform
import GHC.Types.Unique.FM
import GHC.Types.Unique.DSM
import GHC.Cmm.Config
import Data.List (partition)
import Data.Maybe
import GHC.Exts (inline)
type Assignment = (LocalReg, CmmExpr, AbsMem)
type Assignments = [Assignment]
cmmSink :: CmmConfig -> CmmGraph -> UniqDSM CmmGraph
cmmSink :: CmmConfig -> CmmGraph -> UniqDSM CmmGraph
cmmSink CmmConfig
cfg CmmGraph
graph = BlockId -> [CmmBlock] -> CmmGraph
ofBlockList (CmmGraph -> BlockId
forall (s :: * -> *) (n :: Extensibility -> Extensibility -> *).
GenGenCmmGraph s n -> BlockId
g_entry CmmGraph
graph) ([CmmBlock] -> CmmGraph) -> UniqDSM [CmmBlock] -> UniqDSM CmmGraph
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LabelMap Assignments -> [CmmBlock] -> UniqDSM [CmmBlock]
sink LabelMap Assignments
forall v. LabelMap v
mapEmpty [CmmBlock]
blocks
where
platform :: Platform
platform = CmmConfig -> Platform
cmmPlatform CmmConfig
cfg
liveness :: BlockEntryLivenessL
liveness = Platform -> CmmGraph -> BlockEntryLivenessL
cmmLocalLivenessL Platform
platform CmmGraph
graph
getLive :: BlockId -> LRegSet
getLive BlockId
l = LRegSet -> BlockId -> BlockEntryLivenessL -> LRegSet
forall a. a -> BlockId -> LabelMap a -> a
mapFindWithDefault LRegSet
emptyLRegSet BlockId
l BlockEntryLivenessL
liveness
blocks :: [CmmBlock]
blocks = CmmGraph -> [CmmBlock]
revPostorder CmmGraph
graph
join_pts :: LabelMap Int
join_pts = [CmmBlock] -> LabelMap Int
findJoinPoints [CmmBlock]
blocks
sink :: LabelMap Assignments -> [CmmBlock] -> UniqDSM [CmmBlock]
sink :: LabelMap Assignments -> [CmmBlock] -> UniqDSM [CmmBlock]
sink LabelMap Assignments
_ [] = [CmmBlock] -> UniqDSM [CmmBlock]
forall a. a -> UniqDSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
sink LabelMap Assignments
sunk (CmmBlock
b:[CmmBlock]
bs) = do
(prepend, last_fold) <- CmmConfig
-> Opt (CmmNode O C) -> UniqDSM ([CmmNode O O], CmmNode O C)
forall a. CmmConfig -> Opt a -> UniqDSM ([CmmNode O O], a)
runOpt CmmConfig
cfg (Opt (CmmNode O C) -> UniqDSM ([CmmNode O O], CmmNode O C))
-> Opt (CmmNode O C) -> UniqDSM ([CmmNode O O], CmmNode O C)
forall a b. (a -> b) -> a -> b
$ CmmNode O C -> Opt (CmmNode O C)
forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> Opt (CmmNode e x)
constantFoldNode CmmNode O C
last
(middle', assigs) <- walk cfg (ann_middles ++ annotate platform live_middle prepend) (mapFindWithDefault [] lbl sunk)
let (final_last, assigs') = tryToInline platform live last_fold assigs
(dropped_last, assigs'') = dropAssignments platform drop_if init_live_sets assigs'
drop_if :: (LocalReg, CmmExpr, AbsMem)
-> [LRegSet] -> (Bool, [LRegSet])
drop_if a :: Assignment
a@(LocalReg
r,CmmExpr
rhs,AbsMem
_) [LRegSet]
live_sets = (Bool
should_drop, [LRegSet]
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
&& [LRegSet] -> LocalReg -> Bool
live_in_multi [LRegSet]
live_sets LocalReg
r
Bool -> Bool -> Bool
|| LocalReg
r LocalReg -> LRegSet -> Bool
`elemLRegSet` LRegSet
live_in_joins
live_sets' :: [LRegSet]
live_sets' | Bool
should_drop = [LRegSet]
live_sets
| Bool
otherwise = (LRegSet -> LRegSet) -> [LRegSet] -> [LRegSet]
forall a b. (a -> b) -> [a] -> [b]
map LRegSet -> LRegSet
upd [LRegSet]
live_sets
upd :: LRegSet -> LRegSet
upd LRegSet
set | LocalReg
r LocalReg -> LRegSet -> Bool
`elemLRegSet` LRegSet
set = LRegSet
set LRegSet -> LRegSet -> LRegSet
`unionLRegSet` LRegSet
live_rhs
| Bool
otherwise = LRegSet
set
live_rhs :: LRegSet
live_rhs = Platform
-> (LRegSet -> LocalReg -> LRegSet)
-> LRegSet
-> CmmExpr
-> LRegSet
forall b. Platform -> (b -> LocalReg -> b) -> b -> CmmExpr -> b
forall r a b.
UserOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsUsed Platform
platform ((LocalReg -> LRegSet -> LRegSet) -> LRegSet -> LocalReg -> LRegSet
forall a b c. (a -> b -> c) -> b -> a -> c
flip LocalReg -> LRegSet -> LRegSet
insertLRegSet) LRegSet
emptyLRegSet CmmExpr
rhs
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 b a. (b -> a -> b) -> b -> [a] -> b
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
-> LabelMap Assignments -> LabelMap Assignments
forall v. LabelMap v -> LabelMap v -> LabelMap v
mapUnion LabelMap Assignments
sunk (LabelMap Assignments -> LabelMap Assignments)
-> LabelMap Assignments -> LabelMap Assignments
forall a b. (a -> b) -> a -> b
$
[(BlockId, Assignments)] -> LabelMap Assignments
forall v. [(BlockId, v)] -> LabelMap v
mapFromList [ (BlockId
l, Platform -> LRegSet -> Assignments -> Assignments
filterAssignments Platform
platform (BlockId -> LRegSet
getLive BlockId
l) Assignments
assigs'')
| BlockId
l <- [BlockId]
succs ]
(blockJoin first final_middle final_last :) <$> sink sunk' bs
where
lbl :: BlockId
lbl = CmmBlock -> BlockId
forall (x :: Extensibility). Block CmmNode C x -> 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 (e :: Extensibility). CmmNode e C -> [BlockId]
forall (thing :: Extensibility -> Extensibility -> *)
(e :: Extensibility).
NonLocal thing =>
thing e C -> [BlockId]
successors CmmNode O C
last
live :: LRegSet
live = [LRegSet] -> LRegSet
unionsLRegSet ((BlockId -> LRegSet) -> [BlockId] -> [LRegSet]
forall a b. (a -> b) -> [a] -> [b]
map BlockId -> LRegSet
getLive [BlockId]
succs)
live_middle :: LRegSet
live_middle = Platform -> CmmNode O C -> LRegSet -> LRegSet
forall n.
(DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) =>
Platform -> n -> LRegSet -> LRegSet
gen_killL Platform
platform CmmNode O C
last LRegSet
live
ann_middles :: [(LRegSet, CmmNode O O)]
ann_middles = Platform -> LRegSet -> [CmmNode O O] -> [(LRegSet, CmmNode O O)]
annotate Platform
platform LRegSet
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)
([BlockId]
joins, [BlockId]
nonjoins) = (BlockId -> Bool) -> [BlockId] -> ([BlockId], [BlockId])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (BlockId -> LabelMap Int -> Bool
forall a. BlockId -> LabelMap a -> Bool
`mapMember` LabelMap Int
join_pts) [BlockId]
succs
live_in_joins :: LRegSet
live_in_joins = [LRegSet] -> LRegSet
unionsLRegSet ((BlockId -> LRegSet) -> [BlockId] -> [LRegSet]
forall a b. (a -> b) -> [a] -> [b]
map BlockId -> LRegSet
getLive [BlockId]
joins)
init_live_sets :: [LRegSet]
init_live_sets = (BlockId -> LRegSet) -> [BlockId] -> [LRegSet]
forall a b. (a -> b) -> [a] -> [b]
map BlockId -> LRegSet
getLive [BlockId]
nonjoins
live_in_multi :: [LRegSet] -> LocalReg -> Bool
live_in_multi [LRegSet]
live_sets LocalReg
r =
case (LRegSet -> Bool) -> [LRegSet] -> [LRegSet]
forall a. (a -> Bool) -> [a] -> [a]
filter (LocalReg -> LRegSet -> Bool
elemLRegSet LocalReg
r) [LRegSet]
live_sets of
(LRegSet
_one:LRegSet
_two:[LRegSet]
_) -> Bool
True
[LRegSet]
_ -> Bool
False
isTrivial :: Platform -> CmmExpr -> Bool
isTrivial :: Platform -> CmmExpr -> Bool
isTrivial Platform
_ (CmmReg (CmmLocal LocalReg
_)) = Bool
True
isTrivial Platform
platform (CmmReg (CmmGlobal (GlobalRegUse GlobalReg
r CmmType
_))) =
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 -> LRegSet -> [CmmNode O O] -> [(LRegSet, CmmNode O O)]
annotate :: Platform -> LRegSet -> [CmmNode O O] -> [(LRegSet, CmmNode O O)]
annotate Platform
platform LRegSet
live [CmmNode O O]
nodes = (LRegSet, [(LRegSet, CmmNode O O)]) -> [(LRegSet, CmmNode O O)]
forall a b. (a, b) -> b
snd ((LRegSet, [(LRegSet, CmmNode O O)]) -> [(LRegSet, CmmNode O O)])
-> (LRegSet, [(LRegSet, CmmNode O O)]) -> [(LRegSet, CmmNode O O)]
forall a b. (a -> b) -> a -> b
$ (CmmNode O O
-> (LRegSet, [(LRegSet, CmmNode O O)])
-> (LRegSet, [(LRegSet, CmmNode O O)]))
-> (LRegSet, [(LRegSet, CmmNode O O)])
-> [CmmNode O O]
-> (LRegSet, [(LRegSet, CmmNode O O)])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CmmNode O O
-> (LRegSet, [(LRegSet, CmmNode O O)])
-> (LRegSet, [(LRegSet, CmmNode O O)])
ann (LRegSet
live,[]) [CmmNode O O]
nodes
where ann :: CmmNode O O
-> (LRegSet, [(LRegSet, CmmNode O O)])
-> (LRegSet, [(LRegSet, CmmNode O O)])
ann CmmNode O O
n (LRegSet
live,[(LRegSet, CmmNode O O)]
nodes) = (Platform -> CmmNode O O -> LRegSet -> LRegSet
forall n.
(DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) =>
Platform -> n -> LRegSet -> LRegSet
gen_killL Platform
platform CmmNode O O
n LRegSet
live, (LRegSet
live,CmmNode O O
n) (LRegSet, CmmNode O O)
-> [(LRegSet, CmmNode O O)] -> [(LRegSet, CmmNode O O)]
forall a. a -> [a] -> [a]
: [(LRegSet, CmmNode O O)]
nodes)
findJoinPoints :: [CmmBlock] -> LabelMap Int
findJoinPoints :: [CmmBlock] -> LabelMap Int
findJoinPoints [CmmBlock]
blocks = (Int -> Bool) -> LabelMap Int -> LabelMap Int
forall v. (v -> Bool) -> LabelMap v -> LabelMap v
mapFilter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
1) LabelMap Int
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 (e :: Extensibility). Block CmmNode e C -> [BlockId]
forall (thing :: Extensibility -> Extensibility -> *)
(e :: Extensibility).
NonLocal thing =>
thing e C -> [BlockId]
successors [CmmBlock]
blocks
succ_counts :: LabelMap Int
succ_counts :: LabelMap Int
succ_counts = (LabelMap Int -> BlockId -> LabelMap Int)
-> LabelMap Int -> [BlockId] -> LabelMap Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\LabelMap Int
acc BlockId
l -> (Int -> Int -> Int)
-> BlockId -> Int -> LabelMap Int -> LabelMap Int
forall v. (v -> v -> v) -> BlockId -> v -> LabelMap v -> LabelMap v
mapInsertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) BlockId
l Int
1 LabelMap Int
acc) LabelMap Int
forall v. LabelMap v
mapEmpty [BlockId]
all_succs
filterAssignments :: Platform -> LRegSet -> Assignments -> Assignments
filterAssignments :: Platform -> LRegSet -> Assignments -> Assignments
filterAssignments Platform
platform LRegSet
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 -> LRegSet -> Bool
`elemLRegSet` LRegSet
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 :: CmmConfig
-> [(LRegSet, CmmNode O O)]
-> Assignments
-> UniqDSM ( Block CmmNode O O
, Assignments
)
walk :: CmmConfig
-> [(LRegSet, CmmNode O O)]
-> Assignments
-> UniqDSM (Block CmmNode O O, Assignments)
walk CmmConfig
cfg [(LRegSet, CmmNode O O)]
nodes Assignments
assigs = [(LRegSet, CmmNode O O)]
-> Block CmmNode O O
-> Assignments
-> UniqDSM (Block CmmNode O O, Assignments)
go [(LRegSet, CmmNode O O)]
nodes Block CmmNode O O
forall (n :: Extensibility -> Extensibility -> *). Block n O O
emptyBlock Assignments
assigs
where
platform :: Platform
platform = CmmConfig -> Platform
cmmPlatform CmmConfig
cfg
go :: [(LRegSet, CmmNode O O)]
-> Block CmmNode O O
-> Assignments
-> UniqDSM (Block CmmNode O O, Assignments)
go [] Block CmmNode O O
block Assignments
as = (Block CmmNode O O, Assignments)
-> UniqDSM (Block CmmNode O O, Assignments)
forall a. a -> UniqDSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block CmmNode O O
block, Assignments
as)
go ((LRegSet
live,CmmNode O O
node):[(LRegSet, CmmNode O O)]
ns) Block CmmNode O O
block Assignments
as
| CmmNode O O -> LRegSet -> Bool
forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> LRegSet -> Bool
shouldDiscard CmmNode O O
node LRegSet
live = [(LRegSet, CmmNode O O)]
-> Block CmmNode O O
-> Assignments
-> UniqDSM (Block CmmNode O O, Assignments)
go [(LRegSet, CmmNode O O)]
ns Block CmmNode O O
block Assignments
as
| Bool
otherwise = do
(prepend, node1) <- CmmConfig
-> Opt (CmmNode O O) -> UniqDSM ([CmmNode O O], CmmNode O O)
forall a. CmmConfig -> Opt a -> UniqDSM ([CmmNode O O], a)
runOpt CmmConfig
cfg (Opt (CmmNode O O) -> UniqDSM ([CmmNode O O], CmmNode O O))
-> Opt (CmmNode O O) -> UniqDSM ([CmmNode O O], CmmNode O O)
forall a b. (a -> b) -> a -> b
$ CmmNode O O -> Opt (CmmNode O O)
forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> Opt (CmmNode e x)
constantFoldNode CmmNode O O
node
if not (null prepend)
then go (annotate platform live (prepend ++ [node1]) ++ ns) block as
else do
let
(node2, as1) = tryToInline platform live node1 as
(dropped, as') = dropAssignmentsSimple 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) as1
block' = (Block CmmNode O O -> CmmNode O O -> Block CmmNode O O)
-> Block CmmNode O O -> [CmmNode O O] -> Block CmmNode O O
forall b a. (b -> a -> b) -> b -> [a] -> b
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
(prepend2, node3) <- runOpt cfg $ constantFoldNode node2
if | not (null prepend2) -> go (annotate platform live (prepend2 ++ [node3]) ++ ns) block as
| noOpAssignment node3 -> go ns block as
| Just a <- shouldSink platform node3 -> go ns block (a : as1)
| otherwise -> go ns block' as'
shouldSink :: Platform -> CmmNode e x -> Maybe Assignment
shouldSink :: forall (e :: Extensibility) (x :: Extensibility).
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 -> LRegSet -> Bool
shouldDiscard :: forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> LRegSet -> Bool
shouldDiscard CmmNode e x
node LRegSet
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 -> LRegSet -> Bool
`elemLRegSet` LRegSet
live)
CmmNode e x
_otherwise -> Bool
False
noOpAssignment :: CmmNode e x -> Bool
noOpAssignment :: forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> Bool
noOpAssignment CmmNode e x
node
= 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
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 :: forall s.
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 =
let !node :: CmmNode O O
node = Assignment -> CmmNode O O
toNode Assignment
assig
in s
-> Assignments
-> [CmmNode O O]
-> Assignments
-> ([CmmNode O O], Assignments)
go s
state' Assignments
rest (CmmNode O O
node 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
:: forall x. Platform
-> LRegSet
-> CmmNode O x
-> Assignments
-> (
CmmNode O x
, Assignments
)
tryToInline :: forall (x :: Extensibility).
Platform
-> LRegSet
-> CmmNode O x
-> Assignments
-> (CmmNode O x, Assignments)
tryToInline Platform
platform LRegSet
liveAfter CmmNode O x
node Assignments
assigs =
UniqFM LocalReg Int
-> LRegSet
-> CmmNode O x
-> LRegSet
-> Assignments
-> (CmmNode O x, Assignments)
go UniqFM LocalReg Int
usages LRegSet
liveAfter CmmNode O x
node LRegSet
emptyLRegSet Assignments
assigs
where
usages :: UniqFM LocalReg Int
usages :: UniqFM LocalReg Int
usages = Platform
-> (UniqFM LocalReg Int -> LocalReg -> UniqFM LocalReg Int)
-> UniqFM LocalReg Int
-> CmmNode O x
-> UniqFM LocalReg Int
forall a b.
UserOfRegs LocalReg a =>
Platform -> (b -> LocalReg -> b) -> b -> a -> b
foldLocalRegsUsed Platform
platform UniqFM LocalReg Int -> LocalReg -> UniqFM LocalReg Int
addUsage UniqFM LocalReg Int
forall {k} (key :: k) elt. UniqFM key elt
emptyUFM CmmNode O x
node
go :: UniqFM LocalReg Int -> LRegSet -> CmmNode O x -> LRegSet -> Assignments
-> (CmmNode O x, Assignments)
go :: UniqFM LocalReg Int
-> LRegSet
-> CmmNode O x
-> LRegSet
-> Assignments
-> (CmmNode O x, Assignments)
go UniqFM LocalReg Int
_usages LRegSet
_live CmmNode O x
node LRegSet
_skipped [] = (CmmNode O x
node, [])
go UniqFM LocalReg Int
usages LRegSet
live 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 Int
-> LRegSet
-> CmmNode O x
-> LRegSet
-> Assignments
-> (CmmNode O x, Assignments)
go UniqFM LocalReg Int
usages' LRegSet
live CmmNode O x
inl_node LRegSet
skipped Assignments
rest
where usages' :: UniqFM LocalReg Int
usages' = Platform
-> (UniqFM LocalReg Int -> LocalReg -> UniqFM LocalReg Int)
-> UniqFM LocalReg Int
-> CmmExpr
-> UniqFM LocalReg Int
forall a b.
UserOfRegs LocalReg a =>
Platform -> (b -> LocalReg -> b) -> b -> a -> b
foldLocalRegsUsed Platform
platform UniqFM LocalReg Int -> LocalReg -> UniqFM LocalReg Int
addUsage UniqFM LocalReg Int
usages CmmExpr
rhs
discard :: (CmmNode O x, Assignments)
discard = UniqFM LocalReg Int
-> LRegSet
-> CmmNode O x
-> LRegSet
-> Assignments
-> (CmmNode O x, Assignments)
go UniqFM LocalReg Int
usages LRegSet
live 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 -> (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 Int
-> LRegSet
-> CmmNode O x
-> LRegSet
-> Assignments
-> (CmmNode O x, Assignments)
go UniqFM LocalReg Int
usages LRegSet
live' CmmNode O x
node' (LocalReg -> LRegSet -> LRegSet
insertLRegSet LocalReg
l LRegSet
skipped) Assignments
rest
live' :: LRegSet
live' = (Platform
-> (LRegSet -> LocalReg -> LRegSet)
-> LRegSet
-> CmmExpr
-> LRegSet)
-> Platform
-> (LRegSet -> LocalReg -> LRegSet)
-> LRegSet
-> CmmExpr
-> LRegSet
forall a. a -> a
inline Platform
-> (LRegSet -> LocalReg -> LRegSet)
-> LRegSet
-> CmmExpr
-> LRegSet
forall a b.
UserOfRegs LocalReg a =>
Platform -> (b -> LocalReg -> b) -> b -> a -> b
foldLocalRegsUsed Platform
platform (\LRegSet
m LocalReg
r -> LocalReg -> LRegSet -> LRegSet
insertLRegSet LocalReg
r LRegSet
m)
LRegSet
live 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 Int
l_usages = UniqFM LocalReg Int -> LocalReg -> Maybe Int
forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM UniqFM LocalReg Int
usages LocalReg
l
l_live :: Bool
l_live = LocalReg
l LocalReg -> LRegSet -> Bool
`elemLRegSet` LRegSet
live
occurs_once :: Bool
occurs_once = Bool -> Bool
not Bool
l_live Bool -> Bool -> Bool
&& Maybe Int
l_usages Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
occurs_none :: Bool
occurs_none = Bool -> Bool
not Bool
l_live Bool -> Bool -> Bool
&& Maybe Int
l_usages Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
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') Int
off) | LocalReg
l LocalReg -> LocalReg -> Bool
forall a. Eq a => a -> a -> Bool
== LocalReg
l'
= Platform -> CmmExpr -> Int -> CmmExpr
cmmOffset Platform
platform CmmExpr
rhs Int
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 :: forall (x :: Extensibility). 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 a b. (a -> b) -> Maybe a -> Maybe b
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 Int -> LocalReg -> UniqFM LocalReg Int
addUsage UniqFM LocalReg Int
m LocalReg
r = (Int -> Int -> Int)
-> UniqFM LocalReg Int -> LocalReg -> Int -> UniqFM LocalReg Int
forall key elt.
Uniquable key =>
(elt -> elt -> elt)
-> UniqFM key elt -> key -> elt -> UniqFM key elt
addToUFM_C Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) UniqFM LocalReg Int
m LocalReg
r Int
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 = LRegSet -> CmmExpr -> Bool -> Bool
go LRegSet
ls CmmExpr
e Bool
False
where use :: LRegSet -> CmmExpr -> Bool -> Bool
use :: LRegSet -> CmmExpr -> Bool -> Bool
use LRegSet
ls (CmmReg (CmmLocal LocalReg
l)) Bool
_ | LocalReg
l LocalReg -> LRegSet -> Bool
`elemLRegSet` LRegSet
ls = Bool
True
use LRegSet
ls (CmmRegOff (CmmLocal LocalReg
l) Int
_) Bool
_ | LocalReg
l LocalReg -> LRegSet -> Bool
`elemLRegSet` LRegSet
ls = Bool
True
use LRegSet
_ls CmmExpr
_ Bool
z = Bool
z
go :: LRegSet -> CmmExpr -> Bool -> Bool
go :: LRegSet -> CmmExpr -> Bool -> Bool
go LRegSet
ls (CmmMachOp MachOp
_ [CmmExpr]
es) Bool
z = (CmmExpr -> Bool -> Bool) -> Bool -> [CmmExpr] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (LRegSet -> CmmExpr -> Bool -> Bool
go LRegSet
ls) Bool
z [CmmExpr]
es
go LRegSet
ls (CmmLoad CmmExpr
addr CmmType
_ AlignmentSpec
_) Bool
z = LRegSet -> CmmExpr -> Bool -> Bool
go LRegSet
ls CmmExpr
addr Bool
z
go LRegSet
ls CmmExpr
e Bool
z = LRegSet -> CmmExpr -> Bool -> Bool
use LRegSet
ls CmmExpr
e Bool
z
okToInline :: Platform -> CmmExpr -> CmmNode e x -> Bool
okToInline :: forall (e :: Extensibility) (x :: Extensibility).
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 :: forall (x :: Extensibility).
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 b. Platform -> (b -> LocalReg -> b) -> b -> CmmNode O x -> b
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 AlignmentSpec
_ <- 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 (GlobalRegUse GlobalReg
Hp CmmType
_)) CmmExpr
_ <- CmmNode O x
node = Bool
True
| AbsMem
StackMem <- AbsMem
addr, CmmAssign (CmmGlobal (GlobalRegUse GlobalReg
Sp CmmType
_)) CmmExpr
_ <- CmmNode O x
node = Bool
True
| SpMem{} <- AbsMem
addr, CmmAssign (CmmGlobal (GlobalRegUse GlobalReg
Sp CmmType
_)) CmmExpr
_ <- CmmNode O x
node = Bool
True
| CmmUnsafeForeignCall{} <- CmmNode O x
node, AbsMem -> AbsMem -> Bool
memConflicts AbsMem
addr AbsMem
AnyMem = Bool
True
| CmmUnsafeForeignCall (PrimTarget CallishMachOp
MO_SuspendThread) [LocalReg]
_ [CmmExpr]
_ <- CmmNode O x
node
, Platform -> (Bool -> GlobalReg -> Bool) -> Bool -> CmmExpr -> Bool
forall b. Platform -> (b -> GlobalReg -> b) -> b -> CmmExpr -> b
forall r a b.
UserOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsUsed Platform
platform (\Bool
b GlobalReg
g -> Platform -> GlobalReg -> Maybe RealReg
globalRegMaybe Platform
platform GlobalReg
g Maybe RealReg -> Maybe RealReg -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe RealReg
forall a. Maybe a
Nothing Bool -> Bool -> Bool
|| Bool
b) Bool
False CmmExpr
rhs
= 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 :: forall (e :: Extensibility) (x :: Extensibility).
Platform -> CmmExpr -> CmmNode e x -> Bool
globalRegistersConflict Platform
platform CmmExpr
expr CmmNode e x
node =
(Platform
-> (Bool -> GlobalRegUse -> Bool) -> Bool -> CmmNode e x -> Bool)
-> Platform
-> (Bool -> GlobalRegUse -> Bool)
-> Bool
-> CmmNode e x
-> Bool
forall a. a -> a
inline Platform
-> (Bool -> GlobalRegUse -> Bool) -> Bool -> CmmNode e x -> Bool
forall b.
Platform -> (b -> GlobalRegUse -> b) -> b -> CmmNode e x -> b
forall r a b.
DefinerOfRegs r a =>
Platform -> (b -> r -> b) -> b -> a -> b
foldRegsDefd Platform
platform (\Bool
b GlobalRegUse
r -> Bool
b Bool -> Bool -> Bool
|| Platform -> GlobalReg -> CmmExpr -> Bool
globalRegUsedIn Platform
platform (GlobalRegUse -> GlobalReg
globalRegUse_reg GlobalRegUse
r) CmmExpr
expr)
Bool
False CmmNode e x
node
localRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool
localRegistersConflict :: forall (e :: Extensibility) (x :: Extensibility).
Platform -> CmmExpr -> CmmNode e x -> Bool
localRegistersConflict Platform
platform CmmExpr
expr CmmNode e x
node =
(Platform
-> (Bool -> LocalReg -> Bool) -> Bool -> CmmNode e x -> Bool)
-> Platform
-> (Bool -> LocalReg -> Bool)
-> Bool
-> CmmNode e x
-> Bool
forall a. a -> a
inline Platform
-> (Bool -> LocalReg -> Bool) -> Bool -> CmmNode e x -> Bool
forall b. Platform -> (b -> LocalReg -> b) -> b -> CmmNode e x -> b
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 Int
o1 Int
w1) (SpMem Int
o2 Int
w2)
| Int
o1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
o2 = Int -> Int -> AbsMem
SpMem Int
o1 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
w1 Int
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 Int
o1 Int
w1) (SpMem Int
o2 Int
w2)
| Int
o1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
o2 = Int
o1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
o2
| Bool
otherwise = Int
o2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
o1
memConflicts AbsMem
_ AbsMem
_ = Bool
True
exprMem :: Platform -> CmmExpr -> AbsMem
exprMem :: Platform -> CmmExpr -> AbsMem
exprMem Platform
platform (CmmLoad CmmExpr
addr CmmType
w AlignmentSpec
_) = 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 a b. (a -> b -> b) -> b -> [a] -> b
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 -> CmmReg -> Int -> Width -> AbsMem
regAddr CmmReg
r Int
0 Width
w
CmmRegOff CmmReg
r Int
i -> CmmReg -> Int -> Width -> AbsMem
regAddr CmmReg
r Int
i Width
w
CmmExpr
_other | Platform -> CmmReg -> CmmExpr -> Bool
regUsedIn Platform
platform (Platform -> CmmReg
spReg Platform
platform) CmmExpr
e -> AbsMem
StackMem
| Bool
otherwise -> AbsMem
AnyMem
regAddr :: CmmReg -> Int -> Width -> AbsMem
regAddr :: CmmReg -> Int -> Width -> AbsMem
regAddr (CmmGlobal (GlobalRegUse GlobalReg
Sp CmmType
_)) Int
i Width
w = Int -> Int -> AbsMem
SpMem Int
i (Width -> Int
widthInBytes Width
w)
regAddr (CmmGlobal (GlobalRegUse GlobalReg
Hp CmmType
_)) Int
_ Width
_ = AbsMem
HeapMem
regAddr (CmmGlobal (GlobalRegUse GlobalReg
CurrentTSO CmmType
_)) Int
_ Width
_ = AbsMem
HeapMem
regAddr CmmReg
r Int
_ Width
_ | CmmType -> Bool
isGcPtrType (CmmReg -> CmmType
cmmRegType CmmReg
r) = AbsMem
HeapMem
regAddr CmmReg
_ Int
_ Width
_ = AbsMem
AnyMem