module GHCi.FFI
( FFIType(..)
, FFIConv(..)
, C_ffi_cif
, prepForeignCall
, freeForeignCallInfo
) where
import Control.Exception
import Data.Binary
import GHC.Generics
import Foreign
import Foreign.C
data FFIType
= FFIVoid
| FFIPointer
| FFIFloat
| FFIDouble
| FFISInt8
| FFISInt16
| FFISInt32
| FFISInt64
| FFIUInt8
| FFIUInt16
| FFIUInt32
| FFIUInt64
deriving (Show, Generic, Binary)
data FFIConv
= FFICCall
| FFIStdCall
deriving (Show, Generic, Binary)
prepForeignCall
:: FFIConv
-> [FFIType]
-> FFIType
-> IO (Ptr C_ffi_cif)
prepForeignCall cconv arg_types result_type = do
let n_args = length arg_types
arg_arr <- mallocArray n_args
pokeArray arg_arr (map ffiType arg_types)
cif <- mallocBytes (32)
let abi = convToABI cconv
r <- ffi_prep_cif cif abi (fromIntegral n_args) (ffiType result_type) arg_arr
if (r /= fFI_OK)
then throwIO (ErrorCall ("prepForeignCallFailed: " ++ show r))
else return (castPtr cif)
freeForeignCallInfo :: Ptr C_ffi_cif -> IO ()
freeForeignCallInfo p = do
free (((\hsc_ptr -> hsc_ptr `plusPtr` 8)) p)
free p
convToABI :: FFIConv -> C_ffi_abi
convToABI FFICCall = fFI_DEFAULT_ABI
convToABI _ = fFI_DEFAULT_ABI
ffiType :: FFIType -> Ptr C_ffi_type
ffiType FFIVoid = ffi_type_void
ffiType FFIPointer = ffi_type_pointer
ffiType FFIFloat = ffi_type_float
ffiType FFIDouble = ffi_type_double
ffiType FFISInt8 = ffi_type_sint8
ffiType FFISInt16 = ffi_type_sint16
ffiType FFISInt32 = ffi_type_sint32
ffiType FFISInt64 = ffi_type_sint64
ffiType FFIUInt8 = ffi_type_uint8
ffiType FFIUInt16 = ffi_type_uint16
ffiType FFIUInt32 = ffi_type_uint32
ffiType FFIUInt64 = ffi_type_uint64
data C_ffi_type
data C_ffi_cif
type C_ffi_status = (Word32)
type C_ffi_abi = (Word32)
foreign import ccall "&ffi_type_void" ffi_type_void :: Ptr C_ffi_type
foreign import ccall "&ffi_type_uint8" ffi_type_uint8 :: Ptr C_ffi_type
foreign import ccall "&ffi_type_sint8" ffi_type_sint8 :: Ptr C_ffi_type
foreign import ccall "&ffi_type_uint16" ffi_type_uint16 :: Ptr C_ffi_type
foreign import ccall "&ffi_type_sint16" ffi_type_sint16 :: Ptr C_ffi_type
foreign import ccall "&ffi_type_uint32" ffi_type_uint32 :: Ptr C_ffi_type
foreign import ccall "&ffi_type_sint32" ffi_type_sint32 :: Ptr C_ffi_type
foreign import ccall "&ffi_type_uint64" ffi_type_uint64 :: Ptr C_ffi_type
foreign import ccall "&ffi_type_sint64" ffi_type_sint64 :: Ptr C_ffi_type
foreign import ccall "&ffi_type_float" ffi_type_float :: Ptr C_ffi_type
foreign import ccall "&ffi_type_double" ffi_type_double :: Ptr C_ffi_type
foreign import ccall "&ffi_type_pointer"ffi_type_pointer :: Ptr C_ffi_type
fFI_OK :: C_ffi_status
fFI_OK = (0)
fFI_DEFAULT_ABI :: C_ffi_abi
fFI_DEFAULT_ABI = (2)
foreign import ccall "ffi_prep_cif"
ffi_prep_cif :: Ptr C_ffi_cif
-> C_ffi_abi
-> CUInt
-> Ptr C_ffi_type
-> Ptr (Ptr C_ffi_type)
-> IO C_ffi_status