diff --git a/Changelog b/Changelog new file mode 100644 --- /dev/null +++ b/Changelog @@ -0,0 +1,9 @@ +1.8.10 [2022-09-27] +------ + +* Removed the embeded libffi code. + +1.8.9 [2022-09-26] +----- + +* Initial hackage release diff --git a/hdf5.cabal b/hdf5.cabal --- a/hdf5.cabal +++ b/hdf5.cabal @@ -1,14 +1,10 @@ name: hdf5 -version: 1.8.9 +version: 1.8.10 stability: provisional cabal-version: >= 1.10 build-type: Simple -extra-source-files: include/bindings.h - include/mangle.h - include/util.h - author: James Cook maintainer: Picca Frédéric-Emmanuel license: PublicDomain @@ -18,14 +14,15 @@ synopsis: Haskell interface to the HDF5 scientific data storage library. description: This is a low-level but typesafe Haskell interface to the HDF5 library. No pointers necessary. +extra-source-files: Changelog + include/bindings.h + include/mangle.h + include/util.h + source-repository head type: git location: git://github.com/picca/hs-hdf5.git -Flag useEmbededLibFFI - Description: Enable the embeded libffi - Default: False - Library hs-source-dirs: src default-language: Haskell2010 @@ -96,16 +93,6 @@ , Bindings.HDF5.Raw.Util , Foreign.Ptr.Conventions - if flag(useEmbededLibFFI) - other-modules: Foreign.LibFFI - , Foreign.LibFFI.Base - , Foreign.LibFFI.Types - , Foreign.LibFFI.FFITypes - , Foreign.LibFFI.Internal - - else - build-depends: libffi - c-sources: cbits/H5_inline.c , cbits/H5E_inline.c , cbits/H5FD_inline.c @@ -118,13 +105,14 @@ include-dirs: include build-depends: base >= 3 && < 5 - , bytestring - , tagged - , vector , bindings-DSL - , monad-control + , bytestring + , libffi , lifted-base + , monad-control , primitive + , tagged + , vector , transformers pkgconfig-depends: hdf5-serial, libffi diff --git a/src/Foreign/LibFFI.hs b/src/Foreign/LibFFI.hs deleted file mode 100644 --- a/src/Foreign/LibFFI.hs +++ /dev/null @@ -1,28 +0,0 @@ -{- | -This is the only module that normal users should need to import. - -As an example, allocate 1GB of memory, zero it, and crash: - -@ -import System.Posix.DynamicLinker -import Foreign.Ptr -import Foreign.LibFFI - -main = do - malloc <- dlsym Default \"malloc\" - memset <- dlsym Default \"memset\" - p <- callFFI malloc (retPtr retVoid) [argCSize (2^30)] - callFFI memset (retPtr retVoid) [argPtr p, argCInt 0, argCSize (2^30)] - callFFI memset (retPtr retVoid) [argPtr nullPtr, argCInt 0, argCSize 1] -@ --} -module Foreign.LibFFI - (Arg - ,RetType - ,callFFI - ,withRetType - ,module Foreign.LibFFI.Types - ) where - -import Foreign.LibFFI.Base -import Foreign.LibFFI.Types diff --git a/src/Foreign/LibFFI/Base.hs b/src/Foreign/LibFFI/Base.hs deleted file mode 100644 --- a/src/Foreign/LibFFI/Base.hs +++ /dev/null @@ -1,65 +0,0 @@ -{- | This module defines the basic libffi machinery. You will need this to create support for new ffi types. -} -module Foreign.LibFFI.Base where - -import Control.Monad -import Data.List - -import Foreign.Marshal -import Foreign.Ptr -import Foreign.Storable - -import Foreign.LibFFI.FFITypes -import Foreign.LibFFI.Internal - -newtype Arg = Arg { unArg :: IO (Ptr CType, Ptr CValue, IO ()) } - -customPointerArg :: (a -> IO (Ptr b)) -> (Ptr b -> IO ()) -> a -> Arg -customPointerArg newA freeA a = Arg $ do - p <- newA a - pp <- new p - return (ffi_type_pointer, castPtr pp, free pp >> freeA p) - -mkStorableArg :: Storable a => Ptr CType -> a -> Arg -mkStorableArg cType a = Arg $ do - p <- malloc - poke p a - return (cType, castPtr p, free p) - -data RetType a = RetType (Ptr CType) ((Ptr CValue -> IO ()) -> IO a) - -instance Functor RetType where - fmap f = withRetType (return . f) - -withRetType :: (a -> IO b) -> RetType a -> RetType b -withRetType f (RetType cType withPoke) - = RetType cType (withPoke >=> f) - -mkStorableRetType :: Storable a => Ptr CType -> RetType a -mkStorableRetType cType - = RetType cType - (\write -> alloca $ \ptr -> write (castPtr ptr) >> peek ptr) - -newStorableStructArgRet :: Storable a => [Ptr CType] -> IO (a -> Arg, RetType a, IO ()) -newStorableStructArgRet cTypes = do - (cType, freeit) <- newStructCType cTypes - return (mkStorableArg cType, mkStorableRetType cType, freeit) - -newStructCType :: [Ptr CType] -> IO (Ptr CType, IO ()) -newStructCType cTypes = do - ffi_type <- mallocBytes sizeOf_ffi_type - elements <- newArray0 nullPtr cTypes - init_ffi_type ffi_type elements - return (ffi_type, free ffi_type >> free elements) - -callFFI :: FunPtr a -> RetType b -> [Arg] -> IO b -callFFI funPtr (RetType cRetType withRet) args - = allocaBytes sizeOf_cif $ \cif -> do - (cTypes, cValues, frees) <- unzip3 `liftM` mapM unArg args - withArray cTypes $ \cTypesPtr -> do - status <- ffi_prep_cif cif ffi_default_abi (genericLength args) cRetType cTypesPtr - unless (status == ffi_ok) $ - error "callFFI: ffi_prep_cif failed" - withArray cValues $ \cValuesPtr -> do - ret <- withRet (\cRet -> ffi_call cif funPtr cRet cValuesPtr) - sequence_ frees - return ret diff --git a/src/Foreign/LibFFI/FFITypes.hs b/src/Foreign/LibFFI/FFITypes.hs deleted file mode 100644 --- a/src/Foreign/LibFFI/FFITypes.hs +++ /dev/null @@ -1,83 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} -{- | The pointers exported and used by the C libffi describing basic ffi types. -} -module Foreign.LibFFI.FFITypes where - -import Foreign.C.Types -import Foreign.Ptr -import Foreign.Storable - -import Foreign.LibFFI.Internal - -foreign import ccall unsafe "&" ffi_type_void :: Ptr CType -foreign import ccall unsafe "&" ffi_type_sint8 :: Ptr CType -foreign import ccall unsafe "&" ffi_type_uint8 :: Ptr CType -foreign import ccall unsafe "&" ffi_type_uint16 :: Ptr CType -foreign import ccall unsafe "&" ffi_type_sint16 :: Ptr CType -foreign import ccall unsafe "&" ffi_type_uint32 :: Ptr CType -foreign import ccall unsafe "&" ffi_type_sint32 :: Ptr CType -foreign import ccall unsafe "&" ffi_type_uint64 :: Ptr CType -foreign import ccall unsafe "&" ffi_type_sint64 :: Ptr CType -foreign import ccall unsafe "&" ffi_type_float :: Ptr CType -foreign import ccall unsafe "&" ffi_type_double :: Ptr CType -foreign import ccall unsafe "&" ffi_type_pointer :: Ptr CType - -ffi_type_uchar :: Ptr CType -ffi_type_uchar = ffi_type_uint8 - -ffi_type_schar :: Ptr CType -ffi_type_schar = ffi_type_sint8 - -ffi_type_wchar :: Ptr CType -ffi_type_wchar = case sizeOf (undefined :: CWchar) of - 2 -> ffi_type_sint16 - 4 -> ffi_type_sint32 - 8 -> ffi_type_sint64 - _ -> error "ffi_type_wchar of unsupported size" - -ffi_type_size :: Ptr CType -ffi_type_size = case sizeOf (undefined :: CSize) of - 4 -> ffi_type_uint32 - 8 -> ffi_type_uint64 - _ -> error "ffi_type_size of unsupported size" - -ffi_type_time :: Ptr CType -ffi_type_time = case sizeOf (undefined :: CTime) of - 4 -> ffi_type_sint32 - 8 -> ffi_type_sint64 - _ -> error "ffi_type_time of unsupported size" - -ffi_type_uint :: Ptr CType -ffi_type_uint = case sizeOf (undefined :: CUInt) of - 4 -> ffi_type_uint32 - 8 -> ffi_type_uint64 - _ -> error "ffi_type_uint of unsupported size" - -ffi_type_sint :: Ptr CType -ffi_type_sint = case sizeOf (undefined :: CInt) of - 4 -> ffi_type_sint32 - 8 -> ffi_type_sint64 - _ -> error "ffi_type_sint of unsupported size" - -ffi_type_ulong :: Ptr CType -ffi_type_ulong = case sizeOf (undefined :: CULong) of - 4 -> ffi_type_uint32 - 8 -> ffi_type_uint64 - _ -> error "ffi_type_ulong of unsupported size" - -ffi_type_slong :: Ptr CType -ffi_type_slong = case sizeOf (undefined :: CLong) of - 4 -> ffi_type_sint32 - 8 -> ffi_type_sint64 - _ -> error "ffi_type_slong of unsupported size" - -ffi_type_hs_int :: Ptr CType -ffi_type_hs_int = case sizeOf (undefined :: Int) of - 4 -> ffi_type_sint32 - 8 -> ffi_type_sint64 - _ -> error "ffi_type_hs_int: unsupported sizeOf (_ :: Int)" - -ffi_type_hs_word :: Ptr CType -ffi_type_hs_word = case sizeOf (undefined :: Word) of - 4 -> ffi_type_uint32 - 8 -> ffi_type_uint64 - _ -> error "ffi_type_hs_word: unsupported sizeOf (_ :: Word)" diff --git a/src/Foreign/LibFFI/Internal.hsc b/src/Foreign/LibFFI/Internal.hsc deleted file mode 100644 --- a/src/Foreign/LibFFI/Internal.hsc +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} -{- | The internals of the C library libffi -} -module Foreign.LibFFI.Internal where - -#include - -import Data.Word -import Foreign.C.Types -import Foreign.Ptr -import Foreign.Storable - -data CValue -data CType -data CIF - -type C_ffi_status = (#type ffi_status) -type C_ffi_abi = (#type ffi_abi) - -ffi_default_abi :: C_ffi_abi -ffi_default_abi = #const FFI_DEFAULT_ABI - -ffi_ok :: C_ffi_status -ffi_ok = #const FFI_OK - -sizeOf_cif :: Int -sizeOf_cif = #size ffi_cif - -sizeOf_ffi_type :: Int -sizeOf_ffi_type = #size ffi_type - -init_ffi_type :: Ptr CType -> Ptr (Ptr CType) -> IO () -init_ffi_type cType cTypes = do - (#poke ffi_type, size) cType (0 :: CSize) - (#poke ffi_type, alignment) cType (0 :: CUShort) - (#poke ffi_type, type) cType ((#const FFI_TYPE_STRUCT) :: CUShort) - (#poke ffi_type, elements) cType cTypes - -foreign import ccall safe ffi_prep_cif - :: Ptr CIF -> C_ffi_abi -> CUInt -> Ptr CType -> Ptr (Ptr CType) -> IO C_ffi_status - -foreign import ccall safe ffi_call - :: Ptr CIF -> FunPtr a -> Ptr CValue -> Ptr (Ptr CValue) -> IO () diff --git a/src/Foreign/LibFFI/Types.hs b/src/Foreign/LibFFI/Types.hs deleted file mode 100644 --- a/src/Foreign/LibFFI/Types.hs +++ /dev/null @@ -1,223 +0,0 @@ --- | Arguments and return types -module Foreign.LibFFI.Types ( - -- * Arguments - -- ** Integral types - argCInt, - argCUInt, - argCLong, - argCULong, - argInt, - argInt8, - argInt16, - argInt32, - argInt64, - argWord, - argWord8, - argWord16, - argWord32, - argWord64, - -- ** Floating point types - argCFloat, - argCDouble, - -- ** Various other C types - argCSize, - argCTime, - argCChar, - argCUChar, - argCWchar, - argPtr, - argFunPtr, - -- ** Strings - argString, - argByteString, - argConstByteString, - -- * Return types - -- ** Integral types - retVoid, - retCInt, - retCUInt, - retCLong, - retCULong, - retInt, - retInt8, - retInt16, - retInt32, - retInt64, - retWord, - retWord8, - retWord16, - retWord32, - retWord64, - -- ** Floating point types - retCFloat, - retCDouble, - -- ** Various other C types - retCSize, - retCTime, - retCChar, - retCUChar, - retCWchar, - retPtr, - retFunPtr, - -- ** Strings - retCString, - retString, - retByteString, - retMallocByteString - ) where - -import Data.Int -import Data.Word - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Unsafe as BSU -import Foreign.C.String -import Foreign.C.Types -import Foreign.Marshal -import Foreign.Ptr - -import Foreign.LibFFI.Base -import Foreign.LibFFI.FFITypes - -argCInt :: CInt -> Arg -argCInt = mkStorableArg ffi_type_sint -argCUInt :: CUInt -> Arg -argCUInt = mkStorableArg ffi_type_uint -argCLong :: CLong -> Arg -argCLong = mkStorableArg ffi_type_slong -argCULong :: CULong -> Arg -argCULong = mkStorableArg ffi_type_ulong - --- | Note that on e.g. x86_64, Int \/= CInt -argInt :: Int -> Arg -argInt = mkStorableArg ffi_type_hs_int -argInt8 :: Int8 -> Arg -argInt8 = mkStorableArg ffi_type_sint8 -argInt16 :: Int16 -> Arg -argInt16 = mkStorableArg ffi_type_sint16 -argInt32 :: Int32 -> Arg -argInt32 = mkStorableArg ffi_type_sint32 -argInt64 :: Int64 -> Arg -argInt64 = mkStorableArg ffi_type_sint64 - -argWord :: Word -> Arg -argWord = mkStorableArg ffi_type_hs_word -argWord8 :: Word8 -> Arg -argWord8 = mkStorableArg ffi_type_uint8 -argWord16 :: Word16 -> Arg -argWord16 = mkStorableArg ffi_type_uint16 -argWord32 :: Word32 -> Arg -argWord32 = mkStorableArg ffi_type_uint32 -argWord64 :: Word64 -> Arg -argWord64 = mkStorableArg ffi_type_uint64 - -argCFloat :: CFloat -> Arg -argCFloat = mkStorableArg ffi_type_float -argCDouble :: CDouble -> Arg -argCDouble = mkStorableArg ffi_type_double - -argCSize :: CSize -> Arg -argCSize = mkStorableArg ffi_type_size -argCTime :: CTime -> Arg -argCTime = mkStorableArg ffi_type_size - -argCChar :: CChar -> Arg -argCChar = mkStorableArg ffi_type_schar -argCUChar :: CUChar -> Arg -argCUChar = mkStorableArg ffi_type_uchar - -argCWchar :: CWchar -> Arg -argCWchar = mkStorableArg ffi_type_schar - -argPtr :: Ptr a -> Arg -argPtr = mkStorableArg ffi_type_pointer - -argFunPtr :: FunPtr a -> Arg -argFunPtr = mkStorableArg ffi_type_pointer - -{- | The string argument is passed to C as a char * pointer, which is freed afterwards. - The argument should not contain zero-bytes. -} -argString :: String -> Arg -argString = customPointerArg newCString free - --- | Like argString, but for ByteString's. -argByteString :: BS.ByteString -> Arg -argByteString = customPointerArg (flip BS.useAsCString return) (const $ return ()) - --- | Like argByteString, but changing the string from C breaks referential transparency. -argConstByteString :: BS.ByteString -> Arg -argConstByteString = customPointerArg (flip BSU.unsafeUseAsCString return) (const $ return ()) - -retVoid :: RetType () -retVoid = RetType ffi_type_void (\write -> write nullPtr >> return ()) - -retCInt :: RetType CInt -retCInt = mkStorableRetType ffi_type_sint -retCUInt :: RetType CUInt -retCUInt = mkStorableRetType ffi_type_uint -retCLong :: RetType CLong -retCLong = mkStorableRetType ffi_type_slong -retCULong :: RetType CULong -retCULong = mkStorableRetType ffi_type_ulong - -retInt :: RetType Int -retInt = mkStorableRetType ffi_type_hs_int -retInt8 :: RetType Int8 -retInt8 = mkStorableRetType ffi_type_sint8 -retInt16 :: RetType Int16 -retInt16 = mkStorableRetType ffi_type_sint16 -retInt32 :: RetType Int32 -retInt32 = mkStorableRetType ffi_type_sint32 -retInt64 :: RetType Int64 -retInt64 = mkStorableRetType ffi_type_sint64 - -retWord :: RetType Word -retWord = mkStorableRetType ffi_type_hs_word -retWord8 :: RetType Word8 -retWord8 = mkStorableRetType ffi_type_uint8 -retWord16 :: RetType Word16 -retWord16 = mkStorableRetType ffi_type_uint16 -retWord32 :: RetType Word32 -retWord32 = mkStorableRetType ffi_type_uint32 -retWord64 :: RetType Word64 -retWord64 = mkStorableRetType ffi_type_uint64 - -retCFloat :: RetType CFloat -retCFloat = mkStorableRetType ffi_type_float -retCDouble :: RetType CDouble -retCDouble = mkStorableRetType ffi_type_double - -retCSize :: RetType CSize -retCSize = mkStorableRetType ffi_type_size -retCTime :: RetType CTime -retCTime = mkStorableRetType ffi_type_time - -retCChar :: RetType CChar -retCChar = mkStorableRetType ffi_type_schar -retCUChar :: RetType CUChar -retCUChar = mkStorableRetType ffi_type_uchar - -retCWchar :: RetType CWchar -retCWchar = mkStorableRetType ffi_type_schar - -retFunPtr :: RetType a -> RetType (FunPtr a) -retFunPtr _ = mkStorableRetType ffi_type_pointer - -retPtr :: RetType a -> RetType (Ptr a) -retPtr _ = mkStorableRetType ffi_type_pointer - -retCString :: RetType CString -retCString = retPtr retCChar - -{- | Peek a String out of the returned char *. The char * is not freed. -} -retString :: RetType String -retString = withRetType peekCString (retPtr retCChar) - -{- | Like retString, but for ByteString's -} -retByteString :: RetType BS.ByteString -retByteString = withRetType BS.packCString (retPtr retCChar) - -{- | Make a ByteString out of the returned char *. - The char * will be free(3)ed when the ByteString is garbage collected. -} -retMallocByteString :: RetType BS.ByteString -retMallocByteString = withRetType BSU.unsafePackMallocCString (retPtr retCChar)