diff options
Diffstat (limited to 'libraries/ghci/GHCi/FFI.hsc')
| -rw-r--r-- | libraries/ghci/GHCi/FFI.hsc | 30 |
1 files changed, 21 insertions, 9 deletions
diff --git a/libraries/ghci/GHCi/FFI.hsc b/libraries/ghci/GHCi/FFI.hsc index f88e9e8bd8..74c9e175b1 100644 --- a/libraries/ghci/GHCi/FFI.hsc +++ b/libraries/ghci/GHCi/FFI.hsc @@ -58,15 +58,29 @@ prepForeignCall cconv arg_types result_type = do cif <- mallocBytes (#const sizeof(ffi_cif)) 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) + 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) freeForeignCallInfo :: Ptr C_ffi_cif -> IO () freeForeignCallInfo p = do free ((#ptr ffi_cif, arg_types) p) free p +strError :: C_ffi_status -> String +strError r + | r == fFI_BAD_ABI + = "invalid ABI (FFI_BAD_ABI)" + | r == fFI_BAD_TYPEDEF + = "invalid type description (FFI_BAD_TYPEDEF)" + | otherwise + = "unknown error: " ++ show r + convToABI :: FFIConv -> C_ffi_abi convToABI FFICCall = fFI_DEFAULT_ABI #if defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH) @@ -108,12 +122,10 @@ 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 = (#const FFI_OK) ---fFI_BAD_ABI :: C_ffi_status ---fFI_BAD_ABI = (#const FFI_BAD_ABI) ---fFI_BAD_TYPEDEF :: C_ffi_status ---fFI_BAD_TYPEDEF = (#const FFI_BAD_TYPEDEF) +fFI_OK, fFI_BAD_ABI, fFI_BAD_TYPEDEF :: C_ffi_status +fFI_OK = (#const FFI_OK) +fFI_BAD_ABI = (#const FFI_BAD_ABI) +fFI_BAD_TYPEDEF = (#const FFI_BAD_TYPEDEF) fFI_DEFAULT_ABI :: C_ffi_abi fFI_DEFAULT_ABI = (#const FFI_DEFAULT_ABI) |