Opened 9 years ago

Closed 9 years ago

#3159 closed bug (fixed)

QSem fails with negative quantities

Reported by: NeilMitchell Owned by:
Priority: normal Milestone:
Component: libraries/base Version: 6.10.2
Keywords: Cc: ndmitchell@…
Operating System: Unknown/Multiple Architecture: Unknown/Multiple
Type of failure: None/Unknown Test Case:
Blocked By: Blocking:
Related Tickets: Differential Rev(s):
Wiki Page:

Description

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.

Change History (5)

comment:1 Changed 9 years ago by NeilMitchell

Cc: ndmitchell@… added

comment:2 Changed 9 years ago by ChrisKuklewicz

Can be fixed by changing waitQSem's

putMVar sem (0, blocked++[block])

to

putMVar sem (avail, blocked++[block])

and also change signalQSem to

signalQSem :: QSemN -> IO () signalQSem (QSemN sem) = modifyMVar_ free sem

where free (0,(b:bs)) = putMVar b () >> return (0,bs)

free (avail,blocked) = return (avail+1,blocked)

Note: QSem, QSemN, and SampleVar are all not exception safe.

comment:3 Changed 9 years ago by igloo

difficulty: Unknown
Resolution: fixed
Status: newclosed

"Simple quantity semaphores" can't have negative amounts available; the bug here is that newQSem doesn't check that it has been given a non-negative argument; fixed for both QSem and QSemN by:

Fri Apr 10 17:40:13 BST 2009  Ian Lynagh <igloo@earth.li>
  * Fix QSem and QSemN: Initial amount must be non-negative

You can write your program with QSemN:

import Data.IORef
import Control.Concurrent

main = do
   sem <- newQSemN 0
   r <- newIORef 0
   let incRef = atomicModifyIORef r (\a -> (a+1,a))
   sequence_ $ replicate 100 $ forkIO $ incRef >> signalQSemN sem 1
   waitQSemN sem 100
   v <- readIORef r
   print v

comment:4 Changed 9 years ago by NeilMitchell

Resolution: fixed
Status: closedreopened

It seems a shame that when we could provide total implementations of these functions, with intuitive semantics, we choose to make the functions partial. Perhaps leave this ticket open at a low priority to indicate that desire?

If the exception is the way to go, it should at least be documented in the Haddock.

comment:5 Changed 9 years ago by igloo

Resolution: fixed
Status: reopenedclosed

I've documented the 0 minimum quantity.

Note: See TracTickets for help on using tickets.