1 -----------------------------------------------------------------------------
3 -- Module : Control.Concurrent.QSem
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/core/LICENSE)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable
11 -- $Id: QSem.hs,v 1.1 2001/06/28 14:15:02 simonmar Exp $
15 -----------------------------------------------------------------------------
17 module Control.Concurrent.QSem
19 newQSem, -- :: Int -> IO QSem
20 waitQSem, -- :: QSem -> IO ()
21 signalQSem -- :: QSem -> IO ()
24 import Control.Concurrent.MVar
26 -- General semaphores are also implemented readily in terms of shared
27 -- @MVar@s, only have to catch the case when the semaphore is tried
28 -- waited on when it is empty (==0). Implement this in the same way as
29 -- shared variables are implemented - maintaining a list of @MVar@s
30 -- representing threads currently waiting. The counter is a shared
31 -- variable, ensuring the mutual exclusion on its access.
33 newtype QSem = QSem (MVar (Int, [MVar ()]))
35 newQSem :: Int -> IO QSem
37 sem <- newMVar (init,[])
40 waitQSem :: QSem -> IO ()
41 waitQSem (QSem sem) = do
42 (avail,blocked) <- takeMVar sem -- gain ex. access
44 putMVar sem (avail-1,[])
48 Stuff the reader at the back of the queue,
49 so as to preserve waiting order. A signalling
50 process then only have to pick the MVar at the
51 front of the blocked list.
53 The version of waitQSem given in the paper could
56 putMVar sem (0, blocked++[block])
59 signalQSem :: QSem -> IO ()
60 signalQSem (QSem sem) = do
61 (avail,blocked) <- takeMVar sem
63 [] -> putMVar sem (avail+1,[])
65 (block:blocked') -> do
66 putMVar sem (0,blocked')