module GHC.Platform.Reg (
RegNo,
Reg(..),
regSingle,
realRegSingle,
isRealReg, takeRealReg,
isVirtualReg, takeVirtualReg,
VirtualReg(..),
renameVirtualReg,
classOfVirtualReg,
getHiVirtualRegFromLo,
getHiVRegFromLo,
RealReg(..),
regNosOfRealReg,
realRegsAlias,
liftPatchFnToRegReg
)
where
import GHC.Prelude
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Types.Unique
import GHC.Builtin.Uniques
import GHC.Platform.Reg.Class
type RegNo
= Int
data VirtualReg
= VirtualRegI {-# UNPACK #-} !Unique
| VirtualRegHi {-# UNPACK #-} !Unique
| VirtualRegF {-# UNPACK #-} !Unique
| VirtualRegD {-# UNPACK #-} !Unique
deriving (VirtualReg -> VirtualReg -> Bool
(VirtualReg -> VirtualReg -> Bool)
-> (VirtualReg -> VirtualReg -> Bool) -> Eq VirtualReg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VirtualReg -> VirtualReg -> Bool
== :: VirtualReg -> VirtualReg -> Bool
$c/= :: VirtualReg -> VirtualReg -> Bool
/= :: VirtualReg -> VirtualReg -> Bool
Eq, RegNo -> VirtualReg -> ShowS
[VirtualReg] -> ShowS
VirtualReg -> String
(RegNo -> VirtualReg -> ShowS)
-> (VirtualReg -> String)
-> ([VirtualReg] -> ShowS)
-> Show VirtualReg
forall a.
(RegNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: RegNo -> VirtualReg -> ShowS
showsPrec :: RegNo -> VirtualReg -> ShowS
$cshow :: VirtualReg -> String
show :: VirtualReg -> String
$cshowList :: [VirtualReg] -> ShowS
showList :: [VirtualReg] -> ShowS
Show)
instance Ord VirtualReg where
compare :: VirtualReg -> VirtualReg -> Ordering
compare (VirtualRegI Unique
a) (VirtualRegI Unique
b) = Unique -> Unique -> Ordering
nonDetCmpUnique Unique
a Unique
b
compare (VirtualRegHi Unique
a) (VirtualRegHi Unique
b) = Unique -> Unique -> Ordering
nonDetCmpUnique Unique
a Unique
b
compare (VirtualRegF Unique
a) (VirtualRegF Unique
b) = Unique -> Unique -> Ordering
nonDetCmpUnique Unique
a Unique
b
compare (VirtualRegD Unique
a) (VirtualRegD Unique
b) = Unique -> Unique -> Ordering
nonDetCmpUnique Unique
a Unique
b
compare VirtualRegI{} VirtualReg
_ = Ordering
LT
compare VirtualReg
_ VirtualRegI{} = Ordering
GT
compare VirtualRegHi{} VirtualReg
_ = Ordering
LT
compare VirtualReg
_ VirtualRegHi{} = Ordering
GT
compare VirtualRegF{} VirtualReg
_ = Ordering
LT
compare VirtualReg
_ VirtualRegF{} = Ordering
GT
instance Uniquable VirtualReg where
getUnique :: VirtualReg -> Unique
getUnique VirtualReg
reg
= case VirtualReg
reg of
VirtualRegI Unique
u -> Unique
u
VirtualRegHi Unique
u -> Unique
u
VirtualRegF Unique
u -> Unique
u
VirtualRegD Unique
u -> Unique
u
instance Outputable VirtualReg where
ppr :: VirtualReg -> SDoc
ppr VirtualReg
reg
= case VirtualReg
reg of
VirtualRegI Unique
u -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"%vI_" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> SDoc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u
VirtualRegHi Unique
u -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"%vHi_" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> SDoc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u
VirtualRegF Unique
u -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"%vFloat_" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> SDoc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u
VirtualRegD Unique
u -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"%vDouble_" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> SDoc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u
renameVirtualReg :: Unique -> VirtualReg -> VirtualReg
renameVirtualReg :: Unique -> VirtualReg -> VirtualReg
renameVirtualReg Unique
u VirtualReg
r
= case VirtualReg
r of
VirtualRegI Unique
_ -> Unique -> VirtualReg
VirtualRegI Unique
u
VirtualRegHi Unique
_ -> Unique -> VirtualReg
VirtualRegHi Unique
u
VirtualRegF Unique
_ -> Unique -> VirtualReg
VirtualRegF Unique
u
VirtualRegD Unique
_ -> Unique -> VirtualReg
VirtualRegD Unique
u
classOfVirtualReg :: VirtualReg -> RegClass
classOfVirtualReg :: VirtualReg -> RegClass
classOfVirtualReg VirtualReg
vr
= case VirtualReg
vr of
VirtualRegI{} -> RegClass
RcInteger
VirtualRegHi{} -> RegClass
RcInteger
VirtualRegF{} -> RegClass
RcFloat
VirtualRegD{} -> RegClass
RcDouble
getHiVirtualRegFromLo :: VirtualReg -> VirtualReg
getHiVirtualRegFromLo :: VirtualReg -> VirtualReg
getHiVirtualRegFromLo VirtualReg
reg
= case VirtualReg
reg of
VirtualRegI Unique
u -> Unique -> VirtualReg
VirtualRegHi (Unique -> Char -> Unique
newTagUnique Unique
u Char
'H')
VirtualReg
_ -> String -> VirtualReg
forall a. HasCallStack => String -> a
panic String
"Reg.getHiVirtualRegFromLo"
getHiVRegFromLo :: Reg -> Reg
getHiVRegFromLo :: Reg -> Reg
getHiVRegFromLo Reg
reg
= case Reg
reg of
RegVirtual VirtualReg
vr -> VirtualReg -> Reg
RegVirtual (VirtualReg -> VirtualReg
getHiVirtualRegFromLo VirtualReg
vr)
RegReal RealReg
_ -> String -> Reg
forall a. HasCallStack => String -> a
panic String
"Reg.getHiVRegFromLo"
newtype RealReg
= RealRegSingle RegNo
deriving (RealReg -> RealReg -> Bool
(RealReg -> RealReg -> Bool)
-> (RealReg -> RealReg -> Bool) -> Eq RealReg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RealReg -> RealReg -> Bool
== :: RealReg -> RealReg -> Bool
$c/= :: RealReg -> RealReg -> Bool
/= :: RealReg -> RealReg -> Bool
Eq, RegNo -> RealReg -> ShowS
[RealReg] -> ShowS
RealReg -> String
(RegNo -> RealReg -> ShowS)
-> (RealReg -> String) -> ([RealReg] -> ShowS) -> Show RealReg
forall a.
(RegNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: RegNo -> RealReg -> ShowS
showsPrec :: RegNo -> RealReg -> ShowS
$cshow :: RealReg -> String
show :: RealReg -> String
$cshowList :: [RealReg] -> ShowS
showList :: [RealReg] -> ShowS
Show, Eq RealReg
Eq RealReg =>
(RealReg -> RealReg -> Ordering)
-> (RealReg -> RealReg -> Bool)
-> (RealReg -> RealReg -> Bool)
-> (RealReg -> RealReg -> Bool)
-> (RealReg -> RealReg -> Bool)
-> (RealReg -> RealReg -> RealReg)
-> (RealReg -> RealReg -> RealReg)
-> Ord RealReg
RealReg -> RealReg -> Bool
RealReg -> RealReg -> Ordering
RealReg -> RealReg -> RealReg
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
$ccompare :: RealReg -> RealReg -> Ordering
compare :: RealReg -> RealReg -> Ordering
$c< :: RealReg -> RealReg -> Bool
< :: RealReg -> RealReg -> Bool
$c<= :: RealReg -> RealReg -> Bool
<= :: RealReg -> RealReg -> Bool
$c> :: RealReg -> RealReg -> Bool
> :: RealReg -> RealReg -> Bool
$c>= :: RealReg -> RealReg -> Bool
>= :: RealReg -> RealReg -> Bool
$cmax :: RealReg -> RealReg -> RealReg
max :: RealReg -> RealReg -> RealReg
$cmin :: RealReg -> RealReg -> RealReg
min :: RealReg -> RealReg -> RealReg
Ord)
instance Uniquable RealReg where
getUnique :: RealReg -> Unique
getUnique RealReg
reg
= case RealReg
reg of
RealRegSingle RegNo
i -> RegNo -> Unique
mkRegSingleUnique RegNo
i
instance Outputable RealReg where
ppr :: RealReg -> SDoc
ppr RealReg
reg
= case RealReg
reg of
RealRegSingle RegNo
i -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"%r" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> RegNo -> SDoc
forall doc. IsLine doc => RegNo -> doc
int RegNo
i
regNosOfRealReg :: RealReg -> [RegNo]
regNosOfRealReg :: RealReg -> [RegNo]
regNosOfRealReg RealReg
rr
= case RealReg
rr of
RealRegSingle RegNo
r1 -> [RegNo
r1]
realRegsAlias :: RealReg -> RealReg -> Bool
realRegsAlias :: RealReg -> RealReg -> Bool
realRegsAlias RealReg
rr1 RealReg
rr2 =
case RealReg
rr1 of
RealRegSingle RegNo
r1 ->
case RealReg
rr2 of RealRegSingle RegNo
r2 -> RegNo
r1 RegNo -> RegNo -> Bool
forall a. Eq a => a -> a -> Bool
== RegNo
r2
data Reg
= RegVirtual !VirtualReg
| RegReal !RealReg
deriving (Reg -> Reg -> Bool
(Reg -> Reg -> Bool) -> (Reg -> Reg -> Bool) -> Eq Reg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Reg -> Reg -> Bool
== :: Reg -> Reg -> Bool
$c/= :: Reg -> Reg -> Bool
/= :: Reg -> Reg -> Bool
Eq, Eq Reg
Eq Reg =>
(Reg -> Reg -> Ordering)
-> (Reg -> Reg -> Bool)
-> (Reg -> Reg -> Bool)
-> (Reg -> Reg -> Bool)
-> (Reg -> Reg -> Bool)
-> (Reg -> Reg -> Reg)
-> (Reg -> Reg -> Reg)
-> Ord Reg
Reg -> Reg -> Bool
Reg -> Reg -> Ordering
Reg -> Reg -> Reg
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
$ccompare :: Reg -> Reg -> Ordering
compare :: Reg -> Reg -> Ordering
$c< :: Reg -> Reg -> Bool
< :: Reg -> Reg -> Bool
$c<= :: Reg -> Reg -> Bool
<= :: Reg -> Reg -> Bool
$c> :: Reg -> Reg -> Bool
> :: Reg -> Reg -> Bool
$c>= :: Reg -> Reg -> Bool
>= :: Reg -> Reg -> Bool
$cmax :: Reg -> Reg -> Reg
max :: Reg -> Reg -> Reg
$cmin :: Reg -> Reg -> Reg
min :: Reg -> Reg -> Reg
Ord, RegNo -> Reg -> ShowS
[Reg] -> ShowS
Reg -> String
(RegNo -> Reg -> ShowS)
-> (Reg -> String) -> ([Reg] -> ShowS) -> Show Reg
forall a.
(RegNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: RegNo -> Reg -> ShowS
showsPrec :: RegNo -> Reg -> ShowS
$cshow :: Reg -> String
show :: Reg -> String
$cshowList :: [Reg] -> ShowS
showList :: [Reg] -> ShowS
Show)
regSingle :: RegNo -> Reg
regSingle :: RegNo -> Reg
regSingle RegNo
regNo = RealReg -> Reg
RegReal (RegNo -> RealReg
realRegSingle RegNo
regNo)
realRegSingle :: RegNo -> RealReg
realRegSingle :: RegNo -> RealReg
realRegSingle RegNo
regNo = RegNo -> RealReg
RealRegSingle RegNo
regNo
instance Uniquable Reg where
getUnique :: Reg -> Unique
getUnique Reg
reg
= case Reg
reg of
RegVirtual VirtualReg
vr -> VirtualReg -> Unique
forall a. Uniquable a => a -> Unique
getUnique VirtualReg
vr
RegReal RealReg
rr -> RealReg -> Unique
forall a. Uniquable a => a -> Unique
getUnique RealReg
rr
instance Outputable Reg where
ppr :: Reg -> SDoc
ppr Reg
reg
= case Reg
reg of
RegVirtual VirtualReg
vr -> VirtualReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr VirtualReg
vr
RegReal RealReg
rr -> RealReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealReg
rr
isRealReg :: Reg -> Bool
isRealReg :: Reg -> Bool
isRealReg Reg
reg
= case Reg
reg of
RegReal RealReg
_ -> Bool
True
RegVirtual VirtualReg
_ -> Bool
False
takeRealReg :: Reg -> Maybe RealReg
takeRealReg :: Reg -> Maybe RealReg
takeRealReg Reg
reg
= case Reg
reg of
RegReal RealReg
rr -> RealReg -> Maybe RealReg
forall a. a -> Maybe a
Just RealReg
rr
Reg
_ -> Maybe RealReg
forall a. Maybe a
Nothing
isVirtualReg :: Reg -> Bool
isVirtualReg :: Reg -> Bool
isVirtualReg Reg
reg
= case Reg
reg of
RegReal RealReg
_ -> Bool
False
RegVirtual VirtualReg
_ -> Bool
True
takeVirtualReg :: Reg -> Maybe VirtualReg
takeVirtualReg :: Reg -> Maybe VirtualReg
takeVirtualReg Reg
reg
= case Reg
reg of
RegReal RealReg
_ -> Maybe VirtualReg
forall a. Maybe a
Nothing
RegVirtual VirtualReg
vr -> VirtualReg -> Maybe VirtualReg
forall a. a -> Maybe a
Just VirtualReg
vr
liftPatchFnToRegReg :: (VirtualReg -> RealReg) -> (Reg -> Reg)
liftPatchFnToRegReg :: (VirtualReg -> RealReg) -> Reg -> Reg
liftPatchFnToRegReg VirtualReg -> RealReg
patchF Reg
reg
= case Reg
reg of
RegVirtual VirtualReg
vr -> RealReg -> Reg
RegReal (VirtualReg -> RealReg
patchF VirtualReg
vr)
RegReal RealReg
_ -> Reg
reg