ref: 7012562d620c244ce626f2547abf01cdc8afba3d
parent: bdd67c2563c3eeab925592cf368b8c0c9ecc280c
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Sun Dec 17 06:35:42 EST 2023
More storable.
--- a/lib/Foreign/Marshal/Alloc.hs
+++ b/lib/Foreign/Marshal/Alloc.hs
@@ -1,5 +1,5 @@
module Foreign.Marshal.Alloc(
- malloc, calloc,
+ malloc, calloc, alloca,
free,
mallocBytes, callocBytes,
) where
--- /dev/null
+++ b/lib/Foreign/Marshal/Utils.hs
@@ -1,0 +1,57 @@
+module Foreign.Marshal.Utils(module Foreign.Marshal.Utils) where
+import Prelude
+import Foreign.Marshal.Alloc
+import Foreign.Ptr
+import Foreign.Storable
+
+new :: forall a . Storable a => a -> IO (Ptr a)
+new val = do
+ ptr <- malloc
+ poke ptr val
+ return ptr
+
+with :: forall a b . Storable a => a -> (Ptr a -> IO b) -> IO b
+with val f =
+ alloca $ \ ptr -> do
+ poke ptr val
+ f ptr
+
+fromBool :: forall a . Num a => Bool -> a
+fromBool False = 0
+fromBool True = 1
+
+toBool :: forall a . (Eq a, Num a) => a -> Bool
+toBool = (/= 0)
+
+maybeNew :: forall a b .
+ ( a -> IO (Ptr b))
+ -> (Maybe a -> IO (Ptr b))
+maybeNew = maybe (return nullPtr)
+
+maybeWith :: forall a b c .
+ ( a -> (Ptr b -> IO c) -> IO c)
+ -> (Maybe a -> (Ptr b -> IO c) -> IO c)
+maybeWith = maybe ($ nullPtr)
+
+maybePeek :: forall a b . (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
+maybePeek peek ptr | ptr == nullPtr = return Nothing
+ | otherwise = do { a <- peek ptr; return (Just a) }+
+withMany :: forall a b res .
+ (a -> (b -> res) -> res)
+ -> [a]
+ -> ([b] -> res)
+ -> res
+withMany _ [] f = f []
+withMany wth (x : xs) f =
+ wth x $ \ x' ->
+ withMany wth xs (\ xs' -> f (x' : xs'))
+
+foreign import ccall "memcpy" c_memcpy :: forall a b . Ptr a -> Ptr a -> Int -> IO ()
+foreign import ccall "memmove" c_memmove :: forall a b . Ptr a -> Ptr a -> Int -> IO ()
+
+copyBytes :: forall a b . Ptr a -> Ptr a -> Int -> IO ()
+copyBytes = c_memcpy
+
+moveBytes :: forall a b . Ptr a -> Ptr a -> Int -> IO ()
+moveBytes = c_memmove
--- a/src/runtime/eval.c
+++ b/src/runtime/eval.c
@@ -982,7 +982,7 @@
const funptr_t ffi_fun;
enum { FFI_V, FFI_I, FFI_IV, FFI_II, FFI_IIV, FFI_III, FFI_DD, FFI_DDD, FFI_PI,FFI_i, FFI_Pi, FFI_iPi, FFI_PIIPI, FFI_PIV, FFI_IIP,
- FFI_PPI, FFI_PP, FFI_PPP, FFI_IPI, FFI_PV, FFI_IP, FFI_PPV,
+ FFI_PPI, FFI_PP, FFI_PPP, FFI_IPI, FFI_PV, FFI_IP, FFI_PPV, FFI_PPzV,
} ffi_how;
} ffi_table[] = {#if WORD_SIZE == 64
@@ -1049,6 +1049,8 @@
{ "pokeWord", (funptr_t)pokeWord,FFI_PIV }, { "peekByte", (funptr_t)peekByte,FFI_PI }, { "pokeByte", (funptr_t)pokeByte,FFI_PIV },+ { "memcpy", (funptr_t)memcpy, FFI_PPzV },+ { "memmove", (funptr_t)memmove, FFI_PPzV },};
/* Look up an FFI function by name */
@@ -2357,6 +2359,7 @@
case FFI_PPP: FFI (2); xp = PTRARG(1);yp = PTRARG(2); rp = (*(void* (*)(void*, void* ))f)(xp,yp); n = mkPtr(rp); RETIO(n);
case FFI_IPI: FFI (2); xi = INTARG(1);yp = PTRARG(2); ri = (*(value_t (*)(value_t, void* ))f)(xi,yp); n = mkInt(ri); RETIO(n);
case FFI_iPi: FFI (2); xi = INTARG(1);yp = PTRARG(2); ri = (*(int (*)(int, void* ))f)(xi,yp); n = mkInt(ri); RETIO(n);
+ case FFI_PPzV:FFI (3); xp = PTRARG(1);yp = PTRARG(2); zi = INTARG(2); (*(void (*)(void*, void*, size_t))f)(xp,yp,zi); RETIO(combUnit);
case FFI_PIIPI:FFI (4);xp = PTRARG(1);yi = INTARG(2); zi = INTARG(3); wp = PTRARG(4);
ri = (*(int (*)(void*, int, int, void* ))f)(xp,yi,zi,wp); n = mkInt(ri); RETIO(n);
default: ERR("T_IO_CCALL");--
⑨