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/