module GHC.CmmToAsm.RV64.Regs where
import GHC.Cmm
import GHC.Cmm.CLabel (CLabel)
import GHC.CmmToAsm.Format
import GHC.Data.FastString
import GHC.Platform
import GHC.Platform.Reg
import GHC.Platform.Reg.Class
import GHC.Platform.Reg.Class.Separate
import GHC.Platform.Regs
import GHC.Prelude
import GHC.Types.Unique
import GHC.Utils.Outputable
import GHC.Utils.Panic
x0RegNo :: RegNo
x0RegNo :: RegNo
x0RegNo = RegNo
0
x1RegNo, raRegNo :: RegNo
x1RegNo :: RegNo
x1RegNo = RegNo
1
raRegNo :: RegNo
raRegNo = RegNo
x1RegNo
x5RegNo, t0RegNo :: RegNo
x5RegNo :: RegNo
x5RegNo = RegNo
5
t0RegNo :: RegNo
t0RegNo = RegNo
x5RegNo
x7RegNo, t2RegNo :: RegNo
x7RegNo :: RegNo
x7RegNo = RegNo
7
t2RegNo :: RegNo
t2RegNo = RegNo
x7RegNo
x28RegNo, t3RegNo :: RegNo
x28RegNo :: RegNo
x28RegNo = RegNo
28
t3RegNo :: RegNo
t3RegNo = RegNo
x28RegNo
x31RegNo, t6RegNo, tmpRegNo :: RegNo
x31RegNo :: RegNo
x31RegNo = RegNo
31
t6RegNo :: RegNo
t6RegNo = RegNo
x31RegNo
tmpRegNo :: RegNo
tmpRegNo = RegNo
x31RegNo
d0RegNo, ft0RegNo :: RegNo
d0RegNo :: RegNo
d0RegNo = RegNo
32
ft0RegNo :: RegNo
ft0RegNo = RegNo
d0RegNo
d7RegNo, ft7RegNo :: RegNo
d7RegNo :: RegNo
d7RegNo = RegNo
39
ft7RegNo :: RegNo
ft7RegNo = RegNo
d7RegNo
d31RegNo :: RegNo
d31RegNo :: RegNo
d31RegNo = RegNo
63
a0RegNo, x10RegNo :: RegNo
x10RegNo :: RegNo
x10RegNo = RegNo
10
a0RegNo :: RegNo
a0RegNo = RegNo
x10RegNo
a7RegNo, x17RegNo :: RegNo
x17RegNo :: RegNo
x17RegNo = RegNo
17
a7RegNo :: RegNo
a7RegNo = RegNo
x17RegNo
fa0RegNo, d10RegNo :: RegNo
d10RegNo :: RegNo
d10RegNo = RegNo
42
fa0RegNo :: RegNo
fa0RegNo = RegNo
d10RegNo
fa7RegNo, d17RegNo :: RegNo
d17RegNo :: RegNo
d17RegNo = RegNo
49
fa7RegNo :: RegNo
fa7RegNo = RegNo
d17RegNo
zeroReg, raReg, spMachReg, tmpReg :: Reg
zeroReg :: Reg
zeroReg = RegNo -> Reg
regSingle RegNo
x0RegNo
raReg :: Reg
raReg = RegNo -> Reg
regSingle RegNo
1
spMachReg :: Reg
spMachReg = RegNo -> Reg
regSingle RegNo
2
tmpReg :: Reg
tmpReg = RegNo -> Reg
regSingle RegNo
tmpRegNo
allMachRegNos :: [RegNo]
allMachRegNos :: [RegNo]
allMachRegNos = [RegNo]
intRegs [RegNo] -> [RegNo] -> [RegNo]
forall a. [a] -> [a] -> [a]
++ [RegNo]
fpRegs
where
intRegs :: [RegNo]
intRegs = [RegNo
x0RegNo .. RegNo
x31RegNo]
fpRegs :: [RegNo]
fpRegs = [RegNo
d0RegNo .. RegNo
d31RegNo]
allocatableRegs :: Platform -> [RealReg]
allocatableRegs :: Platform -> [RealReg]
allocatableRegs Platform
platform =
let isFree :: RegNo -> Bool
isFree = Platform -> RegNo -> Bool
freeReg Platform
platform
in (RegNo -> RealReg) -> [RegNo] -> [RealReg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> RealReg
RealRegSingle ([RegNo] -> [RealReg]) -> [RegNo] -> [RealReg]
forall a b. (a -> b) -> a -> b
$ (RegNo -> Bool) -> [RegNo] -> [RegNo]
forall a. (a -> Bool) -> [a] -> [a]
filter RegNo -> Bool
isFree [RegNo]
allMachRegNos
allGpArgRegs :: [Reg]
allGpArgRegs :: [Reg]
allGpArgRegs = (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
a0RegNo .. RegNo
a7RegNo]
allFpArgRegs :: [Reg]
allFpArgRegs :: [Reg]
allFpArgRegs = (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
fa0RegNo .. RegNo
fa7RegNo]
data AddrMode
=
AddrRegImm Reg Imm
|
AddrReg Reg
deriving (AddrMode -> AddrMode -> Bool
(AddrMode -> AddrMode -> Bool)
-> (AddrMode -> AddrMode -> Bool) -> Eq AddrMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddrMode -> AddrMode -> Bool
== :: AddrMode -> AddrMode -> Bool
$c/= :: AddrMode -> AddrMode -> Bool
/= :: AddrMode -> AddrMode -> Bool
Eq, RegNo -> AddrMode -> ShowS
[AddrMode] -> ShowS
AddrMode -> String
(RegNo -> AddrMode -> ShowS)
-> (AddrMode -> String) -> ([AddrMode] -> ShowS) -> Show AddrMode
forall a.
(RegNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: RegNo -> AddrMode -> ShowS
showsPrec :: RegNo -> AddrMode -> ShowS
$cshow :: AddrMode -> String
show :: AddrMode -> String
$cshowList :: [AddrMode] -> ShowS
showList :: [AddrMode] -> ShowS
Show)
data Imm
= ImmInt Int
| ImmInteger Integer
| ImmCLbl CLabel
| ImmLit FastString
| ImmIndex CLabel Int
| ImmFloat Rational
| ImmDouble Rational
| ImmConstantSum Imm Imm
| ImmConstantDiff Imm Imm
deriving (Imm -> Imm -> Bool
(Imm -> Imm -> Bool) -> (Imm -> Imm -> Bool) -> Eq Imm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Imm -> Imm -> Bool
== :: Imm -> Imm -> Bool
$c/= :: Imm -> Imm -> Bool
/= :: Imm -> Imm -> Bool
Eq, RegNo -> Imm -> ShowS
[Imm] -> ShowS
Imm -> String
(RegNo -> Imm -> ShowS)
-> (Imm -> String) -> ([Imm] -> ShowS) -> Show Imm
forall a.
(RegNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: RegNo -> Imm -> ShowS
showsPrec :: RegNo -> Imm -> ShowS
$cshow :: Imm -> String
show :: Imm -> String
$cshowList :: [Imm] -> ShowS
showList :: [Imm] -> ShowS
Show)
litToImm :: CmmLit -> Imm
litToImm :: CmmLit -> Imm
litToImm (CmmInt Integer
i Width
w) = Integer -> Imm
ImmInteger (Width -> Integer -> Integer
narrowS Width
w Integer
i)
litToImm (CmmFloat Rational
f Width
W32) = Rational -> Imm
ImmFloat Rational
f
litToImm (CmmFloat Rational
f Width
W64) = Rational -> Imm
ImmDouble Rational
f
litToImm (CmmLabel CLabel
l) = CLabel -> Imm
ImmCLbl CLabel
l
litToImm (CmmLabelOff CLabel
l RegNo
off) = CLabel -> RegNo -> Imm
ImmIndex CLabel
l RegNo
off
litToImm (CmmLabelDiffOff CLabel
l1 CLabel
l2 RegNo
off Width
_) =
Imm -> Imm -> Imm
ImmConstantSum
(Imm -> Imm -> Imm
ImmConstantDiff (CLabel -> Imm
ImmCLbl CLabel
l1) (CLabel -> Imm
ImmCLbl CLabel
l2))
(RegNo -> Imm
ImmInt RegNo
off)
litToImm CmmLit
l = String -> Imm
forall a. HasCallStack => String -> a
panic (String -> Imm) -> String -> Imm
forall a b. (a -> b) -> a -> b
$ String
"RV64.Regs.litToImm: no match for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CmmLit -> String
forall a. Show a => a -> String
show CmmLit
l
{-# INLINE virtualRegSqueeze #-}
virtualRegSqueeze :: RegClass -> VirtualReg -> Int
virtualRegSqueeze :: RegClass -> VirtualReg -> RegNo
virtualRegSqueeze RegClass
cls VirtualReg
vr =
case RegClass
cls of
RegClass
RcInteger ->
case VirtualReg
vr of
VirtualRegI {} -> RegNo
1
VirtualRegHi {} -> RegNo
1
VirtualReg
_other -> RegNo
0
RegClass
RcFloat ->
case VirtualReg
vr of
VirtualRegD {} -> RegNo
1
VirtualReg
_other -> RegNo
0
RegClass
RcVector ->
case VirtualReg
vr of
VirtualRegV128 {} -> RegNo
1
VirtualReg
_other -> RegNo
0
{-# INLINE realRegSqueeze #-}
realRegSqueeze :: RegClass -> RealReg -> Int
realRegSqueeze :: RegClass -> RealReg -> RegNo
realRegSqueeze RegClass
cls RealReg
rr =
case RegClass
cls of
RegClass
RcInteger ->
case RealReg
rr of
RealRegSingle RegNo
regNo
| RegNo
regNo RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
< RegNo
d0RegNo
-> RegNo
1
| Bool
otherwise
-> RegNo
0
RegClass
RcFloat ->
case RealReg
rr of
RealRegSingle RegNo
regNo
| RegNo
regNo RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
< RegNo
d0RegNo
Bool -> Bool -> Bool
|| RegNo
regNo RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
> RegNo
d31RegNo
-> RegNo
0
| Bool
otherwise
-> RegNo
1
RegClass
RcVector ->
case RealReg
rr of
RealRegSingle RegNo
regNo
| RegNo
regNo RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
> RegNo
d31RegNo
-> RegNo
1
| Bool
otherwise
-> RegNo
0
mkVirtualReg :: Unique -> Format -> VirtualReg
mkVirtualReg :: Unique -> Format -> VirtualReg
mkVirtualReg Unique
u Format
format
| Bool -> Bool
not (Format -> Bool
isFloatFormat Format
format) = Unique -> VirtualReg
VirtualRegI Unique
u
| Bool
otherwise =
case Format
format of
Format
FF32 -> Unique -> VirtualReg
VirtualRegD Unique
u
Format
FF64 -> Unique -> VirtualReg
VirtualRegD Unique
u
Format
_ -> String -> VirtualReg
forall a. HasCallStack => String -> a
panic String
"RV64.mkVirtualReg"
{-# INLINE classOfRealReg #-}
classOfRealReg :: RealReg -> RegClass
classOfRealReg :: RealReg -> RegClass
classOfRealReg (RealRegSingle RegNo
i)
| RegNo
i RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
< RegNo
d0RegNo = RegClass
RcInteger
| RegNo
i RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
> RegNo
d31RegNo = RegClass
RcVector
| Bool
otherwise = RegClass
RcFloat
regDotColor :: RealReg -> SDoc
regDotColor :: RealReg -> SDoc
regDotColor RealReg
reg =
case RealReg -> RegClass
classOfRealReg RealReg
reg of
RegClass
RcInteger -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"blue"
RegClass
RcFloat -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"red"
RegClass
RcVector -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"green"