From: <me...@us...> - 2005-07-07 13:28:05
|
Update of /cvsroot/sbcl/sbcl/src/code In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6393/src/code Modified Files: thread.lisp Log Message: 0.9.2.35: * bug fix: inner with-recursive-lock no longer releases the mutex Index: thread.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/thread.lisp,v retrieving revision 1.12 retrieving revision 1.13 diff -u -d -r1.12 -r1.13 --- thread.lisp 1 Jul 2005 08:48:33 -0000 1.12 +++ thread.lisp 7 Jul 2005 13:27:56 -0000 1.13 @@ -12,6 +12,10 @@ (in-package "SB!THREAD") (sb!xc:defmacro with-mutex ((mutex &key value (wait-p t)) &body body) + #!+sb-doc + "Acquire MUTEX for the dynamic scope of BODY, setting it to +NEW-VALUE or some suitable default value if NIL. If WAIT-P is non-NIL +and the mutex is in use, sleep until it is available" #!-sb-thread (declare (ignore mutex value wait-p)) #!+sb-thread (with-unique-names (got) @@ -28,14 +32,21 @@ `(locally ,@body)) (sb!xc:defmacro with-recursive-lock ((mutex) &body body) + #!+sb-doc + "Acquires MUTEX for the dynamic scope of BODY. Within that scope +further recursive lock attempts for the same mutex succeed. However, +it is an error to mix WITH-MUTEX and WITH-RECURSIVE-LOCK for the same +mutex." #!-sb-thread (declare (ignore mutex)) #!+sb-thread - (with-unique-names (cfp) - `(let ((,cfp (sb!kernel:current-fp))) - (unless (and (mutex-value ,mutex) - (sb!vm:control-stack-pointer-valid-p - (sb!sys:int-sap - (sb!kernel:get-lisp-obj-address (mutex-value ,mutex))))) + (with-unique-names (cfp inner-lock) + `(let ((,cfp (sb!kernel:current-fp)) + (,inner-lock + (and (mutex-value ,mutex) + (sb!vm:control-stack-pointer-valid-p + (sb!sys:int-sap + (sb!kernel:get-lisp-obj-address (mutex-value ,mutex))))))) + (unless ,inner-lock ;; this punning with MAKE-LISP-OBJ depends for its safety on ;; the frame pointer being a lispobj-aligned integer. While ;; it is, then MAKE-LISP-OBJ will always return a FIXNUM, so @@ -46,10 +57,7 @@ (get-mutex ,mutex (sb!kernel:make-lisp-obj (sb!sys:sap-int ,cfp)))) (unwind-protect (locally ,@body) - (when (sb!sys:sap= (sb!sys:int-sap - (sb!kernel:get-lisp-obj-address - (mutex-value ,mutex))) - ,cfp) + (unless ,inner-lock (release-mutex ,mutex))))) #!-sb-thread `(locally ,@body)) |