-- | Calling conventions. There are basically only two: System V (Linux, OSX, BSD) and Win64\/fastcall

{-# language NoMonomorphismRestriction #-}
{-# language CPP #-}
{-# language DataKinds #-}
module CodeGen.X86.CallConv where

import Foreign
import Data.Monoid

import CodeGen.X86.Asm
import CodeGen.X86.CodeGen

------------------------------------------------------------------------------ 

#if defined (mingw32_HOST_OS) || defined (mingw64_HOST_OS)

-- On Win64 the caller have to reserve 32 byte "shadow space" on the stack (and clean up after)
callFun :: Operand RW S64 -> FunPtr a -> Code
callFun r p = do
  sub rsp 32
  mov r (fromIntegral $ ptrToIntPtr $ castFunPtrToPtr p)
  call r
  add rsp 32

#elif defined (darwin_HOST_OS)

-- OSX requires 16 byte alignment of the stack...
callFun :: Operand RW S64 -> FunPtr a -> Code
callFun r p = do
  push r15              -- we will use r15 (non-volatile) to store old rsp
  mov r15 15            -- 0xf
  not_ r15              -- 0xffff ... fff0
  and_ r15 rsp          -- align rsp into r15
  xchg r15 rsp          -- new rsp = aligned, r15 = old rsp
  mov r (fromIntegral $ ptrToIntPtr $ castFunPtrToPtr p)
  call r
  mov rsp r15           -- restore rsp
  pop r15               -- restore r15

#else

-- helper to call a function
callFun :: Operand RW S64 -> FunPtr a -> Code
callFun :: Operand 'RW 'S64 -> FunPtr a -> Code
callFun Operand 'RW 'S64
r FunPtr a
p = do
  Operand 'RW 'S64 -> Operand 'R 'S64 -> Code
forall (s :: Size) (r :: Access).
IsSize s =>
Operand 'RW s -> Operand r s -> Code
mov Operand 'RW 'S64
r (Operand 'R 'S64 -> Code) -> Operand 'R 'S64 -> Code
forall a b. (a -> b) -> a -> b
$ IntPtr -> Operand 'R 'S64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IntPtr -> Operand 'R 'S64) -> IntPtr -> Operand 'R 'S64
forall a b. (a -> b) -> a -> b
$ Ptr Any -> IntPtr
forall a. Ptr a -> IntPtr
ptrToIntPtr (Ptr Any -> IntPtr) -> Ptr Any -> IntPtr
forall a b. (a -> b) -> a -> b
$ FunPtr a -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr a
p
  Operand 'RW 'S64 -> Code
forall (r :: Access). Operand r 'S64 -> Code
call Operand 'RW 'S64
r

#endif

------------------------------------------------------------------------------ 

-- | Save the non-volatile registers, execute the code, restore the registers 
-- and return after.
--
-- Note: R12..R15 should be preserved on both Windows and Linux (or 
-- System V convention in general). This is the responsability of the 
-- user (this function won't save them, but you can use "saveR12R15" in 
-- addition to this).
--
saveNonVolatile :: Code -> Code
saveNonVolatile :: Code -> Code
saveNonVolatile Code
code = Code
prologue Code -> Code -> Code
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Code
code Code -> Code -> Code
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Code
epilogue Code -> Code -> Code
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Code
ret

-- | Saves R12, R13, R14 and R15 (on the stack).
saveR12R15 :: Code -> Code
saveR12R15 :: Code -> Code
saveR12R15 Code
code = do
  Operand Any 'S64 -> Code
forall (r :: Access). Operand r 'S64 -> Code
push Operand Any 'S64
forall (c :: Size -> *). FromReg c => c 'S64
r12
  Operand Any 'S64 -> Code
forall (r :: Access). Operand r 'S64 -> Code
push Operand Any 'S64
forall (c :: Size -> *). FromReg c => c 'S64
r13
  Operand Any 'S64 -> Code
forall (r :: Access). Operand r 'S64 -> Code
push Operand Any 'S64
forall (c :: Size -> *). FromReg c => c 'S64
r14
  Operand Any 'S64 -> Code
forall (r :: Access). Operand r 'S64 -> Code
push Operand Any 'S64
forall (c :: Size -> *). FromReg c => c 'S64
r15
  Code
code
  Operand 'RW 'S64 -> Code
pop Operand 'RW 'S64
forall (c :: Size -> *). FromReg c => c 'S64
r15
  Operand 'RW 'S64 -> Code
pop Operand 'RW 'S64
forall (c :: Size -> *). FromReg c => c 'S64
r14
  Operand 'RW 'S64 -> Code
pop Operand 'RW 'S64
forall (c :: Size -> *). FromReg c => c 'S64
r13
  Operand 'RW 'S64 -> Code
pop Operand 'RW 'S64
forall (c :: Size -> *). FromReg c => c 'S64
r12

------------------------------------------------------------------------------ 
-- calling conventions

#if defined (mingw32_HOST_OS) || defined (mingw64_HOST_OS)

---------- Win64 calling convention ----------

arg1 = rcx
arg2 = rdx
arg3 = r8
arg4 = r9
-- rest of the arguments on the stack

result = rax

prologue = do
  push rbp
  push rbx
  push rdi
  push rsi

epilogue = do
  pop rsi
  pop rdi
  pop rbx
  pop rbp

#else

---------- System V calling convention ----------

arg1 :: c 'S64
arg1 = c 'S64
forall (c :: Size -> *). FromReg c => c 'S64
rdi
arg2 :: c 'S64
arg2 = c 'S64
forall (c :: Size -> *). FromReg c => c 'S64
rsi
arg3 :: c 'S64
arg3 = c 'S64
forall (c :: Size -> *). FromReg c => c 'S64
rdx
arg4 :: c 'S64
arg4 = c 'S64
forall (c :: Size -> *). FromReg c => c 'S64
rcx
arg5 :: c 'S64
arg5 = c 'S64
forall (c :: Size -> *). FromReg c => c 'S64
r8
arg6 :: c 'S64
arg6 = c 'S64
forall (c :: Size -> *). FromReg c => c 'S64
r9
-- rest of the arguments on the stack

result :: c 'S64
result = c 'S64
forall (c :: Size -> *). FromReg c => c 'S64
rax

prologue :: Code
prologue = do
  Operand Any 'S64 -> Code
forall (r :: Access). Operand r 'S64 -> Code
push Operand Any 'S64
forall (c :: Size -> *). FromReg c => c 'S64
rbp
  Operand Any 'S64 -> Code
forall (r :: Access). Operand r 'S64 -> Code
push Operand Any 'S64
forall (c :: Size -> *). FromReg c => c 'S64
rbx

epilogue :: Code
epilogue = do
  Operand 'RW 'S64 -> Code
pop Operand 'RW 'S64
forall (c :: Size -> *). FromReg c => c 'S64
rbx
  Operand 'RW 'S64 -> Code
pop Operand 'RW 'S64
forall (c :: Size -> *). FromReg c => c 'S64
rbp

#endif

------------------------------------------------------------------------------