interprocess 0.2.0.0 → 0.2.0.1
raw patch · 4 files changed
+80/−33 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- README.md +47/−10
- interprocess.cabal +1/−1
- src/Foreign/SharedPtr.c +4/−2
- test/StoredMVar.hs +28/−20
README.md view
@@ -1,24 +1,61 @@ # interprocess+[](https://hackage.haskell.org/package/interprocess)+[](http://travis-ci.org/achirkin/interprocess) -WIP: platform-independent interprocess communication.+Platform-independent interprocess communication. -The core feature is shared memory allocator implemented using POSIX mmap and Windows CreateFileMapping.+This project provides a shared memory allocator and some synchronization primitives+for Win32 and POSIX systems.+++#### SharedObjectName++`Foreign.SharedObjectName.SOName` is a globally unique name that can be used to lookup+shared objects across processes.+Internally, it is a `ForeignPtr` to a C-string with a fixed length.+The library provides `Eq`, `Show`, and `Storable` instances and helper functions+to transfer `SOName` via pipes or by any other means.++#### SharedPtr++`Foreign.SharedPtr` provides a custom shared memory `Allocator` and a bunch of functions+similar to vanilla `Ptr`.+Memory allocation is implemented using POSIX mmap and Windows CreateFileMapping APIs. You can create as many allocators as you want (as your RAM can afford) and concurrently malloc and free memory in different processes using them.+All functions of that module are wrappers on C functions from `Foreign.SharedPtr.C`.+The latter can be used to pass the allocation functions as pointers+(those C functions do not need Haskell runtime, thus can be used in unsafe callbacks). -Features and TODO:+#### Control.Concurrent.Process +`Control.Concurrent.Process.*` provide a few synchronization primitives trying+to mirror the interface of `Control.Concurrent.*` modules for the IPC case.+The behavior is slightly different due to IPC limitations.+Internally, these use semaphore, mutexes, condition variables, and events+from Win32/POSIX in a platform-dependent way.++### TODO+ * [x] `Foreign.SharedPtr` -- `malloc`, `realloc` and `free` in the shared memory region that can be accessed by multiple processes. * [x] Semaphores- * [ ] Mutexes (not sure if need this)- * [x] Mutable variables via `Storable` instance plus garbage collection.- * [ ] Proper error messages- * [ ] Debug, verbose mode+ * [x] Mutable variables (`MVar`-like) via `Storable` instance.+ * [ ] `Control.Concurrent.Chan`-like channels+ * [ ] More tests+ * [ ] Ensure Win32 waiting on events interruptible+ (Custom interrupt signal handler + WaitForMultipleObjects)+ * [ ] Benchmarks -The idea of the library is to address GHC stop-the-world GC problem:+### Think about it +There is an untested idea to address GHC stop-the-world GC problem:+ 1. Create several instances of your program in different isolated processes using e.g. `typed-process` library.- 2. Establish shared memory and semaphore usage via this program- 3. Garbage collection events in one process do not affect another one at all. Profit!+ 2. Establish shared memory and semaphore usage via this library+ 3. Garbage collection events in one process do not affect another one at all.+ Profit!++The question is if the cost of IPC synchronization is lower than the added+cost of collecting garbage in all parallel threads.
interprocess.cabal view
@@ -1,5 +1,5 @@ name: interprocess-version: 0.2.0.0+version: 0.2.0.1 synopsis: Shared memory and control structures for IPC description: Provides portable shared memory allocator and some synchronization primitives. Can be used for interprocess communication.
@@ -152,7 +152,8 @@ } memset(sdataPtr, 0, sizeof(SharedAllocData)); SharedPtr curNode;- for(HsInt i = 0; i < WORD_SIZE_IN_BITS; i++) {+ HsInt i;+ for(i = 0; i < WORD_SIZE_IN_BITS; i++) { curNode = ((SharedPtr) &(sdataPtr->availStorage[i])) - ((SharedPtr) sdataPtr); sdataPtr->availStorage[i] = (struct ListNode)@@ -228,7 +229,8 @@ } // release all stores except the main one- for (HsWord8 storeId = DEFAULT_STORE_SIZE_FACTOR;+ HsWord8 storeId;+ for (storeId = DEFAULT_STORE_SIZE_FACTOR; storeId <= sdataPtr->largestStoreId; storeId++) { _store_free( sdataPtr->storeNames[storeId]
test/StoredMVar.hs view
@@ -1,22 +1,23 @@+{-# LANGUAGE CPP #-} module Main (main) where +import Control.Concurrent (forkIO)+import qualified Control.Concurrent.MVar as Vanilla import Control.Concurrent.Process.StoredMVar-import qualified Control.Concurrent.MVar as Vanilla-import Control.Concurrent (forkIO)-import Control.Monad (void, forM)--- import Control.Exception (SomeException, catch,--- displayException)+import Control.Exception+import Control.Monad (forM, void)+import Data.Monoid (First (..), Monoid (..))+#if __GLASGOW_HASKELL__ >= 800+import Data.Semigroup (Semigroup (..))+#endif import Foreign.SharedObjectName--- import GHC.Environment (getFullArgs) import System.Environment import System.Exit-import Data.Monoid-import Text.Read (readMaybe)+import System.IO+import System.IO.Unsafe+import System.Mem import System.Process.Typed-import System.IO-import Control.Exception-import System.IO.Unsafe-import System.Mem+import Text.Read (readMaybe) -- | A number of processes trying to do something concurrently. -- For example, read from the same StoredMVar.@@ -74,7 +75,9 @@ b <- readMVar mVar c <- readMVar mVar putStrLn $ "Reading: " ++ show (a,b,c)- return Success+ return $ if a <= b && b <= c+ then Success+ else Failure "Three taken numbers must go ordered!" tests :: [IO ([TestSpec], IO ())] tests =@@ -105,18 +108,23 @@ | Failure String deriving (Eq, Ord, Show, Read) +#if __GLASGOW_HASKELL__ >= 800+instance Semigroup TestResult where+ (<>) = mappend+#endif+ instance Monoid TestResult where mempty = Success- mappend Success a = a- mappend (Failure s) Success = Failure s+ mappend Success a = a+ mappend (Failure s) Success = Failure s mappend (Failure s) (Failure t) = Failure $ unlines [s,t] displayResult :: TestResult -> String displayResult Success = "OK."-displayResult (Failure s) = unlines $ ("Failure":) . map (" " <>) . filter (not . null) $ lines s+displayResult (Failure s) = unlines $ ("Failure":) . map (mappend " ") . filter (not . null) $ lines s finish :: TestResult -> IO a-finish Success = exitSuccess+finish Success = exitSuccess finish (Failure s) = die s main :: IO ()@@ -134,7 +142,7 @@ fin return r case foldMap id results of- Success -> exitSuccess+ Success -> exitSuccess Failure _ -> exitFailure runSpecs :: FilePath -> [TestSpec] -> IO TestResult@@ -158,11 +166,11 @@ ecode <- waitExitCode p evaluate $ foldr seq () errs Vanilla.putMVar mr $! case ecode of- ExitSuccess -> Success+ ExitSuccess -> Success ExitFailure _ -> Failure (unlines . map withI $ lines errs) rx <- unsafeInterleaveIO $ Vanilla.takeMVar mr rxs <- go xs- return $ rx <> rxs+ return $ mappend rx rxs where withI s = "[" ++ show i ++ "] " ++ s