module RegAlloc.Linear.Base (
BlockAssignment,
Loc(..),
regsOfLoc,
SpillReason(..),
RegAllocStats(..),
RA_State(..),
)
where
import GhcPrelude
import RegAlloc.Linear.StackMap
import RegAlloc.Liveness
import Reg
import DynFlags
import Outputable
import Unique
import UniqFM
import UniqSupply
import BlockId
type BlockAssignment freeRegs
= BlockMap (freeRegs, RegMap Loc)
data Loc
= InReg !RealReg
| InMem {-# UNPACK #-} !StackSlot
| InBoth !RealReg
{-# UNPACK #-} !StackSlot
deriving (Loc -> Loc -> Bool
(Loc -> Loc -> Bool) -> (Loc -> Loc -> Bool) -> Eq Loc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Loc -> Loc -> Bool
$c/= :: Loc -> Loc -> Bool
== :: Loc -> Loc -> Bool
$c== :: Loc -> Loc -> Bool
Eq, Int -> Loc -> ShowS
[Loc] -> ShowS
Loc -> String
(Int -> Loc -> ShowS)
-> (Loc -> String) -> ([Loc] -> ShowS) -> Show Loc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Loc] -> ShowS
$cshowList :: [Loc] -> ShowS
show :: Loc -> String
$cshow :: Loc -> String
showsPrec :: Int -> Loc -> ShowS
$cshowsPrec :: Int -> Loc -> ShowS
Show, Eq Loc
Eq Loc
-> (Loc -> Loc -> Ordering)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Loc)
-> (Loc -> Loc -> Loc)
-> Ord Loc
Loc -> Loc -> Bool
Loc -> Loc -> Ordering
Loc -> Loc -> Loc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Loc -> Loc -> Loc
$cmin :: Loc -> Loc -> Loc
max :: Loc -> Loc -> Loc
$cmax :: Loc -> Loc -> Loc
>= :: Loc -> Loc -> Bool
$c>= :: Loc -> Loc -> Bool
> :: Loc -> Loc -> Bool
$c> :: Loc -> Loc -> Bool
<= :: Loc -> Loc -> Bool
$c<= :: Loc -> Loc -> Bool
< :: Loc -> Loc -> Bool
$c< :: Loc -> Loc -> Bool
compare :: Loc -> Loc -> Ordering
$ccompare :: Loc -> Loc -> Ordering
$cp1Ord :: Eq Loc
Ord)
instance Outputable Loc where
ppr :: Loc -> SDoc
ppr Loc
l = String -> SDoc
text (Loc -> String
forall a. Show a => a -> String
show Loc
l)
regsOfLoc :: Loc -> [RealReg]
regsOfLoc :: Loc -> [RealReg]
regsOfLoc (InReg RealReg
r) = [RealReg
r]
regsOfLoc (InBoth RealReg
r Int
_) = [RealReg
r]
regsOfLoc (InMem Int
_) = []
data SpillReason
= SpillAlloc !Unique
| SpillClobber !Unique
| SpillLoad !Unique
| SpillJoinRR !Unique
| SpillJoinRM !Unique
data RegAllocStats
= RegAllocStats
{ RegAllocStats -> UniqFM [Int]
ra_spillInstrs :: UniqFM [Int]
, RegAllocStats -> [(BlockId, BlockId, BlockId)]
ra_fixupList :: [(BlockId,BlockId,BlockId)]
}
data RA_State freeRegs
= RA_State
{
RA_State freeRegs -> BlockAssignment freeRegs
ra_blockassig :: BlockAssignment freeRegs
, RA_State freeRegs -> freeRegs
ra_freeregs :: !freeRegs
, RA_State freeRegs -> RegMap Loc
ra_assig :: RegMap Loc
, RA_State freeRegs -> Int
ra_delta :: Int
, RA_State freeRegs -> StackMap
ra_stack :: StackMap
, RA_State freeRegs -> UniqSupply
ra_us :: UniqSupply
, RA_State freeRegs -> [SpillReason]
ra_spills :: [SpillReason]
, RA_State freeRegs -> DynFlags
ra_DynFlags :: DynFlags
, RA_State freeRegs -> [(BlockId, BlockId, BlockId)]
ra_fixups :: [(BlockId,BlockId,BlockId)] }