    module GHC.Cmm.CallConv (
      ParamLocation(..),
      assignArgumentsPos,
      assignStack,
      realArgRegsCover,
      allArgRegsCover
    ) where

    import GHC.Prelude

    import GHC.Cmm.Expr
    import GHC.Cmm.Reg (GlobalArgRegs(..))
    import GHC.Runtime.Heap.Layout
    import GHC.Cmm (Convention(..))

    import GHC.Platform
    import GHC.Platform.Reg.Class
    import GHC.Platform.Profile
    import GHC.Utils.Outputable
    import GHC.Utils.Panic

    import Data.Maybe ( maybeToList )
    import Data.List (nub)

    -- Calculate the 'GlobalReg' or stack locations for function call
    -- parameters as used by the Cmm calling convention.

    data ParamLocation
      = RegisterParam GlobalReg
      | StackParam ByteOff

    instance Outputable ParamLocation where
      ppr :: ParamLocation -> SDoc
    ppr (RegisterParam GlobalReg
    g) = GlobalReg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr GlobalReg
    g
      ppr (StackParam Int
    p)    = Int -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Int
    p

    -- |
    -- Given a list of arguments, and a function that tells their types,
    -- return a list showing where each argument is passed
    --
    assignArgumentsPos :: Profile
                       -> ByteOff           -- stack offset to start with
                       -> Convention
                       -> (a -> CmmType)    -- how to get a type from an arg
                       -> [a]               -- args
                       -> (
                            ByteOff              -- bytes of stack args
                          , [(a, ParamLocation)] -- args and locations
                          )

    assignArgumentsPos :: forall a.
    Profile
    -> Int
    -> Convention
    -> (a -> CmmType)
    -> [a]
    -> (Int, [(a, ParamLocation)])
    assignArgumentsPos Profile
    profile Int
    off Convention
    conv a -> CmmType
    arg_ty [a]
    reps = (Int
    stk_off, [(a, ParamLocation)]
    assignments)
        where
          platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile
          regs :: AvailRegs
    regs = case ([a]
    reps, Convention
    conv) of
                   ([a]
    _,   Convention
    NativeNodeCall)   -> Platform -> AvailRegs
    getRegsWithNode Platform
    platform
                   ([a]
    _,   Convention
    NativeDirectCall) -> Platform -> AvailRegs
    getRegsWithoutNode Platform
    platform
                   ([a
    _], Convention
    NativeReturn)     -> Platform -> AvailRegs
    allRegs Platform
    platform
                   ([a]
    _,   Convention
    NativeReturn)     -> Platform -> AvailRegs
    getRegsWithNode Platform
    platform
                   -- GC calling convention *must* put values in registers
                   ([a]
    _,   Convention
    GC)               -> Platform -> AvailRegs
    allRegs Platform
    platform
                   ([a]
    _,   Convention
    Slow)             -> AvailRegs
    nodeOnly
          -- The calling conventions first assign arguments to registers,
          -- then switch to the stack when we first run out of registers
          -- (even if there are still available registers for args of a
          -- different type).  When returning an unboxed tuple, we also
          -- separate the stack arguments by pointerhood.
          ([(a, ParamLocation)]
    reg_assts, [a]
    stk_args)  = [(a, ParamLocation)]
    -> [a] -> AvailRegs -> ([(a, ParamLocation)], [a])
    assign_regs [] [a]
    reps AvailRegs
    regs
          (Int
    stk_off,   [(a, ParamLocation)]
    stk_assts) = Platform
    -> Int -> (a -> CmmType) -> [a] -> (Int, [(a, ParamLocation)])
    forall a.
    Platform
    -> Int -> (a -> CmmType) -> [a] -> (Int, [(a, ParamLocation)])
    assignStack Platform
    platform Int
    off a -> CmmType
    arg_ty [a]
    stk_args
          assignments :: [(a, ParamLocation)]
    assignments = [(a, ParamLocation)]
    reg_assts [(a, ParamLocation)]
    -> [(a, ParamLocation)] -> [(a, ParamLocation)]
    forall a. [a] -> [a] -> [a]
    ++ [(a, ParamLocation)]
    stk_assts

          assign_regs :: [(a, ParamLocation)]
    -> [a] -> AvailRegs -> ([(a, ParamLocation)], [a])
    assign_regs [(a, ParamLocation)]
    assts []     AvailRegs
    _    = ([(a, ParamLocation)]
    assts, [])
          assign_regs [(a, ParamLocation)]
    assts (a
    r:[a]
    rs) AvailRegs
    regs | CmmType -> Bool
    isVecType CmmType
    ty   = ([(a, ParamLocation)], [a])
    vec
                                        | CmmType -> Bool
    isFloatType CmmType
    ty = ([(a, ParamLocation)], [a])
    float
                                        | Bool
    otherwise      = ([(a, ParamLocation)], [a])
    int
            where vec :: ([(a, ParamLocation)], [a])
    vec = case AvailRegs
    regs of
                          AvailRegs [GlobalReg]
    vs [GlobalReg]
    fs [GlobalReg]
    ds [GlobalReg]
    ls (Int
    s:[Int]
    ss)
                            | Width -> Profile -> Bool
    passVectorInReg Width
    w Profile
    profile
                              -> let reg_class :: Int -> GlobalReg
    reg_class = case Width
    w of
                                        Width
    W128 -> Int -> GlobalReg
    XmmReg
                                        Width
    W256 -> Int -> GlobalReg
    YmmReg
                                        Width
    W512 -> Int -> GlobalReg
    ZmmReg
                                        Width
    _    -> String -> Int -> GlobalReg
    forall a. HasCallStack => String -> a
    panic String
    "CmmCallConv.assignArgumentsPos: Invalid vector width"
                                  in (ParamLocation, AvailRegs) -> ([(a, ParamLocation)], [a])
    k (GlobalReg -> ParamLocation
    RegisterParam (Int -> GlobalReg
    reg_class Int
    s), [GlobalReg]
    -> [GlobalReg] -> [GlobalReg] -> [GlobalReg] -> [Int] -> AvailRegs
    AvailRegs [GlobalReg]
    vs [GlobalReg]
    fs [GlobalReg]
    ds [GlobalReg]
    ls [Int]
    ss)
                          AvailRegs
    _ -> ([(a, ParamLocation)]
    assts, a
    ra -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    rs)
                  float :: ([(a, ParamLocation)], [a])
    float = case (Width
    w, AvailRegs
    regs) of
                            (Width
    W32, AvailRegs [GlobalReg]
    vs [GlobalReg]
    fs [GlobalReg]
    ds [GlobalReg]
    ls (Int
    s:[Int]
    ss))
                                | Bool
    passFloatInXmm          -> (ParamLocation, AvailRegs) -> ([(a, ParamLocation)], [a])
    k (GlobalReg -> ParamLocation
    RegisterParam (Int -> GlobalReg
    FloatReg Int
    s), [GlobalReg]
    -> [GlobalReg] -> [GlobalReg] -> [GlobalReg] -> [Int] -> AvailRegs
    AvailRegs [GlobalReg]
    vs [GlobalReg]
    fs [GlobalReg]
    ds [GlobalReg]
    ls [Int]
    ss)
                            (Width
    W32, AvailRegs [GlobalReg]
    vs (GlobalReg
    f:[GlobalReg]
    fs) [GlobalReg]
    ds [GlobalReg]
    ls [Int]
    ss)
                                | Bool -> Bool
    not Bool
    passFloatInXmm      -> (ParamLocation, AvailRegs) -> ([(a, ParamLocation)], [a])
    k (GlobalReg -> ParamLocation
    RegisterParam GlobalReg
    f, [GlobalReg]
    -> [GlobalReg] -> [GlobalReg] -> [GlobalReg] -> [Int] -> AvailRegs
    AvailRegs [GlobalReg]
    vs [GlobalReg]
    fs [GlobalReg]
    ds [GlobalReg]
    ls [Int]
    ss)
                            (Width
    W64, AvailRegs [GlobalReg]
    vs [GlobalReg]
    fs [GlobalReg]
    ds [GlobalReg]
    ls (Int
    s:[Int]
    ss))
                                | Bool
    passFloatInXmm          -> (ParamLocation, AvailRegs) -> ([(a, ParamLocation)], [a])
    k (GlobalReg -> ParamLocation
    RegisterParam (Int -> GlobalReg
    DoubleReg Int
    s), [GlobalReg]
    -> [GlobalReg] -> [GlobalReg] -> [GlobalReg] -> [Int] -> AvailRegs
    AvailRegs [GlobalReg]
    vs [GlobalReg]
    fs [GlobalReg]
    ds [GlobalReg]
    ls [Int]
    ss)
                            (Width
    W64, AvailRegs [GlobalReg]
    vs [GlobalReg]
    fs (GlobalReg
    d:[GlobalReg]
    ds) [GlobalReg]
    ls [Int]
    ss)
                                | Bool -> Bool
    not Bool
    passFloatInXmm      -> (ParamLocation, AvailRegs) -> ([(a, ParamLocation)], [a])
    k (GlobalReg -> ParamLocation
    RegisterParam GlobalReg
    d, [GlobalReg]
    -> [GlobalReg] -> [GlobalReg] -> [GlobalReg] -> [Int] -> AvailRegs
    AvailRegs [GlobalReg]
    vs [GlobalReg]
    fs [GlobalReg]
    ds [GlobalReg]
    ls [Int]
    ss)
                            (Width, AvailRegs)
    _ -> ([(a, ParamLocation)]
    assts, (a
    ra -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    rs))
                  int :: ([(a, ParamLocation)], [a])
    int = case (Width
    w, AvailRegs
    regs) of
                          (Width
    W128, AvailRegs
    _) -> String -> ([(a, ParamLocation)], [a])
    forall a. HasCallStack => String -> a
    panic String
    "W128 unsupported register type"
                          (Width
    _, AvailRegs (GlobalReg
    v:[GlobalReg]
    vs) [GlobalReg]
    fs [GlobalReg]
    ds [GlobalReg]
    ls [Int]
    ss) | Width -> Int
    widthInBits Width
    w Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Width -> Int
    widthInBits (Platform -> Width
    wordWidth Platform
    platform)
                              -> (ParamLocation, AvailRegs) -> ([(a, ParamLocation)], [a])
    k (GlobalReg -> ParamLocation
    RegisterParam GlobalReg
    v, [GlobalReg]
    -> [GlobalReg] -> [GlobalReg] -> [GlobalReg] -> [Int] -> AvailRegs
    AvailRegs [GlobalReg]
    vs [GlobalReg]
    fs [GlobalReg]
    ds [GlobalReg]
    ls [Int]
    ss)
                          (Width
    _, AvailRegs [GlobalReg]
    vs [GlobalReg]
    fs [GlobalReg]
    ds (GlobalReg
    l:[GlobalReg]
    ls) [Int]
    ss) | Width -> Int
    widthInBits Width
    w Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Width -> Int
    widthInBits (Platform -> Width
    wordWidth Platform
    platform)
                              -> (ParamLocation, AvailRegs) -> ([(a, ParamLocation)], [a])
    k (GlobalReg -> ParamLocation
    RegisterParam GlobalReg
    l, [GlobalReg]
    -> [GlobalReg] -> [GlobalReg] -> [GlobalReg] -> [Int] -> AvailRegs
    AvailRegs [GlobalReg]
    vs [GlobalReg]
    fs [GlobalReg]
    ds [GlobalReg]
    ls [Int]
    ss)
                          (Width, AvailRegs)
    _   -> ([(a, ParamLocation)]
    assts, (a
    ra -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    rs))
                  k :: (ParamLocation, AvailRegs) -> ([(a, ParamLocation)], [a])
    k (ParamLocation
    asst, AvailRegs
    regs') = [(a, ParamLocation)]
    -> [a] -> AvailRegs -> ([(a, ParamLocation)], [a])
    assign_regs ((a
    r, ParamLocation
    asst) (a, ParamLocation) -> [(a, ParamLocation)] -> [(a, ParamLocation)]
    forall a. a -> [a] -> [a]
    : [(a, ParamLocation)]
    assts) [a]
    rs AvailRegs
    regs'
                  ty :: CmmType
    ty = a -> CmmType
    arg_ty a
    r
                  w :: Width
    w  = CmmType -> Width
    typeWidth CmmType
    ty
                  passFloatInXmm :: Bool
    passFloatInXmm = Platform -> Bool
    passFloatArgsInXmm Platform
    platform

    passFloatArgsInXmm :: Platform -> Bool
    passFloatArgsInXmm :: Platform -> Bool
    passFloatArgsInXmm Platform
    platform =
      -- TODO: replace the following logic by casing on @registerArch (platformArch platform)@.
      --
      -- This will mean we start saying "True" for AArch64, which the rest of the AArch64
      -- compilation pipeline will need to be able to handle (e.g. the AArch64 NCG).
      case Platform -> Arch
    platformArch Platform
    platform of
        Arch
    ArchX86_64 -> Bool
    True
        Arch
    ArchX86    -> Bool
    False
        Arch
    _          -> Bool
    False

    -- We used to spill vector registers to the stack since the LLVM backend didn't
    -- support vector registers in its calling convention. However, this has now
    -- been fixed. This function remains only as a convenient way to re-enable
    -- spilling when debugging code generation.
    passVectorInReg :: Width -> Profile -> Bool
    passVectorInReg :: Width -> Profile -> Bool
    passVectorInReg Width
    _ Profile
    _ = Bool
    True

    assignStack :: Platform -> ByteOff -> (a -> CmmType) -> [a]
                -> (
                     ByteOff              -- bytes of stack args
                   , [(a, ParamLocation)] -- args and locations
                   )
    assignStack :: forall a.
    Platform
    -> Int -> (a -> CmmType) -> [a] -> (Int, [(a, ParamLocation)])
    assignStack Platform
    platform Int
    offset a -> CmmType
    arg_ty [a]
    args = Int -> [(a, ParamLocation)] -> [a] -> (Int, [(a, ParamLocation)])
    assign_stk Int
    offset [] ([a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    args)
     where
          assign_stk :: Int -> [(a, ParamLocation)] -> [a] -> (Int, [(a, ParamLocation)])
    assign_stk Int
    offset [(a, ParamLocation)]
    assts [] = (Int
    offset, [(a, ParamLocation)]
    assts)
          assign_stk Int
    offset [(a, ParamLocation)]
    assts (a
    r:[a]
    rs)
            = Int -> [(a, ParamLocation)] -> [a] -> (Int, [(a, ParamLocation)])
    assign_stk Int
    off' ((a
    r, Int -> ParamLocation
    StackParam Int
    off') (a, ParamLocation) -> [(a, ParamLocation)] -> [(a, ParamLocation)]
    forall a. a -> [a] -> [a]
    : [(a, ParamLocation)]
    assts) [a]
    rs
            where w :: Width
    w    = CmmType -> Width
    typeWidth (a -> CmmType
    arg_ty a
    r)
                  off' :: Int
    off' = Int
    offset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    size
                  -- Stack arguments always take a whole number of words, we never
                  -- pack them unlike constructor fields.
                  size :: Int
    size = Platform -> Int -> Int
    roundUpToWords Platform
    platform (Width -> Int
    widthInBytes Width
    w)

    -----------------------------------------------------------------------------
    -- Local information about the registers available

    -- | Keep track of locally available registers.
    data AvailRegs
      = AvailRegs
        { AvailRegs -> [GlobalReg]
    availVanillaRegs :: [GlobalReg]
           -- ^ Available vanilla registers
        , AvailRegs -> [GlobalReg]
    availFloatRegs   :: [GlobalReg]
           -- ^ Available float registers
        , AvailRegs -> [GlobalReg]
    availDoubleRegs  :: [GlobalReg]
           -- ^ Available double registers
        , AvailRegs -> [GlobalReg]
    availLongRegs    :: [GlobalReg]
           -- ^ Available long registers
        , AvailRegs -> [Int]
    availXMMRegs     :: [Int]
           -- ^ Available vector XMM registers
        }

    noAvailRegs :: AvailRegs
    noAvailRegs :: AvailRegs
    noAvailRegs = [GlobalReg]
    -> [GlobalReg] -> [GlobalReg] -> [GlobalReg] -> [Int] -> AvailRegs
    AvailRegs [] [] [] [] []

    -- Vanilla registers can contain pointers, Ints, Chars.
    -- Floats and doubles have separate register supplies.
    --
    -- We take these register supplies from the *real* registers, i.e. those
    -- that are guaranteed to map to machine registers.

    getRegsWithoutNode, getRegsWithNode :: Platform -> AvailRegs
    getRegsWithoutNode :: Platform -> AvailRegs
    getRegsWithoutNode Platform
    platform =
      AvailRegs
       { availVanillaRegs :: [GlobalReg]
    availVanillaRegs = (GlobalReg -> Bool) -> [GlobalReg] -> [GlobalReg]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\GlobalReg
    r -> GlobalReg
    r GlobalReg -> GlobalReg -> Bool
    forall a. Eq a => a -> a -> Bool
    /= GlobalReg
    node) (Platform -> [GlobalReg]
    realVanillaRegs Platform
    platform)
       , availFloatRegs :: [GlobalReg]
    availFloatRegs   = Platform -> [GlobalReg]
    realFloatRegs Platform
    platform
       , availDoubleRegs :: [GlobalReg]
    availDoubleRegs  = Platform -> [GlobalReg]
    realDoubleRegs Platform
    platform
       , availLongRegs :: [GlobalReg]
    availLongRegs    = Platform -> [GlobalReg]
    realLongRegs Platform
    platform
       , availXMMRegs :: [Int]
    availXMMRegs     = Platform -> [Int]
    realXmmRegNos Platform
    platform }

    -- getRegsWithNode uses R1/node even if it isn't a register
    getRegsWithNode :: Platform -> AvailRegs
    getRegsWithNode Platform
    platform =
      AvailRegs
       { availVanillaRegs :: [GlobalReg]
    availVanillaRegs = if [GlobalReg] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Platform -> [GlobalReg]
    realVanillaRegs Platform
    platform)
                            then [Int -> GlobalReg
    VanillaReg Int
    1]
                            else Platform -> [GlobalReg]
    realVanillaRegs Platform
    platform
       , availFloatRegs :: [GlobalReg]
    availFloatRegs   = Platform -> [GlobalReg]
    realFloatRegs Platform
    platform
       , availDoubleRegs :: [GlobalReg]
    availDoubleRegs  = Platform -> [GlobalReg]
    realDoubleRegs Platform
    platform
       , availLongRegs :: [GlobalReg]
    availLongRegs    = Platform -> [GlobalReg]
    realLongRegs Platform
    platform
       , availXMMRegs :: [Int]
    availXMMRegs     = Platform -> [Int]
    realXmmRegNos Platform
    platform }

    allFloatRegs, allDoubleRegs, allLongRegs :: Platform -> [GlobalReg]
    allVanillaRegs :: Platform -> [GlobalReg]
    allXmmRegs :: Platform -> [Int]

    allVanillaRegs :: Platform -> [GlobalReg]
    allVanillaRegs Platform
    platform = (Int -> GlobalReg) -> [Int] -> [GlobalReg]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> GlobalReg
    VanillaReg ([Int] -> [GlobalReg]) -> [Int] -> [GlobalReg]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Int]
    regList (PlatformConstants -> Int
    pc_MAX_Vanilla_REG (Platform -> PlatformConstants
    platformConstants Platform
    platform))
    allFloatRegs :: Platform -> [GlobalReg]
    allFloatRegs   Platform
    platform = (Int -> GlobalReg) -> [Int] -> [GlobalReg]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> GlobalReg
    FloatReg   ([Int] -> [GlobalReg]) -> [Int] -> [GlobalReg]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Int]
    regList (PlatformConstants -> Int
    pc_MAX_Float_REG   (Platform -> PlatformConstants
    platformConstants Platform
    platform))
    allDoubleRegs :: Platform -> [GlobalReg]
    allDoubleRegs  Platform
    platform = (Int -> GlobalReg) -> [Int] -> [GlobalReg]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> GlobalReg
    DoubleReg  ([Int] -> [GlobalReg]) -> [Int] -> [GlobalReg]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Int]
    regList (PlatformConstants -> Int
    pc_MAX_Double_REG  (Platform -> PlatformConstants
    platformConstants Platform
    platform))
    allLongRegs :: Platform -> [GlobalReg]
    allLongRegs    Platform
    platform = (Int -> GlobalReg) -> [Int] -> [GlobalReg]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> GlobalReg
    LongReg    ([Int] -> [GlobalReg]) -> [Int] -> [GlobalReg]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Int]
    regList (PlatformConstants -> Int
    pc_MAX_Long_REG    (Platform -> PlatformConstants
    platformConstants Platform
    platform))
    allXmmRegs :: Platform -> [Int]
    allXmmRegs     Platform
    platform =                  Int -> [Int]
    regList (PlatformConstants -> Int
    pc_MAX_XMM_REG     (Platform -> PlatformConstants
    platformConstants Platform
    platform))

    realFloatRegs, realDoubleRegs, realLongRegs :: Platform -> [GlobalReg]
    realVanillaRegs :: Platform -> [GlobalReg]

    realVanillaRegs :: Platform -> [GlobalReg]
    realVanillaRegs Platform
    platform = (Int -> GlobalReg) -> [Int] -> [GlobalReg]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> GlobalReg
    VanillaReg ([Int] -> [GlobalReg]) -> [Int] -> [GlobalReg]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Int]
    regList (PlatformConstants -> Int
    pc_MAX_Real_Vanilla_REG (Platform -> PlatformConstants
    platformConstants Platform
    platform))
    realFloatRegs :: Platform -> [GlobalReg]
    realFloatRegs   Platform
    platform = (Int -> GlobalReg) -> [Int] -> [GlobalReg]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> GlobalReg
    FloatReg   ([Int] -> [GlobalReg]) -> [Int] -> [GlobalReg]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Int]
    regList (PlatformConstants -> Int
    pc_MAX_Real_Float_REG   (Platform -> PlatformConstants
    platformConstants Platform
    platform))
    realDoubleRegs :: Platform -> [GlobalReg]
    realDoubleRegs  Platform
    platform = (Int -> GlobalReg) -> [Int] -> [GlobalReg]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> GlobalReg
    DoubleReg  ([Int] -> [GlobalReg]) -> [Int] -> [GlobalReg]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Int]
    regList (PlatformConstants -> Int
    pc_MAX_Real_Double_REG  (Platform -> PlatformConstants
    platformConstants Platform
    platform))
    realLongRegs :: Platform -> [GlobalReg]
    realLongRegs    Platform
    platform = (Int -> GlobalReg) -> [Int] -> [GlobalReg]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> GlobalReg
    LongReg    ([Int] -> [GlobalReg]) -> [Int] -> [GlobalReg]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Int]
    regList (PlatformConstants -> Int
    pc_MAX_Real_Long_REG    (Platform -> PlatformConstants
    platformConstants Platform
    platform))

    realXmmRegNos :: Platform -> [Int]
    realXmmRegNos :: Platform -> [Int]
    realXmmRegNos Platform
    platform
        | Platform -> Bool
    isSse2Enabled Platform
    platform Bool -> Bool -> Bool
    || Platform -> Arch
    platformArch Platform
    platform Arch -> Arch -> Bool
    forall a. Eq a => a -> a -> Bool
    == Arch
    ArchAArch64
        = Int -> [Int]
    regList (PlatformConstants -> Int
    pc_MAX_Real_XMM_REG (Platform -> PlatformConstants
    platformConstants Platform
    platform))
        | Bool
    otherwise
        = []

    regList :: Int -> [Int]
    regList :: Int -> [Int]
    regList Int
    n = [Int
    1 .. Int
    n]

    allRegs :: Platform -> AvailRegs
    allRegs :: Platform -> AvailRegs
    allRegs Platform
    platform =
      AvailRegs
       { availVanillaRegs :: [GlobalReg]
    availVanillaRegs = Platform -> [GlobalReg]
    allVanillaRegs Platform
    platform
       , availFloatRegs :: [GlobalReg]
    availFloatRegs   = Platform -> [GlobalReg]
    allFloatRegs   Platform
    platform
       , availDoubleRegs :: [GlobalReg]
    availDoubleRegs  = Platform -> [GlobalReg]
    allDoubleRegs  Platform
    platform
       , availLongRegs :: [GlobalReg]
    availLongRegs    = Platform -> [GlobalReg]
    allLongRegs    Platform
    platform
       , availXMMRegs :: [Int]
    availXMMRegs     = Platform -> [Int]
    allXmmRegs     Platform
    platform }

    nodeOnly :: AvailRegs
    nodeOnly :: AvailRegs
    nodeOnly = AvailRegs
    noAvailRegs { availVanillaRegs = [VanillaReg 1] }

    -- | A set of global registers that cover the machine registers used
    -- for argument passing.
    --
    -- See Note [realArgRegsCover].
    realArgRegsCover :: Platform
                     -> GlobalArgRegs
                        -- ^ which kinds of registers do we want to cover?
                     -> [GlobalReg]
    realArgRegsCover :: Platform -> GlobalArgRegs -> [GlobalReg]
    realArgRegsCover Platform
    platform GlobalArgRegs
    argRegs
      =  Platform -> [GlobalReg]
    realVanillaRegs Platform
    platform
      [GlobalReg] -> [GlobalReg] -> [GlobalReg]
    forall a. [a] -> [a] -> [a]
    ++ Platform -> [GlobalReg]
    realLongRegs    Platform
    platform
      [GlobalReg] -> [GlobalReg] -> [GlobalReg]
    forall a. [a] -> [a] -> [a]
    ++ [[GlobalReg]] -> [GlobalReg]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
          (  [ Platform -> [GlobalReg]
    realFloatRegs Platform
    platform  | Bool
    wantFP, Bool -> Bool
    not (Platform -> Bool
    passFloatArgsInXmm Platform
    platform) ]
               -- TODO: the line above is legacy logic, but removing it breaks
               -- the bytecode interpreter on AArch64. Probably easy to fix.
               -- AK: I believe this might be because we map REG_F1..4 and REG_D1..4 to different
               -- machine registers on AArch64.
          [[GlobalReg]] -> [[GlobalReg]] -> [[GlobalReg]]
    forall a. [a] -> [a] -> [a]
    ++ [ Platform -> [GlobalReg]
    realDoubleRegs Platform
    platform | Bool
    wantFP ]
          )
      [GlobalReg] -> [GlobalReg] -> [GlobalReg]
    forall a. [a] -> [a] -> [a]
    ++ [ Int -> GlobalReg
    mkVecReg Int
    i | Int -> GlobalReg
    mkVecReg <- Maybe (Int -> GlobalReg) -> [Int -> GlobalReg]
    forall a. Maybe a -> [a]
    maybeToList Maybe (Int -> GlobalReg)
    mbMkVecReg
                      , Int
    i <- Platform -> [Int]
    realXmmRegNos Platform
    platform ]

      where
        wantFP :: Bool
    wantFP = case Arch -> RegArch
    registerArch (Platform -> Arch
    platformArch Platform
    platform) of
          RegArch
    Unified   -> GlobalArgRegs
    argRegs GlobalArgRegs -> GlobalArgRegs -> Bool
    forall a. Eq a => a -> a -> Bool
    == GlobalArgRegs
    SCALAR_ARG_REGS
          RegArch
    Separate  -> GlobalArgRegs
    argRegs GlobalArgRegs -> GlobalArgRegs -> Bool
    forall a. Ord a => a -> a -> Bool
    >= GlobalArgRegs
    SCALAR_ARG_REGS
          RegArch
    NoVectors -> GlobalArgRegs
    argRegs GlobalArgRegs -> GlobalArgRegs -> Bool
    forall a. Ord a => a -> a -> Bool
    >= GlobalArgRegs
    SCALAR_ARG_REGS
        mbMkVecReg :: Maybe (Int -> GlobalReg)
    mbMkVecReg = case Arch -> RegArch
    registerArch (Platform -> Arch
    platformArch Platform
    platform) of
          RegArch
    Unified   -> Maybe (Int -> GlobalReg)
    mb_xyzmm
          RegArch
    Separate  -> Maybe (Int -> GlobalReg)
    mb_xyzmm
          RegArch
    NoVectors -> Maybe (Int -> GlobalReg)
    forall a. Maybe a
    Nothing
        mb_xyzmm :: Maybe (Int -> GlobalReg)
    mb_xyzmm = case GlobalArgRegs
    argRegs of
          GlobalArgRegs
    V16_ARG_REGS -> (Int -> GlobalReg) -> Maybe (Int -> GlobalReg)
    forall a. a -> Maybe a
    Just Int -> GlobalReg
    XmmReg
          GlobalArgRegs
    V32_ARG_REGS -> (Int -> GlobalReg) -> Maybe (Int -> GlobalReg)
    forall a. a -> Maybe a
    Just Int -> GlobalReg
    YmmReg
          GlobalArgRegs
    V64_ARG_REGS -> (Int -> GlobalReg) -> Maybe (Int -> GlobalReg)
    forall a. a -> Maybe a
    Just Int -> GlobalReg
    ZmmReg
          GlobalArgRegs
    _ -> Maybe (Int -> GlobalReg)
    forall a. Maybe a
    Nothing

    -- | Like "realArgRegsCover", but always includes the node.
    --
    -- See Note [realArgRegsCover].
    allArgRegsCover :: Platform
                    -> GlobalArgRegs
                        -- ^ which kinds of registers do we want to cover?
                    -> [GlobalReg]
    allArgRegsCover :: Platform -> GlobalArgRegs -> [GlobalReg]
    allArgRegsCover Platform
    platform GlobalArgRegs
    argRegs =
      [GlobalReg] -> [GlobalReg]
    forall a. Eq a => [a] -> [a]
    nub (GlobalReg
    node GlobalReg -> [GlobalReg] -> [GlobalReg]
    forall a. a -> [a] -> [a]
    : Platform -> GlobalArgRegs -> [GlobalReg]
    realArgRegsCover Platform
    platform GlobalArgRegs
    argRegs)
      where
        node :: GlobalReg
    node = Int -> GlobalReg
    VanillaReg Int
    1

    {- Note [realArgRegsCover]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    In low-level Cmm, jumps must be annotated with a set of live registers,
    allowing precise control of global STG register contents across function calls.
    However, in some places (in particular in the RTS), the registers we want to
    preserve depend on the *caller*. For example, if we intercept a function call
    via a stack underflow frame, we want to preserve exactly those registers
    containing function arguments.
    Since we can't know exactly how many arguments the caller passed, we settle on
    simply preserving all global regs which might be used for argument passing.
    To do this, we specify a collection of registers that *covers* all the registers
    we want to preserve; this is done by "realArgRegsCover".

    The situation is made somewhat tricky by the need to handle vector registers.
    For example, on X86_64, the F, D, XMM, YMM, ZMM overlap in the following way
              ┌─┬─┬───┬───────┬───────────────┐
              │F┆D┆XMM┆  YMM  ┆     ZMM       │
              └─┴─┴───┴───────┴───────────────┘
    where each register extends all the way to the left.

    Based on this register architecture, on X86_64 we might want to annotate a jump
    in which we (might) want to preserve the contents of all argument-passing
    registers with [R1, ..., R6, ZMM1, ..., ZMM6]. This, however, is not possible
    in general, because preserving e.g. a ZMM register across a C call requires the
    availability of the AVX-512F instruction set. If we did this, the RTS would
    crash at runtime with an "invalid instruction" error on X86_64 machines which
    do not support AVX-512F.

    Instead, we parametrise "realArgRegsCover" on the 'GlobalArgRegs' datatype, which
    specifies which registers it is sufficient to preserve. For example, it might
    suffice to only preserve general-purpose registers, or to only preserve up to
    XMM (not YMM or ZMM).

    Then, to handle certain functions in the RTS such as "stack_underflow_frame", we
    proceed by defining 4 variants, stack_underflow_frame_{d,v16,v32,v64}, which
    respectively annotate the jump at the end of the function with SCALAR_ARG_REGS,
    V16_ARG_REGS, V32_ARG_REGS and V64_ARG_REGS. Compiling these variants, in effect,
    amounts to compiling "stack_underflow_frame" four times, once for each level of
    vector support. Then, in the RTS, we dispatch at runtime based on the support
    for vectors provided by the architecture on the current machine (see e.g.
    'threadStackOverflow' and its 'switch (vectorSupportGlobalVar)'.)

    Note that, like in Note [AutoApply.cmm for vectors], it is **critical** that we
    compile e.g. stack_underflow_frame_v64 with -mavx512f. If we don't, the LLVM
    backend is liable to compile code using e.g. the ZMM1 STG register to uses of
    X86 machine registers xmm1, xmm2, xmm3, xmm4, instead of just zmm1. This would
    mean that LLVM produces ABI-incompatible code that would result in segfaults in
    the RTS.
    -}