From: Christophe Rhodes Date: Thu, 15 Apr 2004 13:17:18 +0000 (+0000) Subject: 0.8.9.45: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=ec066d84dd46611428943d152749b3891a3f4b7c;p=sbcl.git 0.8.9.45: Slight threadcode cleanup ... add boilerplate; ... make bodies of WITH-MUTEX and WITH-RECURSIVE-LOCK accept declarations; ... implement GET-MUTEX and RELEASE-MUTEX for unithread, but don't actually use them yet because we're still in "no performance penalty for unithread"; ... make WITH-MUTEX available in the cross-compiler, so that if necessary we can lock sections non-recursively. --- diff --git a/src/code/cross-thread.lisp b/src/code/cross-thread.lisp index eb71d1f..1c63565 100644 --- a/src/code/cross-thread.lisp +++ b/src/code/cross-thread.lisp @@ -1,9 +1,27 @@ -(in-package :sb!thread) +;;;; cross-compile-time-only replacements for threading stuff -(defun make-mutex (&key name value) nil) +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + +(in-package "SB!THREAD") + +(defun make-mutex (&key name value) + (declare (ignore name value)) + nil) + +(defmacro with-mutex ((mutex) &body body) + (declare (ignore mutex)) + `(locally ,@body)) (defmacro with-recursive-lock ((mutex) &body body) - `(progn ,@body)) + (declare (ignore mutex)) + `(locally ,@body)) diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp index 510cd32..b681336 100644 --- a/src/code/target-thread.lisp +++ b/src/code/target-thread.lisp @@ -1,16 +1,27 @@ +;;;; support for threads in the target machine + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + (in-package "SB!THREAD") ;;; FIXME it would be good to define what a thread id is or isn't (our ;;; current assumption is that it's a fixnum). It so happens that on ;;; Linux it's a pid, but it might not be on posix thread implementations -(sb!alien::define-alien-routine ("create_thread" %create-thread) - sb!alien:unsigned-long - (lisp-fun-address sb!alien:unsigned-long)) +(define-alien-routine ("create_thread" %create-thread) + unsigned-long + (lisp-fun-address unsigned-long)) -(sb!alien::define-alien-routine "signal_thread_to_dequeue" - sb!alien:unsigned-int - (thread-id sb!alien:unsigned-long)) +(define-alien-routine "signal_thread_to_dequeue" + unsigned-int + (thread-id unsigned-long)) (defvar *session* nil) @@ -155,16 +166,6 @@ (setf (mutex-value lock) nil) (futex-wake (mutex-value-address lock) 1)) - -(defmacro with-mutex ((mutex &key value (wait-p t)) &body body) - (with-unique-names (got) - `(let ((,got (get-mutex ,mutex ,value ,wait-p))) - (when ,got - (unwind-protect - (progn ,@body) - (release-mutex ,mutex)))))) - - ;;;; condition variables (defun condition-wait (queue lock) diff --git a/src/code/target-unithread.lisp b/src/code/target-unithread.lisp index 6eb1df2..0eddbbb 100644 --- a/src/code/target-unithread.lisp +++ b/src/code/target-unithread.lisp @@ -1,3 +1,14 @@ +;;;; unithread stub support for threads in the target machine + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + (in-package "SB!THREAD") ;;; used bu debug-int.lisp to access interrupt contexts @@ -92,16 +103,19 @@ (return t)) (setf old-value t1)))) -(defmacro with-mutex ((mutex &key value (wait-p t)) &body body) - (cond ((not wait-p) - `(unless (mutex-value ,mutex) - (unwind-protect - (progn - (setf (mutex-value ,mutex) (or ,value t)) - ,@body) - (setf (mutex-value ,mutex) nil)))) - (t - `(progn ,@body)))) +(defun get-mutex (lock &optional new-value (wait-p t)) + (declare (type mutex lock)) + (let ((old-value (mutex-value lock))) + (when (and old-value wait-p) + (error "In unithread mode, mutex ~S was requested with WAIT-P ~S and ~ + new-value ~S, but has already been acquired (with value ~S)." + lock wait-p new-value old-value)) + (setf (mutex-value lock) new-value) + t)) + +(defun release-mutex (lock) + (declare (type mutex lock)) + (setf (mutex-value lock) nil)) ;;; what's the best thing to do with these on unithread? commented ;;; functions are the thread versions, just to remind me what they do diff --git a/src/code/thread.lisp b/src/code/thread.lisp index 1f2ddcc..1e622ce 100644 --- a/src/code/thread.lisp +++ b/src/code/thread.lisp @@ -1,7 +1,34 @@ +;;;; support for threads needed at cross-compile time + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + (in-package "SB!THREAD") +(sb!xc:defmacro with-mutex ((mutex &key value (wait-p t)) &body body) + #!-sb-thread (declare (ignore mutex value wait-p)) + #!+sb-thread + (with-unique-names (got) + `(let ((,got (get-mutex ,mutex ,value ,wait-p))) + (when ,got + (unwind-protect + (locally ,@body) + (release-mutex ,mutex))))) + ;; KLUDGE: this separate expansion for (NOT SB-THREAD) is not + ;; strictly necessary; GET-MUTEX and RELEASE-MUTEX are implemented. + ;; However, there would be a (possibly slight) performance hit in + ;; using them. + #!-sb-thread + `(locally ,@body)) + (sb!xc:defmacro with-recursive-lock ((mutex) &body body) - (declare (ignore #!-sb-thread mutex)) + #!-sb-thread (declare (ignore mutex)) #!+sb-thread (with-unique-names (cfp) `(let ((,cfp (sb!kernel:current-fp))) @@ -18,12 +45,12 @@ ;; confuse GC completely. -- CSR, 2003-06-03 (get-mutex ,mutex (sb!kernel:make-lisp-obj (sb!sys:sap-int ,cfp)))) (unwind-protect - (progn ,@body) + (locally ,@body) (when (sb!sys:sap= (sb!sys:int-sap (sb!kernel:get-lisp-obj-address (mutex-value ,mutex))) ,cfp) (release-mutex ,mutex))))) #!-sb-thread - `(progn ,@body)) + `(locally ,@body)) diff --git a/version.lisp-expr b/version.lisp-expr index 3862fa1..0210465 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.9.44" +"0.8.9.45"