module LibffiFunctions where
import Foreign
import Foreign.C
import LibffiTypes

foreign import ccall "ffi_closure_alloc" ffi_closure_alloc
    :: CSize -> Ptr (Ptr ()) -> IO (Ptr ())

foreign import ccall "ffi_closure_free" ffi_closure_free
    :: Ptr () -> IO ()

foreign import ccall "ffi_prep_closure_loc" ffi_prep_closure_loc
    :: Ptr Ffi_closure -> Ptr Ffi_cif -> FunPtr (Ptr Ffi_cif ->
       Ptr () -> Ptr (Ptr ()) -> Ptr a -> IO ()) -> Ptr a ->
       Ptr () -> IO Ffi_status

foreign import ccall "ffi_prep_cif" ffi_prep_cif
    :: Ptr Ffi_cif -> Ffi_abi -> CUInt -> Ptr Ffi_type -> 
       Ptr (Ptr Ffi_type) -> IO Ffi_status

foreign import ccall "ffi_call" ffi_call
    :: Ptr Ffi_cif -> FunPtr (IO ()) -> Ptr () -> Ptr (Ptr ()) ->
       IO ()