1#if __GLASGOW_HASKELL__ >= 709 2{-# LANGUAGE Safe #-} 3#else 4{-# LANGUAGE Trustworthy #-} 5#endif 6----------------------------------------------------------------------------- 7-- | 8-- Module : System.Posix.SharedMem 9-- Copyright : (c) Daniel Franke 2007 10-- License : BSD-style (see the file libraries/base/LICENSE) 11-- 12-- Maintainer : libraries@haskell.org 13-- Stability : experimental 14-- Portability : non-portable (requires POSIX) 15-- 16-- POSIX shared memory support. 17-- 18----------------------------------------------------------------------------- 19 20module System.Posix.SharedMem 21 (ShmOpenFlags(..), shmOpen, shmUnlink) 22 where 23 24#include "HsUnix.h" 25 26#include <sys/types.h> 27#include <sys/mman.h> 28#include <fcntl.h> 29 30import System.Posix.Types 31#if defined(HAVE_SHM_OPEN) || defined(HAVE_SHM_UNLINK) 32import Foreign.C 33#endif 34#ifdef HAVE_SHM_OPEN 35import Data.Bits 36#endif 37 38data ShmOpenFlags = ShmOpenFlags 39 { shmReadWrite :: Bool, 40 -- ^ If true, open the shm object read-write rather than read-only. 41 shmCreate :: Bool, 42 -- ^ If true, create the shm object if it does not exist. 43 shmExclusive :: Bool, 44 -- ^ If true, throw an exception if the shm object already exists. 45 shmTrunc :: Bool 46 -- ^ If true, wipe the contents of the shm object after opening it. 47 } 48 49-- | Open a shared memory object with the given name, flags, and mode. 50shmOpen :: String -> ShmOpenFlags -> FileMode -> IO Fd 51#ifdef HAVE_SHM_OPEN 52shmOpen name flags mode = 53 do cflags0 <- return 0 54 cflags1 <- return $ cflags0 .|. (if shmReadWrite flags 55 then #{const O_RDWR} 56 else #{const O_RDONLY}) 57 cflags2 <- return $ cflags1 .|. (if shmCreate flags then #{const O_CREAT} 58 else 0) 59 cflags3 <- return $ cflags2 .|. (if shmExclusive flags 60 then #{const O_EXCL} 61 else 0) 62 cflags4 <- return $ cflags3 .|. (if shmTrunc flags then #{const O_TRUNC} 63 else 0) 64 withCAString name (shmOpen' cflags4) 65 where shmOpen' cflags cname = 66 do fd <- throwErrnoIfMinus1 "shmOpen" $ 67 shm_open cname cflags mode 68 return $ Fd fd 69#else 70shmOpen = error "System.Posix.SharedMem:shm_open: not available" 71#endif 72 73-- | Delete the shared memory object with the given name. 74shmUnlink :: String -> IO () 75#ifdef HAVE_SHM_UNLINK 76shmUnlink name = withCAString name shmUnlink' 77 where shmUnlink' cname = 78 throwErrnoIfMinus1_ "shmUnlink" $ shm_unlink cname 79#else 80shmUnlink = error "System.Posix.SharedMem:shm_unlink: not available" 81#endif 82 83#ifdef HAVE_SHM_OPEN 84foreign import ccall unsafe "shm_open" 85 shm_open :: CString -> CInt -> CMode -> IO CInt 86#endif 87 88#ifdef HAVE_SHM_UNLINK 89foreign import ccall unsafe "shm_unlink" 90 shm_unlink :: CString -> IO CInt 91#endif 92