From dc28bdac392492c9d1680b38360696ac2475c15a Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Thu, 23 Dec 2021 13:52:39 +0100
Subject: [PATCH] Add helper for mmap
---
quasar-wayland.cabal | 1 +
src/Quasar/Wayland/Utils/SharedMemory.hs | 23 +++++++++++++++++++----
2 files changed, 20 insertions(+), 4 deletions(-)
diff --git a/quasar-wayland.cabal b/quasar-wayland.cabal
index b767d0c..3e31b23 100644
--- a/quasar-wayland.cabal
+++ b/quasar-wayland.cabal
@@ -99,6 +99,7 @@ library
network,
quasar,
template-haskell,
+ unix,
unordered-containers,
utf8-string,
stm,
diff --git a/src/Quasar/Wayland/Utils/SharedMemory.hs b/src/Quasar/Wayland/Utils/SharedMemory.hs
index 4de2aab..39767e8 100644
--- a/src/Quasar/Wayland/Utils/SharedMemory.hs
+++ b/src/Quasar/Wayland/Utils/SharedMemory.hs
@@ -2,24 +2,28 @@
{-# LANGUAGE TemplateHaskell #-}
module Quasar.Wayland.Utils.SharedMemory (
- allocateShmFd,
+ memfdCreate,
+ mmap,
) where
+import Foreign
+import Foreign.Concurrent qualified as FC
import Foreign.C.Error
import Language.C.Inline qualified as C
import Language.C.Inline.Unsafe qualified as CU
import Quasar.Prelude
import Quasar.Wayland.Utils.InlineC
-import System.Posix.Types (COff(..), Fd(Fd))
+import System.Posix.Types (Fd(Fd), COff(..))
C.context ctx
C.verbatim "#define _GNU_SOURCE"
C.include "<unistd.h>"
+C.include "<stdint.h>"
C.include "<sys/mman.h>"
-allocateShmFd :: COff -> IO Fd
-allocateShmFd size = Fd <$> throwErrnoIfMinus1 "allocateShmFd"
+memfdCreate :: COff -> IO Fd
+memfdCreate size = Fd <$> throwErrnoIfMinus1 "memfd_create/ftruncate"
[CU.block|
int {
int fd = memfd_create("shm", MFD_CLOEXEC | MFD_ALLOW_SEALING);
@@ -34,3 +38,14 @@ allocateShmFd size = Fd <$> throwErrnoIfMinus1 "allocateShmFd"
return fd;
}
|]
+
+mmap :: Fd -> C.CSize -> IO (ForeignPtr Word8)
+mmap (Fd fd) size = do
+ ptr <- fmap intPtrToPtr . throwErrnoIfMinus1 "mmap" $
+ ptrToIntPtr <$> [CU.exp| void*{ mmap(NULL, $(size_t size), PROT_READ | PROT_WRITE, MAP_SHARED, $(int fd), 0) } |]
+ FC.newForeignPtr ptr (munmap ptr size)
+
+munmap :: Ptr a -> C.CSize -> IO ()
+munmap (castPtr -> ptr) size =
+ throwErrnoIfMinus1_ "munmap" $
+ [CU.exp| int { munmap($(void* ptr), $(size_t size)) } |]
--
GitLab