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