Copyright | (c) Dong Han 2017-2018 |
---|---|
License | BSD |
Maintainer | winterland1989@gmail.com |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
This module provide functions for using PrimArray
and PrimVector
with GHC FFI(Foreign function interface),
Some functions are designed to be used with UnliftedFFITypes extension.
GHC runtime is garbaged collected, there're two types of primitive array in GHC, with the objective to minimize overall memory management cost:
- Small primitive arrays created with
newPrimArray
are directly allocated on GHC heap, which can be moved by GHC garbage collector, we call these arraysunpinned
. Allocating these array is cheap, we only need to check heap limit and bump heap pointer just like any other haskell heap objects. But we will pay GC cost , which is OK for small arrays. - Large primitive array and those created with
newPinnedPrimArray
are allocated on GHC managed memory blocks, which is also traced by garbage collector, but will never moved before freed, thus are calledpinned
. Allocating these arrays are bit more expensive since it's more like howmalloc
works, but we don't have to pay for GC cost.
Beside the pinned/unpinned
difference, we have two types of FFI calls in GHC:
- Safe FFI call annotated with
safe
keyword. These calls are executed on separated OS thread, which can be running concurrently with GHC garbage collector, thus we want to make sure only pinned arrays are passed. The main use case forsafe
FFIs are long running functions, for example, doing IO polling. Since these calls are running on separated OS thread, haskell thread on original OS thread will not be affected. - Unsafe FFI call annotated with
unsafe
keyword. These calls are executed on the same OS thread which is running the haskell side FFI code, which will in turn stop GHC from doing a garbage collection. We can pass bothpinned
andunpinned
arrays in this case. The use case forunsafe
FFIs are short/small functions, which can be treated like a fat primitive operations, such asmemcpy
,memcmp
. Usingunsafe
FFI with long running functions will effectively block GHC runtime thread from running any other haskell threads, which is dangerous. Even if you use threaded runtime and expect your haskell thread can be stolen by other OS threads, but this will not work since GHC garbage collector will refuse to run if one of the OS thread is blocked by FFI calls.
Base on above analysis, we have following FFI strategy table.
FFI Array | pinned | unpinned |
unsafe | directly pass | directly pass |
safe | directly pass | make a copy |
In this module, we separate safe and unsafe FFI handling due to the strategy difference: if the user can guarantee a FFI call is unsafe, we can save an extra copy and pinned allocation. Mistakenly using unsafe function with safe FFI will result in segfault.
Synopsis
- withPrimArrayUnsafe :: Prim a => PrimArray a -> (BA# a -> Int -> IO b) -> IO b
- allocPrimArrayUnsafe :: forall a b. Prim a => Int -> (MBA# a -> IO b) -> IO (PrimArray a, b)
- withPrimVectorUnsafe :: Prim a => PrimVector a -> (BA# a -> Int -> Int -> IO b) -> IO b
- allocPrimVectorUnsafe :: forall a b. Prim a => Int -> (MBA# a -> IO b) -> IO (PrimVector a, b)
- allocBytesUnsafe :: Int -> (MBA# a -> IO b) -> IO (Bytes, b)
- withPrimUnsafe :: Prim a => a -> (MBA# a -> IO b) -> IO (a, b)
- allocPrimUnsafe :: Prim a => (MBA# a -> IO b) -> IO (a, b)
- withPrimArrayListUnsafe :: [PrimArray a] -> (BAArray# a -> Int -> IO b) -> IO b
- withPrimArraySafe :: Prim a => PrimArray a -> (Ptr a -> Int -> IO b) -> IO b
- allocPrimArraySafe :: forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO (PrimArray a, b)
- withPrimVectorSafe :: forall a b. Prim a => PrimVector a -> (Ptr a -> Int -> IO b) -> IO b
- allocPrimVectorSafe :: forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO (PrimVector a, b)
- allocBytesSafe :: Int -> (Ptr Word8 -> IO b) -> IO (Bytes, b)
- withPrimSafe :: forall a b. Prim a => a -> (Ptr a -> IO b) -> IO (a, b)
- allocPrimSafe :: forall a b. Prim a => (Ptr a -> IO b) -> IO (a, b)
- withPrimArrayListSafe :: Prim a => [PrimArray a] -> (Ptr (Ptr a) -> Int -> IO b) -> IO b
- pinPrimArray :: Prim a => PrimArray a -> IO (PrimArray a)
- pinPrimVector :: Prim a => PrimVector a -> IO (PrimVector a)
- type BA# a = ByteArray#
- type MBA# a = MutableByteArray# RealWorld
- type BAArray# a = ArrayArray#
- clearMBA :: MBA# a -> Int -> IO ()
- clearPtr :: Ptr a -> Int -> IO ()
- castPtr :: Ptr a -> Ptr b
- fromNullTerminated :: Ptr a -> IO Bytes
- fromPtr :: Ptr a -> Int -> IO Bytes
- fromPrimPtr :: forall a. Prim a => Ptr a -> Int -> IO (PrimVector a)
- data StdString
- fromStdString :: IO (Ptr StdString) -> IO Bytes
- data RealWorld
- touch :: PrimMonad m => a -> m ()
- module Data.Primitive.ByteArray
- module Data.Primitive.PrimArray
- module Foreign.C.Types
- module Data.Primitive.Ptr
- module Z.Data.Array.Unaligned
- hs_std_string_size :: Ptr StdString -> IO Int
- hs_copy_std_string :: Ptr StdString -> Int -> MBA# Word8 -> IO ()
- hs_delete_std_string :: Ptr StdString -> IO ()
Unsafe FFI
withPrimArrayUnsafe :: Prim a => PrimArray a -> (BA# a -> Int -> IO b) -> IO b Source #
Pass primitive array to unsafe FFI as pointer.
Enable UnliftedFFITypes
extension in your haskell code, use proper pointer type and HsInt
to marshall ByteArray#
and Int
arguments on C side.
The second Int
arguement is the element size not the bytes size.
USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
allocPrimArrayUnsafe :: forall a b. Prim a => Int -> (MBA# a -> IO b) -> IO (PrimArray a, b) Source #
Allocate some bytes and pass to FFI as pointer, freeze result into a PrimArray
.
USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
withPrimVectorUnsafe :: Prim a => PrimVector a -> (BA# a -> Int -> Int -> IO b) -> IO b Source #
Pass PrimVector
to unsafe FFI as pointer
The PrimVector
version of withPrimArrayUnsafe
.
The second Int
arguement is the first element offset, the third Int
argument is the
element length.
USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
allocPrimVectorUnsafe Source #
Allocate a prim array and pass to FFI as pointer, freeze result into a PrimVector
.
USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
Allocate some bytes and pass to FFI as pointer, freeze result into a Bytes
.
USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
withPrimUnsafe :: Prim a => a -> (MBA# a -> IO b) -> IO (a, b) Source #
Create an one element primitive array and use it as a pointer to the primitive element.
Return the element and the computation result.
USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
allocPrimUnsafe :: Prim a => (MBA# a -> IO b) -> IO (a, b) Source #
like withPrimUnsafe
, but don't write initial value.
USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
withPrimArrayListUnsafe :: [PrimArray a] -> (BAArray# a -> Int -> IO b) -> IO b Source #
Pass primitive array list to unsafe FFI as StgArrBytes**
.
Enable UnliftedFFITypes
extension in your haskell code, use StgArrBytes**
(>=8.10)
or StgMutArrPtrs*
(<8.10) pointer type and HsInt
to marshall BAArray#
and Int
arguments on C side, check the example with BAArray#
.
The second Int
arguement is the list size.
USE THIS FUNCTION WITH UNSAFE FFI CALL ONLY.
Safe FFI
withPrimArraySafe :: Prim a => PrimArray a -> (Ptr a -> Int -> IO b) -> IO b Source #
Pass primitive array to safe FFI as pointer.
Use proper pointer type and HsInt
to marshall Ptr a
and Int
arguments on C side.
The memory pointed by 'Ptr a' will not moved during call. After call returned, pointer is no longer valid.
The second Int
arguement is the element size not the bytes size.
Don't pass a forever loop to this function, see #14346.
Allocate a prim array and pass to FFI as pointer, freeze result into a PrimVector
.
withPrimVectorSafe :: forall a b. Prim a => PrimVector a -> (Ptr a -> Int -> IO b) -> IO b Source #
Pass PrimVector
to safe FFI as pointer
The PrimVector
version of withPrimArraySafe
. The Ptr
is already pointed
to the first element, thus no offset is provided. After call returned, pointer is no longer valid.
Don't pass a forever loop to this function, see #14346.
Allocate a prim array and pass to FFI as pointer, freeze result into a PrimVector
.
Allocate some bytes and pass to FFI as pointer, freeze result into a PrimVector
.
withPrimSafe :: forall a b. Prim a => a -> (Ptr a -> IO b) -> IO (a, b) Source #
Create an one element primitive array and use it as a pointer to the primitive element.
Don't pass a forever loop to this function, see #14346.
allocPrimSafe :: forall a b. Prim a => (Ptr a -> IO b) -> IO (a, b) Source #
like withPrimSafe
, but don't write initial value.
withPrimArrayListSafe :: Prim a => [PrimArray a] -> (Ptr (Ptr a) -> Int -> IO b) -> IO b Source #
Pass primitive array list to safe FFI as pointer.
Use proper pointer type and HsInt
to marshall Ptr (Ptr a)
and Int
arguments on C side.
The memory pointed by 'Ptr a' will not moved during call. After call returned, pointer is no longer valid.
The second Int
arguement is the list size.
Don't pass a forever loop to this function, see #14346.
pinPrimArray :: Prim a => PrimArray a -> IO (PrimArray a) Source #
Convert a PrimArray
to a pinned one(memory won't moved by GC) if necessary.
pinPrimVector :: Prim a => PrimVector a -> IO (PrimVector a) Source #
Convert a PrimVector
to a pinned one(memory won't moved by GC) if necessary.
Pointer helpers
type BA# a = ByteArray# Source #
Type alias for ByteArray#
.
Describe a ByteArray#
which we are going to pass across FFI. Use this type with UnliftedFFITypes
extension, At C side you should use a proper const pointer type.
Don't cast BA#
to Addr#
since the heap object offset is hard-coded in code generator:
Note [Unlifted boxed arguments to foreign calls]
In haskell side we use type system to distinguish immutable / mutable arrays, but in C side we can't. So it's users' responsibility to make sure the array content is not mutated (a const pointer type may help).
USE THIS TYPE WITH UNSAFE FFI CALL ONLY. A ByteArray#
COULD BE MOVED BY GC DURING SAFE FFI CALL.
type MBA# a = MutableByteArray# RealWorld Source #
Type alias for MutableByteArray#
RealWorld
.
Describe a MutableByteArray#
which we are going to pass across FFI. Use this type with UnliftedFFITypes
extension, At C side you should use a proper pointer type.
Don't cast MBA#
to Addr#
since the heap object offset is hard-coded in code generator:
Note [Unlifted boxed arguments to foreign calls]
USE THIS TYPE WITH UNSAFE FFI CALL ONLY. A MutableByteArray#
COULD BE MOVED BY GC DURING SAFE FFI CALL.
type BAArray# a = ArrayArray# Source #
Type alias for ArrayArray#
.
Describe a array of ByteArray#
which we are going to pass across FFI. Use this type with UnliftedFFITypes
extension, At C side you should use StgArrBytes**
(>=8.10) or StgMutArrPtrs*
(<8.10) type from "Rts.h",
example code modified from
GHC manual:
// C source, must include the RTS to make the struct StgArrBytes // available along with its fields: ptrs and payload. #include "Rts.h" // GHC 8.10 changes the way how ArrayArray# is passed to C, so... #if __GLASGOW_HASKELL__ < 810 HsInt sum_first (StgMutArrPtrs *arr, HsInt len) { StgArrBytes **bufs = (StgArrBytes**)arr->payload; #else HsInt sum_first (StgArrBytes **bufs, HsInt len) { #endif int res = 0; for(StgWord ix = 0;ix < len;ix++) { // payload pointer type is StgWord*, cast it before use! res = res + ((HsInt*)(bufs[ix]->payload))[0]; } return res; } -- Haskell source, all elements in the argument array must be -- either ByteArray# or MutableByteArray#. This is not enforced -- by the type system in this example since ArrayArray is untyped. foreign import ccall unsafe "sum_first" sumFirst :: BAArray# Int -> Int -> IO CInt
clearPtr :: Ptr a -> Int -> IO () Source #
Zero a structure.
There's no Storable
or Prim
constraint on a
type, the length
should be given in bytes.
Copy some bytes from a pointer.
There's no encoding guarantee, result could be any bytes sequence.
:: forall a. Prim a | |
=> Ptr a | |
-> Int | in elements |
-> IO (PrimVector a) |
Copy some bytes from a pointer.
There's no encoding guarantee, result could be any bytes sequence.
fromStdString :: IO (Ptr StdString) -> IO Bytes Source #
Run FFI in bracket and marshall std::string*
result into Haskell heap bytes,
memory pointed by std::string*
will be delete
ed.
re-export
RealWorld
is deeply magical. It is primitive, but it is not
unlifted (hence ptrArg
). We never manipulate values of type
RealWorld
; it's only used in the type system, to parameterise State#
.
module Data.Primitive.ByteArray
module Data.Primitive.PrimArray
module Foreign.C.Types
module Data.Primitive.Ptr
module Z.Data.Array.Unaligned