[Sbcl-commits] CVS: sbcl/src/code target-thread.lisp,1.7,1.8

[Daniel B. <da...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1:/tmp/cvs-serv26327/src/code

Modified Files:
	target-thread.lisp 
Log Message:
.8.2.21
	Fixes for a couple of threading bugs found by Gilbert Baumann

	... CONDITION-WAIT should acquire the lock with the correct
	    value (i.e. the one it had when it went to sleep), not 
	    just the default value. 
	... CONDITION-NOTIFY should get the queue spinlock before 
	    signalling, making it atomic wrt WAIT-ON-QUEUE

	Added rudimentary thread test script that I thought I'd 
	committed on some previous occasion



Index: target-thread.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-thread.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- target-thread.lisp	18 Jul 2003 21:40:44 -0000	1.7
+++ target-thread.lisp	8 Aug 2003 13:41:48 -0000	1.8
@@ -153,21 +153,23 @@
   "Atomically release LOCK and enqueue ourselves on QUEUE.  Another
 thread may subsequently notify us using CONDITION-NOTIFY, at which
 time we reacquire LOCK and return to the caller."
-  (unwind-protect
-       (progn
-	 (get-spinlock queue 2 (current-thread-id))
-	 (wait-on-queue queue lock))
-    ;; If we are interrupted while waiting, we should do these things
-    ;; before returning.  Ideally, in the case of an unhandled signal,
-    ;; we should do them before entering the debugger, but this is
-    ;; better than nothing.
-    (with-spinlock (queue)
-      (dequeue queue))
-    (get-mutex lock)))
+  (assert lock)
+  (let ((value (mutex-value lock)))
+    (unwind-protect
+	 (progn
+	   (get-spinlock queue 2 (current-thread-id))
+	   (wait-on-queue queue lock))
+      ;; If we are interrupted while waiting, we should do these things
+      ;; before returning.  Ideally, in the case of an unhandled signal,
+      ;; we should do them before entering the debugger, but this is
+      ;; better than nothing.
+      (with-spinlock (queue)
+	(dequeue queue))
+      (get-mutex lock value))))
 
 (defun condition-notify (queue)
   "Notify one of the processes waiting on QUEUE"
-  (signal-queue-head queue))
+  (with-spinlock (queue) (signal-queue-head queue)))
 
 
 ;;;; multiple independent listeners