From: Nikodemus S. <de...@us...> - 2007-06-08 20:38:25
|
Update of /cvsroot/sbcl/sbcl/src/code In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv29933/src/code Modified Files: fd-stream.lisp thread.lisp timer.lisp Log Message: 1.0.6.38: thread and interrupt safe ADD/REMOVE-METHOD * ADD/REMOVE-METHOD need to grab the GF lock and disable interrupts. * ADD/REMOVE-DIRECT-METHOD, and SPECIALIZER-DIRECT-GENERIC-FUNCTIONS need a lock as well, but instead of adding per-specializer lock just use one global one: contention should be minimal here. * INTERN-EQL-SPECIALIZER needs a lock. * Fix non-threaded build. * Delete dead NAME variables from ADD/REMOVE-METHOD. * Tests. Index: fd-stream.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/fd-stream.lisp,v retrieving revision 1.114 retrieving revision 1.115 diff -u -d -r1.114 -r1.115 --- fd-stream.lisp 8 Jun 2007 12:15:45 -0000 1.114 +++ fd-stream.lisp 8 Jun 2007 20:38:22 -0000 1.115 @@ -18,9 +18,8 @@ (defvar *available-buffers* () #!+sb-doc "List of available buffers. Each buffer is an sap pointing to - bytes-per-buffer of memory.") +bytes-per-buffer of memory.") -#!+sb-thread (defvar *available-buffers-mutex* (sb!thread:make-mutex :name "lock for *AVAILABLE-BUFFERS*") #!+sb-doc Index: thread.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/thread.lisp,v retrieving revision 1.20 retrieving revision 1.21 diff -u -d -r1.20 -r1.21 --- thread.lisp 8 Jun 2007 12:15:46 -0000 1.20 +++ thread.lisp 8 Jun 2007 20:38:22 -0000 1.21 @@ -37,6 +37,12 @@ ,value ,wait-p)) +(sb!xc:defmacro with-system-mutex ((mutex &key without-gcing) &body body) + `(call-with-system-mutex + (lambda () ,@body) + ,mutex + ,without-gcing)) + (sb!xc:defmacro with-recursive-lock ((mutex) &body body) #!+sb-doc "Acquires MUTEX for the dynamic scope of BODY. Within that scope @@ -52,6 +58,13 @@ (lambda () ,@body) ,spinlock)) +(sb!xc:defmacro with-recursive-system-spinlock ((spinlock &key without-gcing) + &body body) + `(call-with-recursive-system-spinlock + (lambda () ,@body) + ,spinlock + ,without-gcing)) + (sb!xc:defmacro with-spinlock ((spinlock) &body body) `(call-with-spinlock (lambda () ,@body) @@ -72,7 +85,8 @@ (without-interrupts (funcall function)))) - (defun call-with-system-spinlock (function lock &optional without-gcing-p) + (defun call-with-recursive-system-spinlock (function lock + &optional without-gcing-p) (declare (ignore lock) (function function)) (if without-gcing-p Index: timer.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/timer.lisp,v retrieving revision 1.10 retrieving revision 1.11 diff -u -d -r1.10 -r1.11 --- timer.lisp 8 Jun 2007 12:15:46 -0000 1.10 +++ timer.lisp 8 Jun 2007 20:38:22 -0000 1.11 @@ -135,8 +135,6 @@ ;; FUNCTION until the other is called, from when it does nothing. (let ((mutex (sb!thread:make-mutex)) (cancelled-p nil)) - #!-sb-thread - (declare (ignore mutex)) (list #'(lambda () (sb!thread:with-recursive-lock (mutex) |