[ clisp-Bugs-3424574 ] Semaphores implemented using exemptions don't work

[SourceForge.net <no...@so...>]

Bugs item #3424574, was opened at 2011-10-17 09:55
Message generated for change (Tracker Item Submitted) made by sopindmitry
You can respond by visiting: 
https://sourceforge.net/tracker/?func=detail&atid=101355&aid=3424574&group_id=1355

Please note that this message will contain a full copy of the comment thread,
including the initial issue submission, for this request,
not just the latest update.
Category: multithreading
Group: lisp error
Status: Open
Resolution: None
Priority: 5
Private: No
Submitted By: Sopin Dmitry (sopindmitry)
Assigned to: Vladimir Tzankov (vtz)
Summary: Semaphores implemented using exemptions don't work

Initial Comment:
I tried following code to implement semaphores:

(defstruct clisp-semaphore
  state
  lock
  condition)

(defun make-semaphore (value)
  (make-clisp-semaphore :state value
                                       :lock  (make-mutex)
                                       :condition (make-exemption)))

(defun wait-semaphore (semaphore)
    (let ((lock (clisp-semaphore-lock semaphore))
	(condition (clisp-semaphore-condition semaphore)))
    (mutex-lock lock)
    (loop 
       (if (> (clisp-semaphore-state semaphore) 0)
	   (return)
	   (mt:exemption-wait condition lock)))
    (decf (clisp-semaphore-state semaphore))
    (mutex-unlock lock))

(defun signal-semaphore (semaphore)
  (let ((lock (clisp-semaphore-lock semaphore)))
    (lock-mutex lock)
    (incf (clisp-semaphore-state semaphore))
    (mt:exemption-signal (clisp-semaphore-condition semaphore))
    (unlock-mutex lock)))

And following test code:
(let ((semaphore (make-semaphore)))
  (dotimes (i 10)
    (make-thread #'(lambda () (dotimes (i 100) (wait-semaphore semaphore))))
    (make-thread #'(lambda () (dotimes (i 100) (signal-semaphore semaphore))))))

This test code falls into deadlock. 
Equal code written in SBCL works. Is something wrong with exemptions?

Tried clisp versions 2.48 and 2.49 under Gentoo Linux.

----------------------------------------------------------------------

You can respond by visiting: 
https://sourceforge.net/tracker/?func=detail&atid=101355&aid=3424574&group_id=1355