Made multi threading work on recent versions of SBCL

diff --git a/gdk/gdk.lisp b/gdk/gdk.lisp
index 54e63b944a1d47b777435e12a708705e3815f74a..c1421e342e107e4e5c6bb5fd5a09c2c9ddeb3694 100644 (file)
--- a/gdk/gdk.lisp
+++ b/gdk/gdk.lisp
@@ -20,7 +20,7 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 

-;; $Id: gdk.lisp,v 1.47 2007/11/14 12:52:32 espen Exp $
+;; $Id: gdk.lisp,v 1.48 2008/01/02 15:26:46 espen Exp $

 
 
 (in-package "GDK")
 
 
 (in-package "GDK")


@@ -1120,25 +1120,26 @@   (defbinding (cairo-surface-get-window "clg_gdk_cairo_surface_get_window") () w
 #+sb-thread
 (progn
   (defvar *global-lock* nil)
 #+sb-thread
 (progn
   (defvar *global-lock* nil)

+  (defvar *recursion-count* 0)

 
   (defun %global-lock-p ()
 
   (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)
 
   (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 *recursion-count*)
+        (sb-thread:get-mutex *global-lock*))))

     
   (defun threads-leave (&optional flush-p)
     (when *global-lock*
       (assert (%global-lock-p))
       (cond
     
   (defun threads-leave (&optional flush-p)
     (when *global-lock*
       (assert (%global-lock-p))
       (cond

-       ((zerop (cdr (sb-thread:mutex-value *global-lock*)))
+       ((zerop *recursion-count*)

        (when flush-p
          (flush))
        (sb-thread:release-mutex *global-lock*))
        (when flush-p
          (flush))
        (sb-thread:release-mutex *global-lock*))

-       (t (decf (cdr (sb-thread:mutex-value *global-lock*)))))))
+       (t (decf *recursion-count*)))))

 
   (define-callback %enter-fn nil ()
     (threads-enter))
 
   (define-callback %enter-fn nil ()
     (threads-enter))


@@ -1146,7 +1147,7 @@   (define-callback %enter-fn nil ()
   (define-callback %leave-fn nil ()
     (threads-leave))
   
   (define-callback %leave-fn nil ()
     (threads-leave))
   

-  (defbinding %threads-set-lock-functions (&optional) nil
+  (defbinding %threads-set-lock-functions (nil) nil

     (%enter-fn callback)
     (%leave-fn callback))
 
     (%enter-fn callback)
     (%leave-fn callback))