module GHC.Platform.Reg (
RegNo,
Reg(..),
regPair,
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
import Data.List (intersect)
type RegNo
= Int
data VirtualReg
= VirtualRegI {-# UNPACK #-} !Unique
| VirtualRegHi {-# UNPACK #-} !Unique
| VirtualRegF {-# UNPACK #-} !Unique
| VirtualRegD {-# UNPACK #-} !Unique
deriving (VirtualReg -> VirtualReg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VirtualReg -> VirtualReg -> Bool
$c/= :: VirtualReg -> VirtualReg -> Bool
== :: VirtualReg -> VirtualReg -> Bool
$c== :: VirtualReg -> VirtualReg -> Bool
Eq, RegNo -> VirtualReg -> ShowS
[VirtualReg] -> ShowS
VirtualReg -> String
forall a.
(RegNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VirtualReg] -> ShowS
$cshowList :: [VirtualReg] -> ShowS
show :: VirtualReg -> String
$cshow :: VirtualReg -> String
showsPrec :: RegNo -> VirtualReg -> ShowS
$cshowsPrec :: RegNo -> 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
text String
"%vI_" SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
VirtualRegHi Unique
u -> String -> SDoc
text String
"%vHi_" SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
VirtualRegF Unique
u -> String -> SDoc
text String
"%vFloat_" SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
VirtualRegD Unique
u -> String -> SDoc
text String
"%vDouble_" SDoc -> SDoc -> SDoc
<> Unique -> SDoc
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
_ -> forall a. 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
_ -> forall a. String -> a
panic String
"Reg.getHiVRegFromLo"
data RealReg
= RealRegSingle {-# UNPACK #-} !RegNo
| RealRegPair {-# UNPACK #-} !RegNo {-# UNPACK #-} !RegNo
deriving (RealReg -> RealReg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RealReg -> RealReg -> Bool
$c/= :: RealReg -> RealReg -> Bool
== :: RealReg -> RealReg -> Bool
$c== :: RealReg -> RealReg -> Bool
Eq, RegNo -> RealReg -> ShowS
[RealReg] -> ShowS
RealReg -> String
forall a.
(RegNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RealReg] -> ShowS
$cshowList :: [RealReg] -> ShowS
show :: RealReg -> String
$cshow :: RealReg -> String
showsPrec :: RegNo -> RealReg -> ShowS
$cshowsPrec :: RegNo -> RealReg -> ShowS
Show, Eq 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
min :: RealReg -> RealReg -> RealReg
$cmin :: RealReg -> RealReg -> RealReg
max :: RealReg -> RealReg -> RealReg
$cmax :: RealReg -> RealReg -> RealReg
>= :: RealReg -> RealReg -> Bool
$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
compare :: RealReg -> RealReg -> Ordering
$ccompare :: RealReg -> RealReg -> Ordering
Ord)
instance Uniquable RealReg where
getUnique :: RealReg -> Unique
getUnique RealReg
reg
= case RealReg
reg of
RealRegSingle RegNo
i -> RegNo -> Unique
mkRegSingleUnique RegNo
i
RealRegPair RegNo
r1 RegNo
r2 -> RegNo -> Unique
mkRegPairUnique (RegNo
r1 forall a. Num a => a -> a -> a
* RegNo
65536 forall a. Num a => a -> a -> a
+ RegNo
r2)
instance Outputable RealReg where
ppr :: RealReg -> SDoc
ppr RealReg
reg
= case RealReg
reg of
RealRegSingle RegNo
i -> String -> SDoc
text String
"%r" SDoc -> SDoc -> SDoc
<> RegNo -> SDoc
int RegNo
i
RealRegPair RegNo
r1 RegNo
r2 -> String -> SDoc
text String
"%r(" SDoc -> SDoc -> SDoc
<> RegNo -> SDoc
int RegNo
r1
SDoc -> SDoc -> SDoc
<> SDoc
vbar SDoc -> SDoc -> SDoc
<> RegNo -> SDoc
int RegNo
r2 SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
")"
regNosOfRealReg :: RealReg -> [RegNo]
regNosOfRealReg :: RealReg -> [RegNo]
regNosOfRealReg RealReg
rr
= case RealReg
rr of
RealRegSingle RegNo
r1 -> [RegNo
r1]
RealRegPair RegNo
r1 RegNo
r2 -> [RegNo
r1, RegNo
r2]
realRegsAlias :: RealReg -> RealReg -> Bool
realRegsAlias :: RealReg -> RealReg -> Bool
realRegsAlias RealReg
rr1 RealReg
rr2
= Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [a]
intersect (RealReg -> [RegNo]
regNosOfRealReg RealReg
rr1) (RealReg -> [RegNo]
regNosOfRealReg RealReg
rr2)
data Reg
= RegVirtual !VirtualReg
| RegReal !RealReg
deriving (Reg -> Reg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reg -> Reg -> Bool
$c/= :: Reg -> Reg -> Bool
== :: Reg -> Reg -> Bool
$c== :: Reg -> Reg -> Bool
Eq, Eq 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
min :: Reg -> Reg -> Reg
$cmin :: Reg -> Reg -> Reg
max :: Reg -> Reg -> Reg
$cmax :: Reg -> Reg -> Reg
>= :: Reg -> Reg -> Bool
$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
compare :: Reg -> Reg -> Ordering
$ccompare :: Reg -> Reg -> Ordering
Ord, RegNo -> Reg -> ShowS
[Reg] -> ShowS
Reg -> String
forall a.
(RegNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reg] -> ShowS
$cshowList :: [Reg] -> ShowS
show :: Reg -> String
$cshow :: Reg -> String
showsPrec :: RegNo -> Reg -> ShowS
$cshowsPrec :: RegNo -> 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
regPair :: RegNo -> RegNo -> Reg
regPair :: RegNo -> RegNo -> Reg
regPair RegNo
regNo1 RegNo
regNo2 = RealReg -> Reg
RegReal forall a b. (a -> b) -> a -> b
$ RegNo -> RegNo -> RealReg
RealRegPair RegNo
regNo1 RegNo
regNo2
instance Uniquable Reg where
getUnique :: Reg -> Unique
getUnique Reg
reg
= case Reg
reg of
RegVirtual VirtualReg
vr -> forall a. Uniquable a => a -> Unique
getUnique VirtualReg
vr
RegReal RealReg
rr -> 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 -> forall a. Outputable a => a -> SDoc
ppr VirtualReg
vr
RegReal RealReg
rr -> 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 -> forall a. a -> Maybe a
Just RealReg
rr
Reg
_ -> 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
_ -> forall a. Maybe a
Nothing
RegVirtual VirtualReg
vr -> 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