2 % (c) The GRASP/AQUA Project, Glasgow University, 1995
4 \section[Semaphore]{Quantity semaphores}
6 General/quantity semaphores
14 newQSem, --:: Int -> IO QSem
15 waitQSem, --:: QSem -> IO ()
16 signalQSem, --:: QSem -> IO ()
20 newQSemN, --:: Int -> IO QSemN
21 waitQSemN, --:: QSemN -> Int -> IO ()
22 signalQSemN --:: QSemN -> Int -> IO ()
29 General semaphores are also implemented readily in terms of shared
30 @MVar@s, only have to catch the case when the semaphore is tried
31 waited on when it is empty (==0). Implement this in the same way as
32 shared variables are implemented - maintaining a list of @MVar@s
33 representing threads currently waiting. The counter is a shared
34 variable, ensuring the mutual exclusion on its access.
37 data QSem = QSem (MVar (Int, [MVar ()]))
39 newQSem :: Int -> IO QSem
41 = newMVar (init,[]) >>= \ sem ->
44 waitQSem :: QSem -> IO ()
46 = takeMVar sem >>= \ (avail,blocked) -> -- gain ex. access
48 putMVar sem (avail-1,[]) >>
51 newEmptyMVar >>= \ block ->
53 Stuff the reader at the back of the queue,
54 so as to preserve waiting order. A signalling
55 process then only have to pick the MVar at the
56 front of the blocked list.
58 The version of waitQSem given in the paper could
61 putMVar sem (0, blocked++[block]) >>
62 takeMVar block >>= \ v ->
65 signalQSem :: QSem -> IO ()
67 = takeMVar sem >>= \ (avail,blocked) ->
69 [] -> putMVar sem (avail+1,[]) >>
72 putMVar sem (0,blocked') >>
77 = QSemN (MVar (Int,[(Int,MVar ())]))
79 newQSemN :: Int -> IO QSemN
81 = newMVar (init,[]) >>= \ sem ->
84 waitQSemN :: QSemN -> Int -> IO ()
85 waitQSemN (QSemN sem) sz
86 = takeMVar sem >>= \ (avail,blocked) -> -- gain ex. access
88 putMVar sem (avail-1,[]) >>
91 newEmptyMVar >>= \ block ->
92 putMVar sem (0, blocked++[(sz,block)]) >>
97 signalQSemN :: QSemN -> Int -> IO ()
98 signalQSemN (QSemN sem) n
99 = takeMVar sem >>= \ (avail,blocked) ->
100 free (avail+n) blocked >>= \ (avail',blocked') ->
101 putMVar sem (avail',blocked') >>
104 free avail [] = return (avail,[])
105 free avail ((req,block):blocked) =
108 free (avail-req) blocked
110 free avail blocked >>= \ (avail',blocked') ->
111 return (avail',(req,block):blocked')