    {-# 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] [RegNo] -> [RegNo] -> [RegNo]
    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  (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

    -- argRegs is the set of regs which are read for an n-argument call to C.
    allGpArgRegs :: [Reg]
    allGpArgRegs :: [Reg]
    allGpArgRegs = (RegNo -> Reg) -> [RegNo] -> [Reg]
    forall a b. (a -> b) -> [a] -> [b]
    map RegNo -> Reg
    regSingle [RegNo
    0..RegNo
    7]
    allFpArgRegs :: [Reg]
    allFpArgRegs :: [Reg]
    allFpArgRegs = (RegNo -> Reg) -> [RegNo] -> [Reg]
    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
    (AddrMode -> AddrMode -> Bool)
    -> (AddrMode -> AddrMode -> Bool) -> Eq AddrMode
    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
    (RegNo -> AddrMode -> ShowS)
    -> (AddrMode -> String) -> ([AddrMode] -> ShowS) -> Show AddrMode
    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
    (Imm -> Imm -> Bool) -> (Imm -> Imm -> Bool) -> Eq Imm
    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
    (RegNo -> Imm -> ShowS)
    -> (Imm -> String) -> ([Imm] -> ShowS) -> Show Imm
    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 = SDoc -> String
    forall a. Outputable a => a -> String
    showPprUnsafe (SDoc -> String) -> (SDoc -> SDoc) -> SDoc -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDoc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr

    instance Eq SDoc where
      SDoc
    lhs == :: SDoc -> SDoc -> Bool
    == SDoc
    rhs = SDoc -> String
    forall a. Show a => a -> String
    show SDoc
    lhs String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == SDoc -> String
    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
    _                   = String -> Imm
    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 RegNo -> RegNo -> Bool
    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 RegNo -> RegNo -> Bool
    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
    _       -> String -> VirtualReg
    forall a. String -> a
    panic String
    "AArch64.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
    32        = RegClass
    RcInteger
            | Bool
    otherwise     = RegClass
    RcDouble

    classOfRealReg (RealRegPair{})
            = String -> RegClass
    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"