|
|
# Block Objects: Marshalling Them Explicitly
|
|
|
|
|
|
|
|
|
In the following, we use the standard Haskell 2010 FFI to explicitly marshal Haskell functions to C blocks and vice versa.
|
|
|
|
|
|
## The qsort_b example using a foreign wrapper
|
|
|
|
|
|
|
|
|
The most straight-forward approach is to use the existing FFI support for turning Haskell functions into C function pointers by way of a foreign import wrapper declaration. We can then embed these C function pointers in block literals without the need for a explicit environment on the C side.
|
|
|
|
|
|
### Block literals
|
|
|
|
|
|
|
|
|
Blocks are by default allocated on the stack in C and only promoted to the heap using an explicity `Block_copy()` function. In Haskell, we always allocate them on the heap, which is indicated by the pointer constant that we place in every block literal's `isa` field:
|
|
|
|
|
|
```wiki
|
|
|
foreign import ccall "& _NSConcreteGlobalBlock" nsConcreteGlobalBlock :: Ptr ()
|
|
|
```
|
|
|
|
|
|
|
|
|
A block literal with an empty environment has the following layout:
|
|
|
|
|
|
```wiki
|
|
|
-- Layout of the block literal (64-bit runtime)
|
|
|
--
|
|
|
-- .quad __NSConcreteGlobalBlock # void *isa;
|
|
|
-- .long 1342177280 # int flags = 0x50000000;
|
|
|
-- .long 0 # int reserved;
|
|
|
-- .quad ___block_invoke # void (*invoke)(void *, ...);
|
|
|
-- .quad ___block_descriptor # struct Block_descriptor *descriptor;
|
|
|
|
|
|
long, quad :: Int
|
|
|
long = 4 -- long word = 32 bit
|
|
|
quad = 8 -- quad word = 64 bit
|
|
|
|
|
|
isaOffset, flagsOffset, invokeOffset, descriptorOffset, blockLiteralSize :: Int
|
|
|
isaOffset = 0
|
|
|
flagsOffset = isaOffset + quad
|
|
|
invokeOffset = flagsOffset + long + long
|
|
|
descriptorOffset = invokeOffset + quad
|
|
|
blockLiteralSize = descriptorOffset + quad
|
|
|
```
|
|
|
|
|
|
|
|
|
In Haskell, we represent block literals as opaque pointers:
|
|
|
|
|
|
```wiki
|
|
|
newtype Block a = Block (Ptr (Block a))
|
|
|
```
|
|
|
|
|
|
|
|
|
When turning a Haskell function into a C function pointer to be included in a block literal as the `invoke` function, we need to take care to add a pointer to the block literal itself as a new first argument:
|
|
|
|
|
|
```wiki
|
|
|
mkBlock :: ((Block f -> f) -> IO (FunPtr (Block f -> f))) -> f -> IO (Block f)
|
|
|
mkBlock mkWrapper f
|
|
|
= do { fPtr <- mkWrapper (const f)
|
|
|
; blockPtr <- mallocBytes blockLiteralSize
|
|
|
; poke (blockPtr `plusPtr` isaOffset) nsConcreteGlobalBlock
|
|
|
; poke (blockPtr `plusPtr` flagsOffset) (0x50000000 :: Word32)
|
|
|
; poke (blockPtr `plusPtr` invokeOffset) fPtr
|
|
|
; poke (blockPtr `plusPtr` descriptorOffset) descriptorPtr
|
|
|
; return $ Block blockPtr
|
|
|
}
|
|
|
```
|
|
|
|
|
|
|
|
|
The block descriptor is static, except for the signature that we omit for the moment.
|
|
|
|
|
|
```wiki
|
|
|
-- Block descriptor structure shared between all blocks.
|
|
|
--
|
|
|
-- .quad 0 # unsigned long int reserved;
|
|
|
-- .quad 32 # unsigned long int size = blockLiteralSize;
|
|
|
-- .quad signature_str # const char *signature;
|
|
|
-- .quad 0 # <undocumented>
|
|
|
|
|
|
descriptorPtr :: Ptr ()
|
|
|
descriptorPtr
|
|
|
= unsafePerformIO $
|
|
|
do { descPtr <- mallocBytes (4 * quad)
|
|
|
; poke (descPtr `plusPtr` (0 * quad)) (0 :: Word64)
|
|
|
; poke (descPtr `plusPtr` (1 * quad)) blockLiteralSizeWord64
|
|
|
; poke (descPtr `plusPtr` (2 * quad)) nullPtr -- gcc puts a NULL in; should be ok for now
|
|
|
; poke (descPtr `plusPtr` (3 * quad)) (0 :: Word64)
|
|
|
; return descPtr
|
|
|
}
|
|
|
where
|
|
|
blockLiteralSizeWord64 :: Word64
|
|
|
blockLiteralSizeWord64 = fromIntegral blockLiteralSize
|
|
|
```
|
|
|
|
|
|
### Turning a comparison function into a block literal
|
|
|
|
|
|
|
|
|
The comparison function passed to `qsort_b`, gets pointers to the array elements it is to compare. As these array elements are marshalled Haskell thunks, they are themselves **stable** pointers to the actual values that ought to be compared.
|
|
|
|
|
|
```wiki
|
|
|
type CmpFun a = Ptr (StablePtr a) -> Ptr (StablePtr a) -> IO Int
|
|
|
```
|
|
|
|
|
|
|
|
|
We use a foreign import wrapper to perform the actual marshalling of the Haskell function
|
|
|
|
|
|
```wiki
|
|
|
foreign import ccall "wrapper" mkCmpWrapper
|
|
|
:: (Block (CmpFun a) -> CmpFun a) -> IO (FunPtr (Block (CmpFun a) -> CmpFun a))
|
|
|
```
|
|
|
|
|
|
|
|
|
and pass that wrapper to the `mkBlock` function when creating a block:
|
|
|
|
|
|
```wiki
|
|
|
mkCmpBlock :: CmpFun a -> IO (Block (CmpFun a))
|
|
|
mkCmpBlock = mkBlock mkCmpWrapper
|
|
|
```
|
|
|
|
|
|
### Calling quicksort
|
|
|
|
|
|
|
|
|
With these auxiliary definitions, the actual invocation of `qsort_b` is straight forward. We import `qsort_b` with an explicit block argument for the comparison function:
|
|
|
|
|
|
```wiki
|
|
|
foreign import ccall "stdlib.h" qsort_b
|
|
|
:: Ptr (StablePtr a) -> CSize -> CSize -> Block (CmpFun a) -> IO ()
|
|
|
```
|
|
|
|
|
|
|
|
|
Then, we use `mkCmpBlock` to turn the Haskell comparison into a block literal that we pass as the last argument to `qsort_b`:
|
|
|
|
|
|
```wiki
|
|
|
do { -- convert a list of strings into a C array of stable pointers to those strings in the
|
|
|
-- Haskell heap
|
|
|
; ptrs <- mapM newStablePtr myCharacters
|
|
|
; sortedPtrs <- withArray ptrs $ \myCharactersArray -> do
|
|
|
{
|
|
|
-- get the size in bytes of a stable pointer to a Haskell string
|
|
|
; let elemSize = fromIntegral $ sizeOf (undefined :: StablePtr String)
|
|
|
|
|
|
-- invoke C land 'qsort_b' with a Haskell comparison function passed as a block
|
|
|
-- object; mutates 'myCharactersArray'
|
|
|
; cmpBlock <- mkCmpBlock $ \lPtr rPtr -> do
|
|
|
{ l <- deRefStablePtr =<< peek lPtr
|
|
|
; r <- deRefStablePtr =<< peek rPtr
|
|
|
; return $ fromOrdering (l `compare` r)
|
|
|
}
|
|
|
; qsort_b myCharactersArray (genericLength myCharacters) elemSize cmpBlock
|
|
|
|
|
|
; peekArray (length ptrs) myCharactersArray
|
|
|
}
|
|
|
|
|
|
-- turn the array of Haskell strings back into a list of strings
|
|
|
; mySortedCharacters <- mapM deRefStablePtr sortedPtrs
|
|
|
}
|
|
|
```
|
|
|
|
|
|
|
|
|
The complete code is in the attachment `QSortB_wrapper.hs`.
|
|
|
|
|
|
**TODO**
|
|
|
|
|
|
- Produce an example marshalling a block from C to Haskell
|
... | ... | |