Skip to content
Snippets Groups Projects
Commit ff1ff0a5 authored by Jens Nolte's avatar Jens Nolte
Browse files

Add util to allocate shared memory

parent 527a51dd
No related merge requests found
......@@ -84,12 +84,16 @@ library
Quasar.Wayland.Protocol.TH
other-modules:
Quasar.Wayland.Protocol.Core
Quasar.Wayland.Utils.InlineC
Quasar.Wayland.Utils.SharedMemory
build-depends:
base >=4.7 && <5,
binary,
bytestring,
containers,
exceptions,
filepath,
inline-c,
mtl,
network,
quasar,
......
module Quasar.Wayland.Utils.InlineC (
ctx
) where
import Data.Map.Strict as Map
import Language.C.Inline.Context
import Language.C.Types
import Language.Haskell.TH
import Quasar.Prelude
import System.Posix.Types (COff(..))
ctx :: Context
ctx = baseCtx <> extraTypesCtx
emptyCtx :: Context
emptyCtx = Context {
ctxTypesTable = mempty,
ctxAntiQuoters = mempty,
ctxOutput = mempty,
ctxForeignSrcLang = Nothing,
ctxEnableCpp = False
}
extraTypesCtx :: Context
extraTypesCtx =
emptyCtx {
ctxTypesTable = Map.fromList types
}
types :: [(TypeSpecifier, TypeQ)]
types = [
(TypeName "off_t", [t|COff|])
]
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Quasar.Wayland.Utils.SharedMemory (
allocateShmFd,
) where
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))
C.context ctx
C.verbatim "#define _GNU_SOURCE"
C.include "<unistd.h>"
C.include "<sys/mman.h>"
allocateShmFd :: COff -> IO Fd
allocateShmFd size = Fd <$> throwErrnoIfMinus1 "allocateShmFd"
[CU.block|
int {
int fd = memfd_create("shm", MFD_CLOEXEC | MFD_ALLOW_SEALING);
if (fd < 0) {
return fd;
}
if (ftruncate(fd, $(off_t size)) < 0) {
close(fd);
return -1;
}
return fd;
}
|]
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment