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

-- * Registers

-- | First integer register number. @zero@ register.
x0RegNo :: RegNo
x0RegNo :: RegNo
x0RegNo = RegNo
0

-- | return address register
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

-- | Last integer register number. Used as TMP (IP) register.
x31RegNo, t6RegNo, tmpRegNo :: RegNo
x31RegNo :: RegNo
x31RegNo = RegNo
31
t6RegNo :: RegNo
t6RegNo = RegNo
x31RegNo
tmpRegNo :: RegNo
tmpRegNo = RegNo
x31RegNo

-- | First floating point register.
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

-- | Last floating point register.
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

-- Note [The made-up RISCV64 TMP (IP) register]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- RISCV64 has no inter-procedural register in its ABI. However, we need one to
-- make register spills/loads to/from high number slots. I.e. slot numbers that
-- do not fit in a 12bit integer which is used as immediate in the arithmetic
-- operations. Thus, we're marking one additional register (x31) as permanently
-- non-free and call it TMP.
--
-- TMP can be used as temporary register in all operations. Just be aware that
-- it may be clobbered as soon as you loose direct control over it (i.e. using
-- TMP by-passes the register allocation/spilling mechanisms.) It should be fine
-- to use it as temporary register in a MachOp translation as long as you don't
-- rely on its value beyond this limited scope.
--
-- X31 is a caller-saved register. I.e. there are no guarantees about what the
-- callee does with it. That's exactly what we want here.

zeroReg, raReg, spMachReg, tmpReg :: Reg
zeroReg :: Reg
zeroReg = RegNo -> Reg
regSingle RegNo
x0RegNo
raReg :: Reg
raReg = RegNo -> Reg
regSingle RegNo
1

-- | Not to be confused with the `CmmReg` `spReg`
spMachReg :: Reg
spMachReg = RegNo -> Reg
regSingle RegNo
2

tmpReg :: Reg
tmpReg = RegNo -> Reg
regSingle RegNo
tmpRegNo

-- | All machine register numbers.
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]

-- | Registers available to the register allocator.
--
-- These are all registers minus those with a fixed role in RISCV ABI (zero, lr,
-- sp, gp, tp, fp, tmp) and GHC RTS (Base, Sp, Hp, HpLim, R1..R8, F1..F6,
-- D1..D6.)
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

-- | Integer argument registers according to the calling convention
allGpArgRegs :: [Reg]
allGpArgRegs :: [Reg]
allGpArgRegs = (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
a0RegNo .. RegNo
a7RegNo]

-- | Floating point argument registers according to the calling convention
allFpArgRegs :: [Reg]
allFpArgRegs :: [Reg]
allFpArgRegs = (RegNo -> Reg) -> [RegNo] -> [Reg]
forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
fa0RegNo .. RegNo
fa7RegNo]

-- * Addressing modes

-- | Addressing modes
data AddrMode
  = -- | A register plus some immediate integer, e.g. @8(sp)@ or @-16(sp)@. The
    -- offset needs to fit into 12bits.
    AddrRegImm Reg Imm
  | -- | A register
    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)

-- * Immediates

data Imm
  = ImmInt Int
  | ImmInteger Integer -- Sigh.
  | ImmCLbl CLabel -- AbstractC Label (with baggage)
  | 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)

-- | Map `CmmLit` to `Imm`
--
-- N.B. this is a partial function, because not all `CmmLit`s have an immediate
-- representation.
litToImm :: CmmLit -> Imm
litToImm :: CmmLit -> Imm
litToImm (CmmInt Integer
i Width
w) = Integer -> Imm
ImmInteger (Width -> Integer -> Integer
narrowS Width
w Integer
i)
-- narrow to the width: a CmmInt might be out of
-- range, but we assume that ImmInteger only contains
-- in-range values.  A signed value should be fine here.
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

-- == To satisfy GHC.CmmToAsm.Reg.Target =======================================

-- squeese functions for the graph allocator -----------------------------------

-- | regSqueeze_class reg
--      Calculate the maximum number of register colors that could be
--      denied to a node of this class due to having this reg
--      as a neighbour.
{-# 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"