{-# LINE 1 "libraries/ghci/GHCi/FFI.hsc" #-}
-----------------------------------------------------------------------------
--
-- libffi bindings
--
-- (c) The University of Glasgow 2008
--
-----------------------------------------------------------------------------

{- Note [FFI for the JS-Backend]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

   The JS-backend does not use GHC's native rts, as such you might think that it
   doesn't require ghci. However, that is not true, because we need ghci in
   order to interoperate with iserv even if we do not use any of the FFI stuff
   in this file. So obviously we do not require libffi, but we still need to be
   able to build ghci in order for the JS-Backend to supply its own iserv
   interop solution. Thus we bite the bullet and wrap all the unneeded bits in a
   CPP conditional compilation blocks that detect the JS-backend. A necessary
   evil to be sure; notice that the only symbols remaining the JS_HOST_ARCH case
   are those that are explicitly exported by this module and set to error if
   they are every used.
-}


{-# LINE 25 "libraries/ghci/GHCi/FFI.hsc" #-}


{-# LINE 27 "libraries/ghci/GHCi/FFI.hsc" #-}

{-# LANGUAGE CPP, DeriveGeneric, DeriveAnyClass #-}
module GHCi.FFI
  ( FFIType(..)
  , FFIConv(..)
  , C_ffi_cif
  , prepForeignCall
  , freeForeignCallInfo
  ) where

import Prelude -- See note [Why do we import Prelude here?]

{-# LINE 39 "libraries/ghci/GHCi/FFI.hsc" #-}
import Control.Exception
import Foreign.C

{-# LINE 42 "libraries/ghci/GHCi/FFI.hsc" #-}
import Data.Binary
import GHC.Generics
import Foreign

data FFIType
  = FFIVoid
  | FFIPointer
  | FFIFloat
  | FFIDouble
  | FFISInt8
  | FFISInt16
  | FFISInt32
  | FFISInt64
  | FFIUInt8
  | FFIUInt16
  | FFIUInt32
  | FFIUInt64
  deriving (Int -> FFIType -> ShowS
[FFIType] -> ShowS
FFIType -> String
(Int -> FFIType -> ShowS)
-> (FFIType -> String) -> ([FFIType] -> ShowS) -> Show FFIType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FFIType -> ShowS
showsPrec :: Int -> FFIType -> ShowS
$cshow :: FFIType -> String
show :: FFIType -> String
$cshowList :: [FFIType] -> ShowS
showList :: [FFIType] -> ShowS
Show, (forall x. FFIType -> Rep FFIType x)
-> (forall x. Rep FFIType x -> FFIType) -> Generic FFIType
forall x. Rep FFIType x -> FFIType
forall x. FFIType -> Rep FFIType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FFIType -> Rep FFIType x
from :: forall x. FFIType -> Rep FFIType x
$cto :: forall x. Rep FFIType x -> FFIType
to :: forall x. Rep FFIType x -> FFIType
Generic, Get FFIType
[FFIType] -> Put
FFIType -> Put
(FFIType -> Put)
-> Get FFIType -> ([FFIType] -> Put) -> Binary FFIType
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: FFIType -> Put
put :: FFIType -> Put
$cget :: Get FFIType
get :: Get FFIType
$cputList :: [FFIType] -> Put
putList :: [FFIType] -> Put
Binary)

data FFIConv
  = FFICCall
  | FFIStdCall
  deriving (Int -> FFIConv -> ShowS
[FFIConv] -> ShowS
FFIConv -> String
(Int -> FFIConv -> ShowS)
-> (FFIConv -> String) -> ([FFIConv] -> ShowS) -> Show FFIConv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FFIConv -> ShowS
showsPrec :: Int -> FFIConv -> ShowS
$cshow :: FFIConv -> String
show :: FFIConv -> String
$cshowList :: [FFIConv] -> ShowS
showList :: [FFIConv] -> ShowS
Show, (forall x. FFIConv -> Rep FFIConv x)
-> (forall x. Rep FFIConv x -> FFIConv) -> Generic FFIConv
forall x. Rep FFIConv x -> FFIConv
forall x. FFIConv -> Rep FFIConv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FFIConv -> Rep FFIConv x
from :: forall x. FFIConv -> Rep FFIConv x
$cto :: forall x. Rep FFIConv x -> FFIConv
to :: forall x. Rep FFIConv x -> FFIConv
Generic, Get FFIConv
[FFIConv] -> Put
FFIConv -> Put
(FFIConv -> Put)
-> Get FFIConv -> ([FFIConv] -> Put) -> Binary FFIConv
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: FFIConv -> Put
put :: FFIConv -> Put
$cget :: Get FFIConv
get :: Get FFIConv
$cputList :: [FFIConv] -> Put
putList :: [FFIConv] -> Put
Binary)


prepForeignCall
    :: FFIConv
    -> [FFIType]          -- arg types
    -> FFIType            -- result type
    -> IO (Ptr C_ffi_cif) -- token for making calls (must be freed by caller)


{-# LINE 74 "libraries/ghci/GHCi/FFI.hsc" #-}
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)
{-# LINE 79 "libraries/ghci/GHCi/FFI.hsc" #-}
  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 $ concat
      [ "prepForeignCallFailed: ", strError r,
        "(cconv: ", show cconv,
        " arg tys: ", show arg_types,
        " res ty: ", show result_type, ")" ]
  else
    return (castPtr cif)

{-# LINE 93 "libraries/ghci/GHCi/FFI.hsc" #-}


freeForeignCallInfo :: Ptr C_ffi_cif -> IO ()

{-# LINE 97 "libraries/ghci/GHCi/FFI.hsc" #-}
freeForeignCallInfo p = do
  free (((\hsc_ptr -> hsc_ptr `plusPtr` 8)) p)
{-# LINE 99 "libraries/ghci/GHCi/FFI.hsc" #-}
  free p

{-# LINE 104 "libraries/ghci/GHCi/FFI.hsc" #-}

data C_ffi_cif


{-# LINE 108 "libraries/ghci/GHCi/FFI.hsc" #-}
data C_ffi_type

strError :: C_ffi_status -> String
strError :: C_ffi_abi -> String
strError C_ffi_abi
r
  | C_ffi_abi
r C_ffi_abi -> C_ffi_abi -> Bool
forall a. Eq a => a -> a -> Bool
== C_ffi_abi
fFI_BAD_ABI
  = String
"invalid ABI (FFI_BAD_ABI)"
  | C_ffi_abi
r C_ffi_abi -> C_ffi_abi -> Bool
forall a. Eq a => a -> a -> Bool
== C_ffi_abi
fFI_BAD_TYPEDEF
  = String
"invalid type description (FFI_BAD_TYPEDEF)"
  | Bool
otherwise
  = String
"unknown error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ C_ffi_abi -> String
forall a. Show a => a -> String
show C_ffi_abi
r

convToABI :: FFIConv -> C_ffi_abi
convToABI :: FFIConv -> C_ffi_abi
convToABI FFIConv
FFICCall  = C_ffi_abi
fFI_DEFAULT_ABI

{-# LINE 124 "libraries/ghci/GHCi/FFI.hsc" #-}
-- unknown conventions are mapped to the default, (#3336)
convToABI FFIConv
_           = C_ffi_abi
fFI_DEFAULT_ABI

ffiType :: FFIType -> Ptr C_ffi_type
ffiType :: FFIType -> Ptr C_ffi_type
ffiType FFIType
FFIVoid     = Ptr C_ffi_type
ffi_type_void
ffiType FFIType
FFIPointer  = Ptr C_ffi_type
ffi_type_pointer
ffiType FFIType
FFIFloat    = Ptr C_ffi_type
ffi_type_float
ffiType FFIType
FFIDouble   = Ptr C_ffi_type
ffi_type_double
ffiType FFIType
FFISInt8    = Ptr C_ffi_type
ffi_type_sint8
ffiType FFIType
FFISInt16   = Ptr C_ffi_type
ffi_type_sint16
ffiType FFIType
FFISInt32   = Ptr C_ffi_type
ffi_type_sint32
ffiType FFIType
FFISInt64   = Ptr C_ffi_type
ffi_type_sint64
ffiType FFIType
FFIUInt8    = Ptr C_ffi_type
ffi_type_uint8
ffiType FFIType
FFIUInt16   = Ptr C_ffi_type
ffi_type_uint16
ffiType FFIType
FFIUInt32   = Ptr C_ffi_type
ffi_type_uint32
ffiType FFIType
FFIUInt64   = Ptr C_ffi_type
ffi_type_uint64

type C_ffi_status = (Word32)
{-# LINE 142 "libraries/ghci/GHCi/FFI.hsc" #-}
type C_ffi_abi    = (Word32)
{-# LINE 143 "libraries/ghci/GHCi/FFI.hsc" #-}

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, fFI_BAD_ABI, fFI_BAD_TYPEDEF :: C_ffi_status
fFI_OK :: C_ffi_abi
fFI_OK = (C_ffi_abi
0)
{-# LINE 159 "libraries/ghci/GHCi/FFI.hsc" #-}
fFI_BAD_ABI = (2)
{-# LINE 160 "libraries/ghci/GHCi/FFI.hsc" #-}
fFI_BAD_TYPEDEF = (1)
{-# LINE 161 "libraries/ghci/GHCi/FFI.hsc" #-}

fFI_DEFAULT_ABI :: C_ffi_abi
fFI_DEFAULT_ABI :: C_ffi_abi
fFI_DEFAULT_ABI = (C_ffi_abi
2)
{-# LINE 164 "libraries/ghci/GHCi/FFI.hsc" #-}

{-# LINE 168 "libraries/ghci/GHCi/FFI.hsc" #-}

-- ffi_status ffi_prep_cif(ffi_cif *cif,
--                         ffi_abi abi,
--                         unsigned int nargs,
--                         ffi_type *rtype,
--                         ffi_type **atypes);

foreign import ccall "ffi_prep_cif"
  ffi_prep_cif :: Ptr C_ffi_cif         -- cif
               -> C_ffi_abi             -- abi
               -> CUInt                 -- nargs
               -> Ptr C_ffi_type        -- result type
               -> Ptr (Ptr C_ffi_type)  -- arg types
               -> IO C_ffi_status

-- Currently unused:

-- void ffi_call(ffi_cif *cif,
--               void (*fn)(),
--               void *rvalue,
--               void **avalue);

-- foreign import ccall "ffi_call"
--   ffi_call :: Ptr C_ffi_cif             -- cif
--            -> FunPtr (IO ())            -- function to call
--            -> Ptr ()                    -- put result here
--            -> Ptr (Ptr ())              -- arg values
--            -> IO ()

{-# LINE 197 "libraries/ghci/GHCi/FFI.hsc" #-}