{-# OPTIONS_GHC -fno-warn-orphans #-}
module GHC.CmmToAsm.AArch64.Regs where

import GHC.Prelude

import GHC.Platform.Reg
import GHC.Platform.Reg.Class
import GHC.CmmToAsm.Format

import GHC.Cmm
import GHC.Cmm.CLabel           ( CLabel )
import GHC.Types.Unique

import GHC.Platform.Regs
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Platform

allMachRegNos   :: [RegNo]
allMachRegNos :: [RegNo]
allMachRegNos   = [RegNo
0..RegNo
31] forall a. [a] -> [a] -> [a]
++ [RegNo
32..RegNo
63]
-- allocatableRegs is allMachRegNos with the fixed-use regs removed.
-- i.e., these are the regs for which we are prepared to allow the
-- register allocator to attempt to map VRegs to.
allocatableRegs :: Platform -> [RealReg]
allocatableRegs :: Platform -> [RealReg]
allocatableRegs Platform
platform
   = let isFree :: RegNo -> Bool
isFree RegNo
i = Platform -> RegNo -> Bool
freeReg Platform
platform RegNo
i
     in  forall a b. (a -> b) -> [a] -> [b]
map RegNo -> RealReg
RealRegSingle forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter RegNo -> Bool
isFree [RegNo]
allMachRegNos


-- argRegs is the set of regs which are read for an n-argument call to C.
allGpArgRegs :: [Reg]
allGpArgRegs :: [Reg]
allGpArgRegs = forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
0..RegNo
7]
allFpArgRegs :: [Reg]
allFpArgRegs :: [Reg]
allFpArgRegs = forall a b. (a -> b) -> [a] -> [b]
map RegNo -> Reg
regSingle [RegNo
32..RegNo
39]

-- STG:
-- 19: Base
-- 20: Sp
-- 21: Hp
-- 22-27: R1-R6
-- 28: SpLim

-- This is the STG Sp reg.
-- sp :: Reg
-- sp = regSingle 20

-- addressing modes ------------------------------------------------------------

data AddrMode
        = AddrRegReg    Reg Reg
        | AddrRegImm    Reg Imm
        | AddrReg       Reg
        deriving (AddrMode -> AddrMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddrMode -> AddrMode -> Bool
$c/= :: AddrMode -> AddrMode -> Bool
== :: AddrMode -> AddrMode -> Bool
$c== :: AddrMode -> AddrMode -> Bool
Eq, RegNo -> AddrMode -> ShowS
[AddrMode] -> ShowS
AddrMode -> String
forall a.
(RegNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddrMode] -> ShowS
$cshowList :: [AddrMode] -> ShowS
show :: AddrMode -> String
$cshow :: AddrMode -> String
showsPrec :: RegNo -> AddrMode -> ShowS
$cshowsPrec :: RegNo -> AddrMode -> ShowS
Show)

-- -----------------------------------------------------------------------------
-- Immediates

data Imm
  = ImmInt      Int
  | ImmInteger  Integer     -- Sigh.
  | ImmCLbl     CLabel      -- AbstractC Label (with baggage)
  | ImmLit      SDoc        -- Simple string
  | ImmIndex    CLabel Int
  | ImmFloat    Rational
  | ImmDouble   Rational
  | ImmConstantSum Imm Imm
  | ImmConstantDiff Imm Imm
  deriving (Imm -> Imm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Imm -> Imm -> Bool
$c/= :: Imm -> Imm -> Bool
== :: Imm -> Imm -> Bool
$c== :: Imm -> Imm -> Bool
Eq, RegNo -> Imm -> ShowS
[Imm] -> ShowS
Imm -> String
forall a.
(RegNo -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Imm] -> ShowS
$cshowList :: [Imm] -> ShowS
show :: Imm -> String
$cshow :: Imm -> String
showsPrec :: RegNo -> Imm -> ShowS
$cshowsPrec :: RegNo -> Imm -> ShowS
Show)

instance Show SDoc where
  show :: SDoc -> String
show = forall a. Outputable a => a -> String
showPprUnsafe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Outputable a => a -> SDoc
ppr

instance Eq SDoc where
  SDoc
lhs == :: SDoc -> SDoc -> Bool
== SDoc
rhs = forall a. Show a => a -> String
show SDoc
lhs forall a. Eq a => a -> a -> Bool
== forall a. Show a => a -> String
show SDoc
rhs

strImmLit :: String -> Imm
strImmLit :: String -> Imm
strImmLit String
s = SDoc -> Imm
ImmLit (String -> SDoc
text String
s)


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
_                   = forall a. String -> a
panic String
"AArch64.Regs.litToImm: no match"


-- == 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
RcDouble
         -> case VirtualReg
vr of
                VirtualRegD{}           -> RegNo
1
                VirtualRegF{}           -> RegNo
0
                VirtualReg
_other                  -> RegNo
0

        RegClass
_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 forall a. Ord a => a -> a -> Bool
< RegNo
32    -> RegNo
1     -- first fp reg is 32
                        | Bool
otherwise     -> RegNo
0

                RealRegPair{}           -> RegNo
0

        RegClass
RcDouble
         -> case RealReg
rr of
                RealRegSingle RegNo
regNo
                        | RegNo
regNo forall a. Ord a => a -> a -> Bool
< RegNo
32    -> RegNo
0
                        | Bool
otherwise     -> RegNo
1

                RealRegPair{}           -> RegNo
0

        RegClass
_other -> 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
_       -> forall a. String -> a
panic String
"AArch64.mkVirtualReg"

{-# INLINE classOfRealReg      #-}
classOfRealReg :: RealReg -> RegClass
classOfRealReg :: RealReg -> RegClass
classOfRealReg (RealRegSingle RegNo
i)
        | RegNo
i forall a. Ord a => a -> a -> Bool
< RegNo
32        = RegClass
RcInteger
        | Bool
otherwise     = RegClass
RcDouble

classOfRealReg (RealRegPair{})
        = forall a. String -> a
panic String
"regClass(ppr): no reg pairs on this architecture"

regDotColor :: RealReg -> SDoc
regDotColor :: RealReg -> SDoc
regDotColor RealReg
reg
 = case RealReg -> RegClass
classOfRealReg RealReg
reg of
        RegClass
RcInteger       -> String -> SDoc
text String
"blue"
        RegClass
RcFloat         -> String -> SDoc
text String
"red"
        RegClass
RcDouble        -> String -> SDoc
text String
"green"