#3159: QSem fails with negative quantities
-----------------------------+----------------------------------------------
Reporter: NeilMitchell | Owner:
Type: bug | Status: new
Priority: normal | Component: libraries/base
Version: 6.10.2 | Severity: major
Keywords: | Testcase:
Os: Unknown/Multiple | Architecture: Unknown/Multiple
-----------------------------+----------------------------------------------
The following program should always give 100 (I think). It doesn't:
{{{
import Data.IORef
import Control.Concurrent
main = do
sem <- newQSem (-99)
r <- newIORef 0
let incRef = atomicModifyIORef r (\a -> (a+1,a))
sequence_ $ replicate 100 $ forkIO $ incRef >> signalQSem sem
waitQSem sem
v <- readIORef r
print v
}}}
With a 2 processor machine on Windows, using GHC 6.8.3 and 6.10.2 and +RTS
-N3 I usually get 100, but occasionally get answers such as 49, 82, 95.
With +RTS -N2 it almost always works.
From reading the implementation of QSem, it doesn't seem that negative
availability was considered. A quick look suggests a better implementation
might be:
{{{
-- Invariant: avail >= 1 ==> null blocked
waitQSem :: QSem -> IO ()
waitQSem (QSem sem) = do
(avail,blocked) <- takeMVar sem -- gain ex. access
if avail > 0 then
putMVar sem (avail-1,[])
else do
block <- newEmptyMVar
putMVar sem (avail, blocked++[block]) -- changed line
takeMVar block
signalQSem :: QSem -> IO ()
signalQSem (QSem sem) = do
(avail,blocked) <- takeMVar sem
-- changed below
if null blocked || avail < 0 then
putMVar sem (avail+1,blocked)
else
putMVar sem (avail, tail blocked)
putMVar (head blocked) ()
}}}
Writing parallel code is hard, so I could have easily got this wrong.
I haven't looked at QSemN, which may need similar fixes (or may
already deal with this)
Marking as severity major because it can cause incorrect parallel
behaviour.
--
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/3159>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
