    -- -----------------------------------------------------------------------------
    --
    -- (c) The University of Glasgow 1994-2004
    --
    -- -----------------------------------------------------------------------------

    module GHC.CmmToAsm.PPC.Regs (
            -- squeeze functions
            virtualRegSqueeze,
            realRegSqueeze,

            mkVirtualReg,
            regDotColor,

            -- immediates
            Imm(..),
            strImmLit,
            litToImm,

            -- addressing modes
            AddrMode(..),
            addrOffset,

            -- registers
            spRel,
            argRegs,
            allArgRegs,
            callClobberedRegs,
            allMachRegNos,
            classOfRealReg,
            toRegNo,

            -- machine specific
            allFPArgRegs,
            fits16Bits,
            makeImmediate,
            fReg,
            r0, sp, toc, r3, r4, r11, r12, r30,
            tmpReg,
            f1,

            allocatableRegs

    )

    where

    import GHC.Prelude
    import GHC.Data.FastString

    import GHC.Platform.Reg
    import GHC.Platform.Reg.Class.Unified
    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

    import Data.Word        ( Word8, Word16, Word32, Word64 )
    import Data.Int         ( Int8, Int16, Int32, Int64 )

    -- 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
    RcFloatOrVector
             -> case VirtualReg
    vr of
                    VirtualRegD{}           -> RegNo
    1
                    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
    32    -> RegNo
    1     -- first fp reg is 32
                            | Bool
    otherwise     -> RegNo
    0

            RegClass
    RcFloatOrVector
             -> 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

    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
    "mkVirtualReg"

    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
    RcFloatOrVector -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "red"

    -- 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
            | LO Imm
            | HI Imm
            | HA Imm        {- high halfword adjusted -}
            | HIGHERA Imm
            | HIGHESTA Imm

    strImmLit :: FastString -> Imm
    strImmLit :: FastString -> Imm
    strImmLit FastString
    s = FastString -> Imm
    ImmLit FastString
    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. HasCallStack => String -> a
    panic String
    "PPC.Regs.litToImm: no match"

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

    data AddrMode
            = AddrRegReg    Reg Reg
            | AddrRegImm    Reg Imm

    addrOffset :: AddrMode -> Int -> Maybe AddrMode
    addrOffset :: AddrMode -> RegNo -> Maybe AddrMode
    addrOffset AddrMode
    addr RegNo
    off
      = case AddrMode
    addr of
          AddrRegImm Reg
    r (ImmInt RegNo
    n)
           | RegNo -> Bool
    forall a. Integral a => a -> Bool
    fits16Bits RegNo
    n2 -> AddrMode -> Maybe AddrMode
    forall a. a -> Maybe a
    Just (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    r (RegNo -> Imm
    ImmInt RegNo
    n2))
           | Bool
    otherwise     -> Maybe AddrMode
    forall a. Maybe a
    Nothing
           where n2 :: RegNo
    n2 = RegNo
    n RegNo -> RegNo -> RegNo
    forall a. Num a => a -> a -> a
    + RegNo
    off

          AddrRegImm Reg
    r (ImmInteger Integer
    n)
           | Integer -> Bool
    forall a. Integral a => a -> Bool
    fits16Bits Integer
    n2 -> AddrMode -> Maybe AddrMode
    forall a. a -> Maybe a
    Just (Reg -> Imm -> AddrMode
    AddrRegImm Reg
    r (RegNo -> Imm
    ImmInt (Integer -> RegNo
    forall a. Num a => Integer -> a
    fromInteger Integer
    n2)))
           | Bool
    otherwise     -> Maybe AddrMode
    forall a. Maybe a
    Nothing
           where n2 :: Integer
    n2 = Integer
    n Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + RegNo -> Integer
    forall a. Integral a => a -> Integer
    toInteger RegNo
    off

          AddrMode
    _ -> Maybe AddrMode
    forall a. Maybe a
    Nothing

    -- registers -------------------------------------------------------------------
    -- @spRel@ gives us a stack relative addressing mode for volatile
    -- temporaries and for excess call arguments.  @fpRel@, where
    -- applicable, is the same but for the frame pointer.

    spRel :: Platform
          -> Int    -- desired stack offset in words, positive or negative
          -> AddrMode

    spRel :: Platform -> RegNo -> AddrMode
    spRel Platform
    platform RegNo
    n = Reg -> Imm -> AddrMode
    AddrRegImm Reg
    sp (RegNo -> Imm
    ImmInt (RegNo
    n RegNo -> RegNo -> RegNo
    forall a. Num a => a -> a -> a
    * Platform -> RegNo
    platformWordSizeInBytes Platform
    platform))

    -- argRegs is the set of regs which are read for an n-argument call to C.
    -- For archs which pass all args on the stack (x86), is empty.
    -- Sparc passes up to the first 6 args in regs.
    argRegs :: RegNo -> [Reg]
    argRegs :: RegNo -> [Reg]
    argRegs RegNo
    0 = []
    argRegs RegNo
    1 = (RegNo -> Reg) -> [RegNo] -> [Reg]
    forall a b. (a -> b) -> [a] -> [b]
    map RegNo -> Reg
    regSingle [RegNo
    3]
    argRegs RegNo
    2 = (RegNo -> Reg) -> [RegNo] -> [Reg]
    forall a b. (a -> b) -> [a] -> [b]
    map RegNo -> Reg
    regSingle [RegNo
    3,RegNo
    4]
    argRegs RegNo
    3 = (RegNo -> Reg) -> [RegNo] -> [Reg]
    forall a b. (a -> b) -> [a] -> [b]
    map RegNo -> Reg
    regSingle [RegNo
    3..RegNo
    5]
    argRegs RegNo
    4 = (RegNo -> Reg) -> [RegNo] -> [Reg]
    forall a b. (a -> b) -> [a] -> [b]
    map RegNo -> Reg
    regSingle [RegNo
    3..RegNo
    6]
    argRegs RegNo
    5 = (RegNo -> Reg) -> [RegNo] -> [Reg]
    forall a b. (a -> b) -> [a] -> [b]
    map RegNo -> Reg
    regSingle [RegNo
    3..RegNo
    7]
    argRegs RegNo
    6 = (RegNo -> Reg) -> [RegNo] -> [Reg]
    forall a b. (a -> b) -> [a] -> [b]
    map RegNo -> Reg
    regSingle [RegNo
    3..RegNo
    8]
    argRegs RegNo
    7 = (RegNo -> Reg) -> [RegNo] -> [Reg]
    forall a b. (a -> b) -> [a] -> [b]
    map RegNo -> Reg
    regSingle [RegNo
    3..RegNo
    9]
    argRegs RegNo
    8 = (RegNo -> Reg) -> [RegNo] -> [Reg]
    forall a b. (a -> b) -> [a] -> [b]
    map RegNo -> Reg
    regSingle [RegNo
    3..RegNo
    10]
    argRegs RegNo
    _ = String -> [Reg]
    forall a. HasCallStack => String -> a
    panic String
    "MachRegs.argRegs(powerpc): don't know about >8 arguments!"

    allArgRegs :: [Reg]
    allArgRegs :: [Reg]
    allArgRegs = (RegNo -> Reg) -> [RegNo] -> [Reg]
    forall a b. (a -> b) -> [a] -> [b]
    map RegNo -> Reg
    regSingle [RegNo
    3..RegNo
    10]

    -- these are the regs which we cannot assume stay alive over a C call.
    callClobberedRegs :: Platform -> [Reg]
    callClobberedRegs :: Platform -> [Reg]
    callClobberedRegs Platform
    _platform
      = (RegNo -> Reg) -> [RegNo] -> [Reg]
    forall a b. (a -> b) -> [a] -> [b]
    map RegNo -> Reg
    regSingle (RegNo
    0RegNo -> [RegNo] -> [RegNo]
    forall a. a -> [a] -> [a]
    :[RegNo
    2..RegNo
    12] [RegNo] -> [RegNo] -> [RegNo]
    forall a. [a] -> [a] -> [a]
    ++ (RegNo -> RegNo) -> [RegNo] -> [RegNo]
    forall a b. (a -> b) -> [a] -> [b]
    map RegNo -> RegNo
    fReg [RegNo
    0..RegNo
    13])

    allMachRegNos   :: [RegNo]
    allMachRegNos :: [RegNo]
    allMachRegNos   = [RegNo
    0..RegNo
    63]

    {-# 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
    RcFloatOrVector

    toRegNo :: Reg -> RegNo
    toRegNo :: Reg -> RegNo
    toRegNo (RegReal (RealRegSingle RegNo
    n)) = RegNo
    n
    toRegNo Reg
    _                           = String -> RegNo
    forall a. HasCallStack => String -> a
    panic String
    "PPC.toRegNo: unsupported register"

    -- machine specific ------------------------------------------------------------

    allFPArgRegs :: Platform -> [Reg]
    allFPArgRegs :: Platform -> [Reg]
    allFPArgRegs Platform
    platform
        = case Platform -> OS
    platformOS Platform
    platform of
          OS
    OSAIX    -> (RegNo -> Reg) -> [RegNo] -> [Reg]
    forall a b. (a -> b) -> [a] -> [b]
    map (RegNo -> Reg
    regSingle (RegNo -> Reg) -> (RegNo -> RegNo) -> RegNo -> Reg
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RegNo -> RegNo
    fReg) [RegNo
    1..RegNo
    13]
          OS
    _        -> case Platform -> Arch
    platformArch Platform
    platform of
            Arch
    ArchPPC      -> (RegNo -> Reg) -> [RegNo] -> [Reg]
    forall a b. (a -> b) -> [a] -> [b]
    map (RegNo -> Reg
    regSingle (RegNo -> Reg) -> (RegNo -> RegNo) -> RegNo -> Reg
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RegNo -> RegNo
    fReg) [RegNo
    1..RegNo
    8]
            ArchPPC_64 PPC_64ABI
    _ -> (RegNo -> Reg) -> [RegNo] -> [Reg]
    forall a b. (a -> b) -> [a] -> [b]
    map (RegNo -> Reg
    regSingle (RegNo -> Reg) -> (RegNo -> RegNo) -> RegNo -> Reg
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RegNo -> RegNo
    fReg) [RegNo
    1..RegNo
    13]
            Arch
    _            -> String -> [Reg]
    forall a. HasCallStack => String -> a
    panic String
    "PPC.Regs.allFPArgRegs: unknown PPC Linux"

    fits16Bits :: Integral a => a -> Bool
    fits16Bits :: forall a. Integral a => a -> Bool
    fits16Bits a
    x = a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= -a
    32768 Bool -> Bool -> Bool
    && a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    32768

    makeImmediate :: Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate :: forall a. Integral a => Width -> Bool -> a -> Maybe Imm
    makeImmediate Width
    rep Bool
    signed a
    x = (RegNo -> Imm) -> Maybe RegNo -> Maybe Imm
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap RegNo -> Imm
    ImmInt (Width -> Bool -> Maybe RegNo
    toI16 Width
    rep Bool
    signed)
        where
            narrow :: Width -> Bool -> RegNo
    narrow Width
    W64 Bool
    False = Word64 -> RegNo
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (a -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x :: Word64)
            narrow Width
    W32 Bool
    False = Word32 -> RegNo
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (a -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x :: Word32)
            narrow Width
    W16 Bool
    False = Word16 -> RegNo
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (a -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x :: Word16)
            narrow Width
    W8  Bool
    False = Word8 -> RegNo
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (a -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x :: Word8)
            narrow Width
    W64 Bool
    True  = Int64 -> RegNo
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (a -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x :: Int64)
            narrow Width
    W32 Bool
    True  = Int32 -> RegNo
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (a -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x :: Int32)
            narrow Width
    W16 Bool
    True  = Int16 -> RegNo
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (a -> Int16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x :: Int16)
            narrow Width
    W8  Bool
    True  = Int8 -> RegNo
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (a -> Int8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x :: Int8)
            narrow Width
    _   Bool
    _     = String -> RegNo
    forall a. HasCallStack => String -> a
    panic String
    "PPC.Regs.narrow: no match"

            narrowed :: RegNo
    narrowed = Width -> Bool -> RegNo
    narrow Width
    rep Bool
    signed

            toI16 :: Width -> Bool -> Maybe RegNo
    toI16 Width
    W32 Bool
    True
                | RegNo
    narrowed RegNo -> RegNo -> Bool
    forall a. Ord a => a -> a -> Bool
    >= -RegNo
    32768 Bool -> Bool -> Bool
    && RegNo
    narrowed RegNo -> RegNo -> Bool
    forall a. Ord a => a -> a -> Bool
    < RegNo
    32768 = RegNo -> Maybe RegNo
    forall a. a -> Maybe a
    Just RegNo
    narrowed
                | Bool
    otherwise = Maybe RegNo
    forall a. Maybe a
    Nothing
            toI16 Width
    W32 Bool
    False
                | RegNo
    narrowed RegNo -> RegNo -> Bool
    forall a. Ord a => a -> a -> Bool
    >= RegNo
    0 Bool -> Bool -> Bool
    && RegNo
    narrowed RegNo -> RegNo -> Bool
    forall a. Ord a => a -> a -> Bool
    < RegNo
    65536 = RegNo -> Maybe RegNo
    forall a. a -> Maybe a
    Just RegNo
    narrowed
                | Bool
    otherwise = Maybe RegNo
    forall a. Maybe a
    Nothing
            toI16 Width
    W64 Bool
    True
                | RegNo
    narrowed RegNo -> RegNo -> Bool
    forall a. Ord a => a -> a -> Bool
    >= -RegNo
    32768 Bool -> Bool -> Bool
    && RegNo
    narrowed RegNo -> RegNo -> Bool
    forall a. Ord a => a -> a -> Bool
    < RegNo
    32768 = RegNo -> Maybe RegNo
    forall a. a -> Maybe a
    Just RegNo
    narrowed
                | Bool
    otherwise = Maybe RegNo
    forall a. Maybe a
    Nothing
            toI16 Width
    W64 Bool
    False
                | RegNo
    narrowed RegNo -> RegNo -> Bool
    forall a. Ord a => a -> a -> Bool
    >= RegNo
    0 Bool -> Bool -> Bool
    && RegNo
    narrowed RegNo -> RegNo -> Bool
    forall a. Ord a => a -> a -> Bool
    < RegNo
    65536 = RegNo -> Maybe RegNo
    forall a. a -> Maybe a
    Just RegNo
    narrowed
                | Bool
    otherwise = Maybe RegNo
    forall a. Maybe a
    Nothing
            toI16 Width
    _ Bool
    _  = RegNo -> Maybe RegNo
    forall a. a -> Maybe a
    Just RegNo
    narrowed

    {-
    The PowerPC has 64 registers of interest; 32 integer registers and 32 floating
    point registers.
    -}

    fReg :: Int -> RegNo
    fReg :: RegNo -> RegNo
    fReg RegNo
    x = (RegNo
    32 RegNo -> RegNo -> RegNo
    forall a. Num a => a -> a -> a
    + RegNo
    x)

    r0, sp, toc, r3, r4, r11, r12, r30, f1 :: Reg
    r0 :: Reg
    r0      = RegNo -> Reg
    regSingle RegNo
    0
    sp :: Reg
    sp      = RegNo -> Reg
    regSingle RegNo
    1
    toc :: Reg
    toc     = RegNo -> Reg
    regSingle RegNo
    2
    r3 :: Reg
    r3      = RegNo -> Reg
    regSingle RegNo
    3
    r4 :: Reg
    r4      = RegNo -> Reg
    regSingle RegNo
    4
    r11 :: Reg
    r11     = RegNo -> Reg
    regSingle RegNo
    11
    r12 :: Reg
    r12     = RegNo -> Reg
    regSingle RegNo
    12
    r30 :: Reg
    r30     = RegNo -> Reg
    regSingle RegNo
    30
    f1 :: Reg
    f1      = RegNo -> Reg
    regSingle (RegNo -> Reg) -> RegNo -> Reg
    forall a b. (a -> b) -> a -> b
    $ RegNo -> RegNo
    fReg RegNo
    1

    -- 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

    -- temporary register for compiler use
    tmpReg :: Platform -> Reg
    tmpReg :: Platform -> Reg
    tmpReg Platform
    platform =
           case Platform -> Arch
    platformArch Platform
    platform of
           Arch
    ArchPPC      -> RegNo -> Reg
    regSingle RegNo
    13
           ArchPPC_64 PPC_64ABI
    _ -> RegNo -> Reg
    regSingle RegNo
    30
           Arch
    _            -> String -> Reg
    forall a. HasCallStack => String -> a
    panic String
    "PPC.Regs.tmpReg: unknown arch"