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

import GHC.Prelude
import Data.List (nub)

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

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

-- 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 (Width
w, AvailRegs
regs) of
                      (Width
W128, ([VGcPtr -> GlobalReg]
vs, [GlobalReg]
fs, [GlobalReg]
ds, [GlobalReg]
ls, Int
s:[Int]
ss))
                          | Width -> Profile -> Bool
passVectorInReg Width
W128 Profile
profile -> (ParamLocation, AvailRegs) -> ([(a, ParamLocation)], [a])
k (GlobalReg -> ParamLocation
RegisterParam (Int -> GlobalReg
XmmReg Int
s), ([VGcPtr -> GlobalReg]
vs, [GlobalReg]
fs, [GlobalReg]
ds, [GlobalReg]
ls, [Int]
ss))
                      (Width
W256, ([VGcPtr -> GlobalReg]
vs, [GlobalReg]
fs, [GlobalReg]
ds, [GlobalReg]
ls, Int
s:[Int]
ss))
                          | Width -> Profile -> Bool
passVectorInReg Width
W256 Profile
profile -> (ParamLocation, AvailRegs) -> ([(a, ParamLocation)], [a])
k (GlobalReg -> ParamLocation
RegisterParam (Int -> GlobalReg
YmmReg Int
s), ([VGcPtr -> GlobalReg]
vs, [GlobalReg]
fs, [GlobalReg]
ds, [GlobalReg]
ls, [Int]
ss))
                      (Width
W512, ([VGcPtr -> GlobalReg]
vs, [GlobalReg]
fs, [GlobalReg]
ds, [GlobalReg]
ls, Int
s:[Int]
ss))
                          | Width -> Profile -> Bool
