From e6a897c42cbfadc0dbae03ac308a14c97e1102b2 Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Mon, 29 Sep 1997 04:44:44 +0000 Subject: [PATCH] Process structure predicate was intended to be processp not process-p, for compat. with clim-sys. Rework the with-lock-held macro; bug fixes; faster version for the Pentium using new %instance-set-conditional inline function. --- code/multi-proc.lisp | 54 ++++++++++++++++++++++++-------------------- 1 file changed, 30 insertions(+), 24 deletions(-) diff --git a/code/multi-proc.lisp b/code/multi-proc.lisp index cba54299a..ec46c0b52 100644 --- a/code/multi-proc.lisp +++ b/code/multi-proc.lisp @@ -3,7 +3,7 @@ ;;; This code was written by Douglas T. Crosher and has been placed in ;;; the Public domain, and is provided 'as is'. ;;; -;;; $Id: multi-proc.lisp,v 1.1 1997/09/24 06:08:14 dtc Exp $ +;;; $Id: multi-proc.lisp,v 1.2 1997/09/29 04:44:44 dtc Exp $ ;;; ;;; ********************************************************************** ;;; @@ -489,6 +489,7 @@ (defstruct (process (:constructor %make-process) + (:predicate processp) (:print-function (lambda (process stream depth) (declare (type process process) @@ -900,30 +901,35 @@ (name nil) (process nil :type (or null process))) -;;; Try to seize a lock for the current process, installing the -;;; current process in the lock's process slot on success. -;;; -;;; This currently use without-interrupts but could be implement as a -;;; fast atomic VOP. -;;; -(defun seize-lock (lock) +;;; Compare the lock's process slot to test-process and when equal set +;;; to new-process, returning the old slot value. +(declaim (inline seize-lock)) +#-pentium +(defun seize-lock (lock test-process new-process) + (declare (type lock lock)) (sys:without-interrupts - (when (null (lock-process lock)) - (setf (lock-process lock) *current-process*)) - (values))) + (let ((process (lock-process lock))) + (when (eq process test-process) + (setf (lock-process lock) new-process)) + process))) + +;;; Fast inline version for Pentium. +#+pentium +(defun seize-lock (lock test-process new-process) + (declare (type lock lock)) + (kernel:%instance-set-conditional lock 2 test-process new-process)) -;;; Only waits if it can't seize the lock. (defmacro with-lock-held ((lock &optional (whostate "Waiting for lock")) &body body) - `(unwind-protect - (progn - (seize-lock ,lock) - (unless (eq (lock-process ,lock) *current-process*) - (process-wait ,whostate - #'(lambda () - (if (or (eq (lock-process ,lock) *current-process*) - (null (lock-process ,lock))) - (setf (lock-process ,lock) *current-process*))))) - ,@body) - (when (eq (lock-process ,lock) *current-process*) - (setf (lock-process ,lock) nil)))) + (let ((have-lock (gensym))) + `(let ((,have-lock (eq (lock-process ,lock) *current-process*))) + (unwind-protect + (progn + (unless (or ,have-lock + (null (seize-lock ,lock nil *current-process*))) + (process-wait ,whostate + #'(lambda () + (null (seize-lock ,lock nil *current-process*))))) + ,@body) + (unless ,have-lock + (setf (lock-process ,lock) nil)))))) -- GitLab