{-# 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" #-}
-- See Note [FFI_GO_CLOSURES workaround] in ghc_ffi.h
-- We can't include ghc_ffi.h here as we must build with stage0

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



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

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

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

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

{-# LINE 49 "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)

prepForeignCall
    :: [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 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" #-}
  r <- ffi_prep_cif cif fFI_DEFAULT_ABI (fromIntegral n_args) (ffiType result_type) arg_arr
  if r /= fFI_OK then
    throwIO $ ErrorCall $ concat
      [ "prepForeignCallFailed: ", strError r,
        "(arg tys: ", show arg_types,
        " res ty: ", show result_type, ")" ]
  else
    return (castPtr cif)

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


freeForeignCallInfo :: Ptr C_ffi_cif -> IO ()

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

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

data C_ffi_cif


{-# LINE 106 "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

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 132 "libraries/ghci/GHCi/FFI.hsc" #-}
type C_ffi_abi    = (Word32)
{-# LINE 133 "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 149 "libraries/ghci/GHCi/FFI.hsc" #-}
fFI_BAD_ABI = (2)
{-# LINE 150 "libraries/ghci/GHCi/FFI.hsc" #-}
fFI_BAD_TYPEDEF = (1)
{-# LINE 151 "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 154 "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 183 "libraries/ghci/GHCi/FFI.hsc" #-}