Update of /project/mcclim/cvsroot/mcclim/Lisp-Dep In directory common-lisp.net:/tmp/cvs-serv21464/Lisp-Dep

Modified Files: mp-sbcl.lisp Log Message: * Lisp-Dep/mp-sbcl.lisp: more changes to keep up with the evolving thread-object API. The new version ought to be backward-compatible too.

Date: Fri Jul 15 18:36:58 2005 Author: dbarlow

Index: mcclim/Lisp-Dep/mp-sbcl.lisp diff -u mcclim/Lisp-Dep/mp-sbcl.lisp:1.7 mcclim/Lisp-Dep/mp-sbcl.lisp:1.8 --- mcclim/Lisp-Dep/mp-sbcl.lisp:1.7 Fri Jul 1 16:53:42 2005 +++ mcclim/Lisp-Dep/mp-sbcl.lisp Fri Jul 15 18:36:58 2005 @@ -56,9 +56,14 @@ (defvar *all-processes-lock* (sb-thread:make-mutex :name "Lock around *ALL-PROCESSES*"))

+;; we implement disable-process by making the disablee attempt to lock +;; *permanent-queue*, which is already locked because we locked it +;; here. enable-process just interrupts the lock attempt. + (defvar *permanent-queue* - (sb-thread:make-mutex :name "Lock for disabled threads" - :data :permanently-queued)) + (sb-thread:make-mutex :name "Lock for disabled threads")) +(unless (sb-thread:mutex-value *permanent-queue*) + (sb-thread:get-mutex *permanent-queue* :locked nil))

(defun make-process (function &key name) (let ((p (%make-process :name name :function function))) @@ -146,16 +151,15 @@ (defmacro without-scheduling (&body body) `(progn ,@body))

-(defparameter *atomic-queue* - #+xlib xlib::*conditional-store-queue* - #-xlib (sb-thread:make-waitqueue :name "atomic incf/decf")) +(defparameter *atomic-lock* + (sb-thread:make-mutex :name "atomic incf/decf"))

(defmacro atomic-incf (place) - `(sb-thread::with-spinlock (*atomic-queue*) + `(sb-thread:with-mutex (*atomic-lock*) (incf ,place)))

(defmacro atomic-decf (place) - `(sb-thread::with-spinlock (*atomic-queue*) + `(sb-thread:with-mutex (*atomic-lock*) (decf ,place)))

;;; 32.3 Locks