{-# LANGUAGE MagicHash #-}
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.Exts ( Int(I#), dataToTag# )
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Types.Unique
import GHC.Builtin.Uniques
import GHC.Platform.Reg.Class
import qualified GHC.Platform.Reg.Class.Unified as Unified
import qualified GHC.Platform.Reg.Class.Separate as Separate
import qualified GHC.Platform.Reg.Class.NoVectors as NoVectors
import GHC.Platform.ArchOS
type RegNo
= Int
data VirtualReg
= VirtualRegI { VirtualReg -> Unique
virtualRegUnique :: {-# UNPACK #-} !Unique }
| VirtualRegHi { virtualRegUnique :: {-# UNPACK #-} !Unique }
| VirtualRegD { virtualRegUnique :: {-# UNPACK #-} !Unique }
| VirtualRegV128 { virtualRegUnique :: {-# 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 VirtualReg
vr1 VirtualReg
vr2 =
case RegNo -> RegNo -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int# -> RegNo
I# (VirtualReg -> Int#
forall a. DataToTag a => a -> Int#
dataToTag# VirtualReg
vr1)) (Int# -> RegNo
I# (VirtualReg -> Int#
forall a. DataToTag a => a -> Int#
dataToTag# VirtualReg
vr2)) of
Ordering
LT -> Ordering
LT
Ordering
GT -> Ordering
GT
Ordering
EQ -> Unique -> Unique -> Ordering
nonDetCmpUnique (VirtualReg -> Unique
virtualRegUnique VirtualReg
vr1) (VirtualReg -> Unique
virtualRegUnique VirtualReg
vr2)
instance Uniquable VirtualReg where
getUnique :: VirtualReg -> Unique
getUnique = VirtualReg -> Unique
virtualRegUnique
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
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
VirtualRegV128 Unique
u -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"%vV128_" 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 = VirtualReg
r { virtualRegUnique = u }
classOfVirtualReg :: Arch -> VirtualReg -> RegClass
classOfVirtualReg :: Arch -> VirtualReg -> RegClass
classOfVirtualReg Arch
arch VirtualReg
vr
= case VirtualReg
vr of
VirtualRegI{} ->
case RegArch
regArch of
RegArch
Unified -> RegClass
Unified.RcInteger
RegArch
Separate -> RegClass
Separate.RcInteger
RegArch
NoVectors -> RegClass
NoVectors.RcInteger
VirtualRegHi{} ->
case RegArch
regArch of
RegArch
Unified -> RegClass
Unified.RcInteger
RegArch
Separate -> RegClass
Separate.RcInteger
RegArch
NoVectors -> RegClass
NoVectors.RcInteger
VirtualRegD{} ->
case RegArch
regArch of
RegArch
Unified -> RegClass
Unified.RcFloatOrVector
RegArch
Separate -> RegClass
Separate.RcFloat
RegArch
NoVectors -> RegClass
NoVectors.RcFloat
VirtualRegV128{} ->
case RegArch
regArch of
RegArch
Unified -> RegClass
Unified.RcFloatOrVector
RegArch
Separate -> RegClass
Separate.RcVector
RegArch
NoVectors -> String -> SDoc -> RegClass
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"classOfVirtualReg VirtualRegV128"
( String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"arch:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text ( Arch -> String
forall a. Show a => a -> String
show Arch
arch ) )
where
regArch :: RegArch
regArch = Arch -> RegArch
registerArch Arch
arch
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