{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module GHC.Cmm.Reg
(
CmmReg(..)
, cmmRegType
, cmmRegWidth
, LocalReg(..)
, localRegType
, GlobalReg(..), isArgReg, globalRegSpillType, pprGlobalReg
, spReg, hpReg, spLimReg, hpLimReg, nodeReg
, currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg
, node, baseReg
, GlobalRegUse(..), pprGlobalRegUse
, GlobalArgRegs(..)
) where
import GHC.Prelude
import GHC.Platform
import GHC.Utils.Outputable
import GHC.Types.Unique
import GHC.Cmm.Type
data GlobalRegUse
= GlobalRegUse
{ GlobalRegUse -> GlobalReg
globalRegUse_reg :: !GlobalReg
, GlobalRegUse -> CmmType
globalRegUse_type :: !CmmType
}
deriving Int -> GlobalRegUse -> ShowS
[GlobalRegUse] -> ShowS
GlobalRegUse -> String
(Int -> GlobalRegUse -> ShowS)
-> (GlobalRegUse -> String)
-> ([GlobalRegUse] -> ShowS)
-> Show GlobalRegUse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GlobalRegUse -> ShowS
showsPrec :: Int -> GlobalRegUse -> ShowS
$cshow :: GlobalRegUse -> String
show :: GlobalRegUse -> String
$cshowList :: [GlobalRegUse] -> ShowS
showList :: [GlobalRegUse] -> ShowS
Show
instance Outputable GlobalRegUse where
ppr :: GlobalRegUse -> SDoc
ppr (GlobalRegUse GlobalReg
reg CmmType
_) = GlobalReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr GlobalReg
reg
pprGlobalRegUse :: IsLine doc => GlobalRegUse -> doc
pprGlobalRegUse :: forall doc. IsLine doc => GlobalRegUse -> doc
pprGlobalRegUse (GlobalRegUse GlobalReg
reg CmmType
_) = GlobalReg -> doc
forall doc. IsLine doc => GlobalReg -> doc
pprGlobalReg GlobalReg
reg
instance Eq GlobalRegUse where
GlobalRegUse GlobalReg
r1 CmmType
_ == :: GlobalRegUse -> GlobalRegUse -> Bool
== GlobalRegUse GlobalReg
r2 CmmType
_ = GlobalReg
r1 GlobalReg -> GlobalReg -> Bool
forall a. Eq a => a -> a -> Bool
== GlobalReg
r2
instance Ord GlobalRegUse where
GlobalRegUse GlobalReg
r1 CmmType
_ compare :: GlobalRegUse -> GlobalRegUse -> Ordering
`compare` GlobalRegUse GlobalReg
r2 CmmType
_ = GlobalReg -> GlobalReg -> Ordering
forall a. Ord a => a -> a -> Ordering
compare GlobalReg
r1 GlobalReg
r2
data CmmReg
= CmmLocal {-# UNPACK #-} !LocalReg
| CmmGlobal GlobalRegUse
deriving ( CmmReg -> CmmReg -> Bool
(CmmReg -> CmmReg -> Bool)
-> (CmmReg -> CmmReg -> Bool) -> Eq CmmReg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CmmReg -> CmmReg -> Bool
== :: CmmReg -> CmmReg -> Bool
$c/= :: CmmReg -> CmmReg -> Bool
/= :: CmmReg -> CmmReg -> Bool
Eq, Eq CmmReg
Eq CmmReg =>
(CmmReg -> CmmReg -> Ordering)
-> (CmmReg -> CmmReg -> Bool)
-> (CmmReg -> CmmReg -> Bool)
-> (CmmReg -> CmmReg -> Bool)
-> (CmmReg -> CmmReg -> Bool)
-> (CmmReg -> CmmReg -> CmmReg)
-> (CmmReg -> CmmReg -> CmmReg)
-> Ord CmmReg
CmmReg -> CmmReg -> Bool
CmmReg -> CmmReg -> Ordering
CmmReg -> CmmReg -> CmmReg
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 :: CmmReg -> CmmReg -> Ordering
compare :: CmmReg -> CmmReg -> Ordering
$c< :: CmmReg -> CmmReg -> Bool
< :: CmmReg -> CmmReg -> Bool
$c<= :: CmmReg -> CmmReg -> Bool
<= :: CmmReg -> CmmReg -> Bool
$c> :: CmmReg -> CmmReg -> Bool
> :: CmmReg -> CmmReg -> Bool
$c>= :: CmmReg -> CmmReg -> Bool
>= :: CmmReg -> CmmReg -> Bool
$cmax :: CmmReg -> CmmReg -> CmmReg
max :: CmmReg -> CmmReg -> CmmReg
$cmin :: CmmReg -> CmmReg -> CmmReg
min :: CmmReg -> CmmReg -> CmmReg
Ord, Int -> CmmReg -> ShowS
[CmmReg] -> ShowS
CmmReg -> String
(Int -> CmmReg -> ShowS)
-> (CmmReg -> String) -> ([CmmReg] -> ShowS) -> Show CmmReg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CmmReg -> ShowS
showsPrec :: Int -> CmmReg -> ShowS
$cshow :: CmmReg -> String
show :: CmmReg -> String
$cshowList :: [CmmReg] -> ShowS
showList :: [CmmReg] -> ShowS
Show )
instance Outputable CmmReg where
ppr :: CmmReg -> SDoc
ppr CmmReg
e = CmmReg -> SDoc
pprReg CmmReg
e
pprReg :: CmmReg -> SDoc
pprReg :: CmmReg -> SDoc
pprReg CmmReg
r
= case CmmReg
r of
CmmLocal LocalReg
local -> LocalReg -> SDoc
pprLocalReg LocalReg
local
CmmGlobal (GlobalRegUse GlobalReg
global CmmType
_ty) -> GlobalReg -> SDoc
forall doc. IsLine doc => GlobalReg -> doc
pprGlobalReg GlobalReg
global
cmmRegType :: CmmReg -> CmmType
cmmRegType :: CmmReg -> CmmType
cmmRegType (CmmLocal LocalReg
reg) = LocalReg -> CmmType
localRegType LocalReg
reg
cmmRegType (CmmGlobal GlobalRegUse
reg) = GlobalRegUse -> CmmType
globalRegUse_type GlobalRegUse
reg
cmmRegWidth :: CmmReg -> Width
cmmRegWidth :: CmmReg -> Width
cmmRegWidth = CmmType -> Width
typeWidth (CmmType -> Width) -> (CmmReg -> CmmType) -> CmmReg -> Width
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmReg -> CmmType
cmmRegType
data LocalReg
= LocalReg {-# UNPACK #-} !Unique !CmmType
deriving Int -> LocalReg -> ShowS
[LocalReg] -> ShowS
LocalReg -> String
(Int -> LocalReg -> ShowS)
-> (LocalReg -> String) -> ([LocalReg] -> ShowS) -> Show LocalReg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LocalReg -> ShowS
showsPrec :: Int -> LocalReg -> ShowS
$cshow :: LocalReg -> String
show :: LocalReg -> String
$cshowList :: [LocalReg] -> ShowS
showList :: [LocalReg] -> ShowS
Show
instance Eq LocalReg where
(LocalReg Unique
u1 CmmType
_) == :: LocalReg -> LocalReg -> Bool
== (LocalReg Unique
u2 CmmType
_) = Unique
u1 Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== Unique
u2
instance Outputable LocalReg where
ppr :: LocalReg -> SDoc
ppr LocalReg
e = LocalReg -> SDoc
pprLocalReg LocalReg
e
instance Ord LocalReg where
compare :: LocalReg -> LocalReg -> Ordering
compare (LocalReg Unique
u1 CmmType
_) (LocalReg Unique
u2 CmmType
_) = Unique -> Unique -> Ordering
nonDetCmpUnique Unique
u1 Unique
u2
instance Uniquable LocalReg where
getUnique :: LocalReg -> Unique
getUnique (LocalReg Unique
uniq CmmType
_) = Unique
uniq
localRegType :: LocalReg -> CmmType
localRegType :: LocalReg -> CmmType
localRegType (LocalReg Unique
_ CmmType
rep) = CmmType
rep
pprLocalReg :: LocalReg -> SDoc
pprLocalReg :: LocalReg -> SDoc
pprLocalReg (LocalReg Unique
uniq CmmType
rep) =
Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'_' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> SDoc
forall a. Outputable a => a -> SDoc
pprUnique Unique
uniq SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
(if CmmType -> Bool
isWord32 CmmType
rep
then SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
ptr SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> CmmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmType
rep
else SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
ptr SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> CmmType -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmType
rep)
where
pprUnique :: a -> SDoc
pprUnique a
unique = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocSuppressUniques ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
Bool
True -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"_locVar_"
Bool
False -> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
unique
ptr :: SDoc
ptr = SDoc
forall doc. IsOutput doc => doc
empty
data GlobalReg
= VanillaReg
{-# UNPACK #-} !Int
| FloatReg
{-# UNPACK #-} !Int
| DoubleReg
{-# UNPACK #-} !Int
| LongReg
{-# UNPACK #-} !Int
| XmmReg
{-# UNPACK #-} !Int
| YmmReg
{-# UNPACK #-} !Int
| ZmmReg
{-# UNPACK #-} !Int
| Sp
| SpLim
| Hp
| HpLim
| CCCS
| CurrentTSO
| CurrentNursery
| HpAlloc
| EagerBlackholeInfo
| GCEnter1
| GCFun
| BaseReg
| MachSp
| UnwindReturnReg
| PicBaseReg
deriving( GlobalReg -> GlobalReg -> Bool
(GlobalReg -> GlobalReg -> Bool)
-> (GlobalReg -> GlobalReg -> Bool) -> Eq GlobalReg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GlobalReg -> GlobalReg -> Bool
== :: GlobalReg -> GlobalReg -> Bool
$c/= :: GlobalReg -> GlobalReg -> Bool
/= :: GlobalReg -> GlobalReg -> Bool
Eq, Eq GlobalReg
Eq GlobalReg =>
(GlobalReg -> GlobalReg -> Ordering)
-> (GlobalReg -> GlobalReg -> Bool)
-> (GlobalReg -> GlobalReg -> Bool)
-> (GlobalReg -> GlobalReg -> Bool)
-> (GlobalReg -> GlobalReg -> Bool)
-> (GlobalReg -> GlobalReg -> GlobalReg)
-> (GlobalReg -> GlobalReg -> GlobalReg)
-> Ord GlobalReg
GlobalReg -> GlobalReg -> Bool
GlobalReg -> GlobalReg -> Ordering
GlobalReg -> GlobalReg -> GlobalReg
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 :: GlobalReg -> GlobalReg -> Ordering
compare :: GlobalReg -> GlobalReg -> Ordering
$c< :: GlobalReg -> GlobalReg -> Bool
< :: GlobalReg -> GlobalReg -> Bool
$c<= :: GlobalReg -> GlobalReg -> Bool
<= :: GlobalReg -> GlobalReg -> Bool
$c> :: GlobalReg -> GlobalReg -> Bool
> :: GlobalReg -> GlobalReg -> Bool
$c>= :: GlobalReg -> GlobalReg -> Bool
>= :: GlobalReg -> GlobalReg -> Bool
$cmax :: GlobalReg -> GlobalReg -> GlobalReg
max :: GlobalReg -> GlobalReg -> GlobalReg
$cmin :: GlobalReg -> GlobalReg -> GlobalReg
min :: GlobalReg -> GlobalReg -> GlobalReg
Ord, Int -> GlobalReg -> ShowS
[GlobalReg] -> ShowS
GlobalReg -> String
(Int -> GlobalReg -> ShowS)
-> (GlobalReg -> String)
-> ([GlobalReg] -> ShowS)
-> Show GlobalReg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GlobalReg -> ShowS
showsPrec :: Int -> GlobalReg -> ShowS
$cshow :: GlobalReg -> String
show :: GlobalReg -> String
$cshowList :: [GlobalReg] -> ShowS
showList :: [GlobalReg] -> ShowS
Show )
instance Outputable GlobalReg where
ppr :: GlobalReg -> SDoc
ppr GlobalReg
e = GlobalReg -> SDoc
forall doc. IsLine doc => GlobalReg -> doc
pprGlobalReg GlobalReg
e
instance OutputableP env GlobalReg where
pdoc :: env -> GlobalReg -> SDoc
pdoc env
_ = GlobalReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr
pprGlobalReg :: IsLine doc => GlobalReg -> doc
pprGlobalReg :: forall doc. IsLine doc => GlobalReg -> doc
pprGlobalReg GlobalReg
gr
= case GlobalReg
gr of
VanillaReg Int
n -> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'R' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
n
FloatReg Int
n -> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'F' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
n
DoubleReg Int
n -> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'D' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
n
LongReg Int
n -> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'L' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
n
XmmReg Int
n -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"XMM" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
n
YmmReg Int
n -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"YMM" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
n
ZmmReg Int
n -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"ZMM" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
n
GlobalReg
Sp -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"Sp"
GlobalReg
SpLim -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"SpLim"
GlobalReg
Hp -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"Hp"
GlobalReg
HpLim -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"HpLim"
GlobalReg
MachSp -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"MachSp"
GlobalReg
UnwindReturnReg-> String -> doc
forall doc. IsLine doc => String -> doc
text String
"UnwindReturnReg"
GlobalReg
CCCS -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"CCCS"
GlobalReg
CurrentTSO -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"CurrentTSO"
GlobalReg
CurrentNursery -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"CurrentNursery"
GlobalReg
HpAlloc -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"HpAlloc"
GlobalReg
EagerBlackholeInfo -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"stg_EAGER_BLACKHOLE_info"
GlobalReg
GCEnter1 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"stg_gc_enter_1"
GlobalReg
GCFun -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"stg_gc_fun"
GlobalReg
BaseReg -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"BaseReg"
GlobalReg
PicBaseReg -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"PicBaseReg"
{-# SPECIALIZE pprGlobalReg :: GlobalReg -> SDoc #-}
{-# SPECIALIZE pprGlobalReg :: GlobalReg -> HLine #-}
baseReg, spReg, hpReg, spLimReg, hpLimReg, nodeReg,
currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg :: Platform -> CmmReg
baseReg :: Platform -> CmmReg
baseReg Platform
p = GlobalRegUse -> CmmReg
CmmGlobal (GlobalReg -> CmmType -> GlobalRegUse
GlobalRegUse GlobalReg
BaseReg (CmmType -> GlobalRegUse) -> CmmType -> GlobalRegUse
forall a b. (a -> b) -> a -> b
$ Platform -> CmmType
bWord Platform
p)
spReg :: Platform -> CmmReg
spReg Platform
p = GlobalRegUse -> CmmReg
CmmGlobal (GlobalReg -> CmmType -> GlobalRegUse
GlobalRegUse GlobalReg
Sp (CmmType -> GlobalRegUse) -> CmmType -> GlobalRegUse
forall a b. (a -> b) -> a -> b
$ Platform -> CmmType
bWord Platform
p)
hpReg :: Platform -> CmmReg
hpReg Platform
p = GlobalRegUse -> CmmReg
CmmGlobal (GlobalReg -> CmmType -> GlobalRegUse
GlobalRegUse GlobalReg
Hp (CmmType -> GlobalRegUse) -> CmmType -> GlobalRegUse
forall a b. (a -> b) -> a -> b
$ Platform -> CmmType
gcWord Platform
p)
hpLimReg :: Platform -> CmmReg
hpLimReg Platform
p = GlobalRegUse -> CmmReg
CmmGlobal (GlobalReg -> CmmType -> GlobalRegUse
GlobalRegUse GlobalReg
HpLim (CmmType -> GlobalRegUse) -> CmmType -> GlobalRegUse
forall a b. (a -> b) -> a -> b
$ Platform -> CmmType
bWord Platform
p)
spLimReg :: Platform -> CmmReg
spLimReg Platform
p = GlobalRegUse -> CmmReg
CmmGlobal (GlobalReg -> CmmType -> GlobalRegUse
GlobalRegUse GlobalReg
SpLim (CmmType -> GlobalRegUse) -> CmmType -> GlobalRegUse
forall a b. (a -> b) -> a -> b
$ Platform -> CmmType
bWord Platform
p)
nodeReg :: Platform -> CmmReg
nodeReg Platform
p = GlobalRegUse -> CmmReg
CmmGlobal (GlobalReg -> CmmType -> GlobalRegUse
GlobalRegUse (Int -> GlobalReg
VanillaReg Int
1) (CmmType -> GlobalRegUse) -> CmmType -> GlobalRegUse
forall a b. (a -> b) -> a -> b
$ Platform -> CmmType
gcWord Platform
p)
currentTSOReg :: Platform -> CmmReg
currentTSOReg Platform
p = GlobalRegUse -> CmmReg
CmmGlobal (GlobalReg -> CmmType -> GlobalRegUse
GlobalRegUse GlobalReg
CurrentTSO (CmmType -> GlobalRegUse) -> CmmType -> GlobalRegUse
forall a b. (a -> b) -> a -> b
$ Platform -> CmmType
bWord Platform
p)
currentNurseryReg :: Platform -> CmmReg
currentNurseryReg Platform
p = GlobalRegUse -> CmmReg
CmmGlobal (GlobalReg -> CmmType -> GlobalRegUse
GlobalRegUse GlobalReg
CurrentNursery (CmmType -> GlobalRegUse) -> CmmType -> GlobalRegUse
forall a b. (a -> b) -> a -> b
$ Platform -> CmmType
bWord Platform
p)
hpAllocReg :: Platform -> CmmReg
hpAllocReg Platform
p = GlobalRegUse -> CmmReg
CmmGlobal (GlobalReg -> CmmType -> GlobalRegUse
GlobalRegUse GlobalReg
HpAlloc (CmmType -> GlobalRegUse) -> CmmType -> GlobalRegUse
forall a b. (a -> b) -> a -> b
$ Platform -> CmmType
bWord Platform
p)
cccsReg :: Platform -> CmmReg
cccsReg Platform
p = GlobalRegUse -> CmmReg
CmmGlobal (GlobalReg -> CmmType -> GlobalRegUse
GlobalRegUse GlobalReg
CCCS (CmmType -> GlobalRegUse) -> CmmType -> GlobalRegUse
forall a b. (a -> b) -> a -> b
$ Platform -> CmmType
bWord Platform
p)
node :: GlobalReg
node :: GlobalReg
node = Int -> GlobalReg
VanillaReg Int
1
globalRegSpillType :: Platform -> GlobalReg -> CmmType
globalRegSpillType :: Platform -> GlobalReg -> CmmType
globalRegSpillType Platform
platform = \case
VanillaReg Int
_ -> Platform -> CmmType
gcWord Platform
platform
FloatReg Int
_ -> Width -> CmmType
cmmFloat Width
W32
DoubleReg Int
_ -> Width -> CmmType
cmmFloat Width
W64
LongReg Int
_ -> Width -> CmmType
cmmBits Width
W64
XmmReg Int
_ -> Int -> CmmType -> CmmType
cmmVec Int
4 (Width -> CmmType
cmmBits Width
W32)
YmmReg Int
_ -> Int -> CmmType -> CmmType
cmmVec Int
8 (Width -> CmmType
cmmBits Width
W32)
ZmmReg Int
_ -> Int -> CmmType -> CmmType
cmmVec Int
16 (Width -> CmmType
cmmBits Width
W32)
GlobalReg
Hp -> Platform -> CmmType
gcWord Platform
platform
GlobalReg
_ -> Platform -> CmmType
bWord Platform
platform
isArgReg :: GlobalReg -> Bool
isArgReg :: GlobalReg -> Bool
isArgReg (VanillaReg {}) = Bool
True
isArgReg (FloatReg {}) = Bool
True
isArgReg (DoubleReg {}) = Bool
True
isArgReg (LongReg {}) = Bool
True
isArgReg (XmmReg {}) = Bool
True
isArgReg (YmmReg {}) = Bool
True
isArgReg (ZmmReg {}) = Bool
True
isArgReg GlobalReg
_ = Bool
False
data GlobalArgRegs
= GP_ARG_REGS
| SCALAR_ARG_REGS
| V16_ARG_REGS
| V32_ARG_REGS
| V64_ARG_REGS
deriving ( Int -> GlobalArgRegs -> ShowS
[GlobalArgRegs] -> ShowS
GlobalArgRegs -> String
(Int -> GlobalArgRegs -> ShowS)
-> (GlobalArgRegs -> String)
-> ([GlobalArgRegs] -> ShowS)
-> Show GlobalArgRegs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GlobalArgRegs -> ShowS
showsPrec :: Int -> GlobalArgRegs -> ShowS
$cshow :: GlobalArgRegs -> String
show :: GlobalArgRegs -> String
$cshowList :: [GlobalArgRegs] -> ShowS
showList :: [GlobalArgRegs] -> ShowS
Show, GlobalArgRegs -> GlobalArgRegs -> Bool
(GlobalArgRegs -> GlobalArgRegs -> Bool)
-> (GlobalArgRegs -> GlobalArgRegs -> Bool) -> Eq GlobalArgRegs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GlobalArgRegs -> GlobalArgRegs -> Bool
== :: GlobalArgRegs -> GlobalArgRegs -> Bool
$c/= :: GlobalArgRegs -> GlobalArgRegs -> Bool
/= :: GlobalArgRegs -> GlobalArgRegs -> Bool
Eq, Eq GlobalArgRegs
Eq GlobalArgRegs =>
(GlobalArgRegs -> GlobalArgRegs -> Ordering)
-> (GlobalArgRegs -> GlobalArgRegs -> Bool)
-> (GlobalArgRegs -> GlobalArgRegs -> Bool)
-> (GlobalArgRegs -> GlobalArgRegs -> Bool)
-> (GlobalArgRegs -> GlobalArgRegs -> Bool)
-> (GlobalArgRegs -> GlobalArgRegs -> GlobalArgRegs)
-> (GlobalArgRegs -> GlobalArgRegs -> GlobalArgRegs)
-> Ord GlobalArgRegs
GlobalArgRegs -> GlobalArgRegs -> Bool
GlobalArgRegs -> GlobalArgRegs -> Ordering
GlobalArgRegs -> GlobalArgRegs -> GlobalArgRegs
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 :: GlobalArgRegs -> GlobalArgRegs -> Ordering
compare :: GlobalArgRegs -> GlobalArgRegs -> Ordering
$c< :: GlobalArgRegs -> GlobalArgRegs -> Bool
< :: GlobalArgRegs -> GlobalArgRegs -> Bool
$c<= :: GlobalArgRegs -> GlobalArgRegs -> Bool
<= :: GlobalArgRegs -> GlobalArgRegs -> Bool
$c> :: GlobalArgRegs -> GlobalArgRegs -> Bool
> :: GlobalArgRegs -> GlobalArgRegs -> Bool
$c>= :: GlobalArgRegs -> GlobalArgRegs -> Bool
>= :: GlobalArgRegs -> GlobalArgRegs -> Bool
$cmax :: GlobalArgRegs -> GlobalArgRegs -> GlobalArgRegs
max :: GlobalArgRegs -> GlobalArgRegs -> GlobalArgRegs
$cmin :: GlobalArgRegs -> GlobalArgRegs -> GlobalArgRegs
min :: GlobalArgRegs -> GlobalArgRegs -> GlobalArgRegs
Ord )