passVectorInReg Width
W512 Profile
profile -> (ParamLocation, AvailRegs) -> ([(a, ParamLocation)], [a])
k (GlobalReg -> ParamLocation
RegisterParam (Int -> GlobalReg
ZmmReg Int
s), ([VGcPtr -> 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))
              float :: ([(a, ParamLocation)], [a])
float = case (Width
w, AvailRegs
regs) of
                        (Width
W32, ([VGcPtr -> 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), ([VGcPtr -> GlobalReg]
vs, [GlobalReg]
fs, [GlobalReg]
ds, [GlobalReg]
ls, [Int]
ss))
                        (Width
W32, ([VGcPtr -> 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, ([VGcPtr -> GlobalReg]
vs, [GlobalReg]
fs, [GlobalReg]
ds, [GlobalReg]
ls, [Int]
ss))
                        (Width
W64, ([VGcPtr -> 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), ([VGcPtr -> GlobalReg]
vs, [GlobalReg]
fs, [GlobalReg]
ds, [GlobalReg]
ls, [Int]
ss))
                        (Width
W64, ([VGcPtr -> 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, ([VGcPtr -> 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
_, (VGcPtr -> GlobalReg
v:[VGcPtr -> 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 (VGcPtr -> GlobalReg
v VGcPtr
gcp), ([VGcPtr -> GlobalReg]
vs, [GlobalReg]
fs, [GlobalReg]
ds, [GlobalReg]
ls, [Int]
ss))
                      (Width
_, ([VGcPtr -> 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, ([VGcPtr -> 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
              !gcp :: VGcPtr
gcp | CmmType -> Bool
isGcPtrType CmmType
ty = VGcPtr
VGcPtr
                   | Bool
otherwise      = VGcPtr
VNonGcPtr
              passFloatInXmm :: Bool
passFloatInXmm = Platform -> Bool
passFloatArgsInXmm Platform
platform

passFloatArgsInXmm :: Platform -> Bool
passFloatArgsInXmm :: Platform -> Bool
passFloatArgsInXmm Platform
platform = 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

type AvailRegs = ( [VGcPtr -> GlobalReg]   -- available vanilla regs.
                 , [GlobalReg]   -- floats
                 , [GlobalReg]   -- doubles
                 , [GlobalReg]   -- longs (int64 and word64)
                 , [Int]         -- XMM (floats and doubles)
                 )

-- 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 =
  ( ((VGcPtr -> GlobalReg) -> Bool)
-> [VGcPtr -> GlobalReg] -> [VGcPtr -> GlobalReg]
forall a. (a -> Bool) -> [a] -> [a]
filter (\VGcPtr -> GlobalReg
r -> VGcPtr -> GlobalReg
r VGcPtr
VGcPtr GlobalReg -> GlobalReg -> Bool
forall a. Eq a => a -> a -> Bool
/= GlobalReg
node) (Platform -> [VGcPtr -> GlobalReg]
realVanillaRegs Platform
platform)
  , Platform -> [GlobalReg]
realFloatRegs Platform
platform
  , Platform -> [GlobalReg]
realDoubleRegs Platform
platform
  , Platform -> [GlobalReg]
realLongRegs Platform
platform
  , Platform -> [Int]
realXmmRegNos Platform
platform)

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

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

allVanillaRegs :: Platform -> [VGcPtr -> GlobalReg]
allVanillaRegs Platform
platform = (Int -> VGcPtr -> GlobalReg) -> [Int] -> [VGcPtr -> GlobalReg]
forall a b. (a -> b) -> [a] -> [b]
map Int -> VGcPtr -> GlobalReg
VanillaReg ([Int] -> [VGcPtr -> GlobalReg]) -> [Int] -> [VGcPtr -> 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 -> [VGcPtr -> GlobalReg]

realVanillaRegs :: Platform -> [VGcPtr -> GlobalReg]
realVanillaRegs Platform
platform = (Int -> VGcPtr -> GlobalReg) -> [Int] -> [VGcPtr -> GlobalReg]
forall a b. (a -> b) -> [a] -> [b]
map Int -> VGcPtr -> GlobalReg
VanillaReg ([Int] -> [VGcPtr -> GlobalReg]) -> [Int] -> [VGcPtr -> 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 = 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 = ( Platform -> [VGcPtr -> GlobalReg]
allVanillaRegs Platform
platform
                   , Platform -> [GlobalReg]
allFloatRegs   Platform
platform
                   , Platform -> [GlobalReg]
allDoubleRegs  Platform
platform
                   , Platform -> [GlobalReg]
allLongRegs    Platform
platform
                   , Platform -> [Int]
allXmmRegs     Platform
platform
                   )

nodeOnly :: AvailRegs
nodeOnly :: AvailRegs
nodeOnly = ([Int -> VGcPtr -> GlobalReg
VanillaReg Int
1], [], [], [], [])

-- This returns the set of global registers that *cover* the machine registers
-- used for argument passing. On platforms where registers can overlap---right
-- now just x86-64, where Float and Double registers overlap---passing this set
-- of registers is guaranteed to preserve the contents of all live registers. We
-- only use this functionality in hand-written C-- code in the RTS.
realArgRegsCover :: Platform -> [GlobalReg]
realArgRegsCover :: Platform -> [GlobalReg]
realArgRegsCover Platform
platform
    | Platform -> Bool
passFloatArgsInXmm Platform
platform
    = ((VGcPtr -> GlobalReg) -> GlobalReg)
-> [VGcPtr -> GlobalReg] -> [GlobalReg]
forall a b. (a -> b) -> [a] -> [b]
map ((VGcPtr -> GlobalReg) -> VGcPtr -> GlobalReg
forall a b. (a -> b) -> a -> b
$ VGcPtr
VGcPtr) (Platform -> [VGcPtr -> 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]
++
      Platform -> [GlobalReg]
realDoubleRegs Platform
platform -- we only need to save the low Double part of XMM registers.
                              -- Moreover, the NCG can't load/store full XMM
                              -- registers for now...

    | Bool
otherwise
    = ((VGcPtr -> GlobalReg) -> GlobalReg)
-> [VGcPtr -> GlobalReg] -> [GlobalReg]
forall a b. (a -> b) -> [a] -> [b]
map ((VGcPtr -> GlobalReg) -> VGcPtr -> GlobalReg
forall a b. (a -> b) -> a -> b
$ VGcPtr
VGcPtr) (Platform -> [VGcPtr -> GlobalReg]
realVanillaRegs Platform
platform) [GlobalReg] -> [GlobalReg] -> [GlobalReg]
forall a. [a] -> [a] -> [a]
++
      Platform -> [GlobalReg]
realFloatRegs  Platform
platform [GlobalReg] -> [GlobalReg] -> [GlobalReg]
forall a. [a] -> [a] -> [a]
++
      Platform -> [GlobalReg]
realDoubleRegs Platform
platform [GlobalReg] -> [GlobalReg] -> [GlobalReg]
forall a. [a] -> [a] -> [a]
++
      Platform -> [GlobalReg]
realLongRegs   Platform
platform
      -- we don't save XMM registers if they are not used for parameter passing


{-

  Note [GHCi and native call registers]
  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

  The GHCi bytecode interpreter does not have access to the STG registers
  that the native calling convention uses for passing arguments. It uses
  helper stack frames to move values between the stack and registers.

  If only a single register needs to be moved, GHCi uses a specific stack
  frame. For example stg_ctoi_R1p saves a heap pointer value from STG register
  R1 and stg_ctoi_D1 saves a double precision floating point value from D1.
  In the other direction, helpers stg_ret_p and stg_ret_d move a value from
  the stack to the R1 and D1 registers, respectively.

  When GHCi needs to move more than one register it cannot use a specific
  helper frame. It would simply be impossible to create a helper for all
  possible combinations of register values. Instead, there are generic helper
  stack frames that use a call_info word that describes the active registers
  and the number of stack words used by the arguments of a call.

  These helper stack frames are currently:

      - stg_ret_t:    return a tuple to the continuation at the top of
                          the stack
      - stg_ctoi_t:   convert a tuple return value to be used in
                          bytecode
      - stg_primcall: call a function


  The call_info word contains a bitmap of the active registers
  for the call and and a stack offset. The layout is as follows:

      - bit 0-23:  Bitmap of active registers for the call, the
                   order corresponds to the list returned by
                   allArgRegsCover. For example if bit 0 (the least
                   significant bit) is set, the first register in the
                   allArgRegsCover list is active. Bit 1 for the
                   second register in the list and so on.

      - bit 24-31: Unsigned byte indicating the stack offset
                   of the continuation in words. For tuple returns
                   this is the number of words returned on the
                   stack. For primcalls this field is unused, since
                   we don't jump to a continuation.

    The upper 32 bits on 64 bit platforms are currently unused.

    If a register is smaller than a word on the stack (for example a
    single precision float on a 64 bit system), then the stack slot
    is padded to a whole word.

    Example:

        If a tuple is returned in three registers and an additional two
        words on the stack, then three bits in the register bitmap
        (bits 0-23) would be set. And bit 24-31 would be
        00000010 (two in binary).

        The values on the stack before a call to POP_ARG_REGS would
        be as follows:

            ...
            continuation
            stack_arg_1
            stack_arg_2
            register_arg_3
            register_arg_2
            register_arg_1 <- Sp

        A call to POP_ARG_REGS(call_info) would move register_arg_1
        to the register corresponding to the lowest set bit in the
        call_info word. register_arg_2 would be moved to the register
        corresponding to the second lowest set bit, and so on.

        After POP_ARG_REGS(call_info), the stack pointer Sp points
        to the topmost stack argument, so the stack looks as follows:

            ...
            continuation
            stack_arg_1
            stack_arg_2 <- Sp

        At this point all the arguments are in place and we are ready
        to jump to the continuation, the location (offset from Sp) of
        which is found by inspecting the value of bits 24-31. In this
        case the offset is two words.

    On x86_64, the double precision (Dn) and single precision
    floating (Fn) point registers overlap, e.g. D1 uses the same
    physical register as F1. On this platform, the list returned
    by allArgRegsCover contains only entries for the double
    precision registers. If an argument is passed in register
    Fn, the bit corresponding to Dn should be set.

  Note: if anything changes in how registers for native calls overlap,
           make sure to also update GHC.StgToByteCode.layoutNativeCall
 -}

-- Like realArgRegsCover but always includes the node. This covers all real
-- and virtual registers actually used for passing arguments.

allArgRegsCover :: Platform -> [GlobalReg]
allArgRegsCover :: Platform -> [GlobalReg]
allArgRegsCover Platform
platform =
  [GlobalReg] -> [GlobalReg]
forall a. Eq a => [a] -> [a]
nub (Int -> VGcPtr -> GlobalReg
VanillaReg Int
1 VGcPtr
VGcPtr GlobalReg -> [GlobalReg] -> [GlobalReg]
forall a. a -> [a] -> [a]
: Platform -> [GlobalReg]
realArgRegsCover Platform
platform)