mutex code in gdk.lisp

"Matthew D. Swank" <[email protected]> Sun, 30 Dec 2007 01:59:00 -0600
Newsgroups gmane.lisp.clg.devel
Message-ID <[email protected]>
The accessor sb-thread:mutex-value can only refer to nil or to the owning
thread, so the use of a cons as the mutex value in calls to get-mutex fail
under recent versions of sbcl.  The attached patch fixes that (and is
backward compatible with older sbcl's?)

--- gdk.lisp.~1.47.~	2007-11-14 06:52:32.000000000 -0600
+++ gdk.lisp	2007-12-30 01:19:20.000000000 -0600
@@ -1120,25 +1120,27 @@
 #+sb-thread
 (progn
   (defvar *global-lock* nil)
+  (defvar *entry-count* 0)
 
   (defun %global-lock-p ()
-    (eq (car (sb-thread:mutex-value *global-lock*)) sb-thread:*current-thread*))
+    (eq (sb-thread:mutex-value *global-lock*) sb-thread:*current-thread*))
 
   (defun threads-enter ()
     (when *global-lock*
       (if (%global-lock-p)
-	  (incf (cdr (sb-thread:mutex-value *global-lock*)))
-	(sb-thread:get-mutex *global-lock* (cons sb-thread:*current-thread* 0)))))
+	  (incf *entry-count*)
+          (progn (sb-thread:get-mutex *global-lock*)
+                 (setf *entry-count* 0)))))
     
   (defun threads-leave (&optional flush-p)
     (when *global-lock*
       (assert (%global-lock-p))
       (cond
-       ((zerop (cdr (sb-thread:mutex-value *global-lock*)))
+       ((zerop *entry-count*)
 	(when flush-p
 	  (flush))
 	(sb-thread:release-mutex *global-lock*))
-       (t (decf (cdr (sb-thread:mutex-value *global-lock*)))))))
+       (t (decf *entry-count*)))))
 
   (define-callback %enter-fn nil ()
     (threads-enter))
8<-------------------snip------------------------
-- 
"You do not really understand something unless you
 can explain it to your grandmother." -- Albert Einstein.



-------------------------------------------------------------------------
This SF.net email is sponsored by: Microsoft
Defy all challenges. Microsoft(R) Visual Studio 2005.
http://clk.atdmt.com/MRT/go/vse0120000070mrt/direct/01/