unify locks
authorNikodemus Siivola <nikodemus@random-state.net>
Tue, 23 Aug 2011 12:50:04 +0000 (15:50 +0300)
committerNikodemus Siivola <nikodemus@random-state.net>
Thu, 10 Nov 2011 15:14:38 +0000 (17:14 +0200)
  Remove spinlocks, make spinlock functions redirect to mutexes
  instead. (Compile-time deprecation style-warning for spinlocks.)

16 files changed:
src/code/cross-thread.lisp
src/code/fd-stream.lisp
src/code/hash-table.lisp
src/code/target-hash-table.lisp
src/code/target-package.lisp
src/code/target-thread.lisp
src/code/thread.lisp
src/pcl/boot.lisp
src/pcl/defs.lisp
src/pcl/dfun.lisp
src/pcl/methods.lisp
src/pcl/std-class.lisp
src/pcl/vector.lisp
tests/dynamic-extent.impure.lisp
tests/threads.impure.lisp
tests/threads.pure.lisp

index 461f02d..3682330 100644 (file)
   (declare (ignore mutex))
   `(locally ,@body))
 
-(defun make-spinlock (&key name value)
-  (declare (ignore name value))
-  nil)
-
-(defun get-spinlock (spinlock)
-  (declare (ignore spinlock))
-  t)
-
-(defun release-spinlock (spinlock)
-  (declare (ignore spinlock))
-  nil)
-
-(defmacro with-spinlock ((spinlock) &body body)
-  (declare (ignore spinlock))
-  `(locally ,@body))
index 69505b8..6dff66f 100644 (file)
   #!+sb-doc
   "List of available buffers.")
 
-(defvar *available-buffers-spinlock* (sb!thread::make-spinlock
-                                      :name "lock for *AVAILABLE-BUFFERS*")
+(defvar *available-buffers-lock* (sb!thread:make-mutex
+                                  :name "lock for *AVAILABLE-BUFFERS*")
   #!+sb-doc
   "Mutex for access to *AVAILABLE-BUFFERS*.")
 
 (defmacro with-available-buffers-lock ((&optional) &body body)
-  ;; CALL-WITH-SYSTEM-SPINLOCK because
-  ;;
-  ;; 1. streams are low-level enough to be async signal safe, and in
-  ;;    particular a C-c that brings up the debugger while holding the
-  ;;    mutex would lose badly
-  ;;
-  ;; 2. this can potentially be a fairly busy (but also probably
-  ;;    uncontended) lock, so we don't want to pay the syscall per
-  ;;    release -- hence a spinlock.
-  ;;
-  ;; ...again, once we have smarted locks the spinlock here can become
-  ;; a mutex.
-  `(sb!thread::with-system-spinlock (*available-buffers-spinlock*)
+  ;; CALL-WITH-SYSTEM-MUTEX because streams are low-level enough to be
+  ;; async signal safe, and in particular a C-c that brings up the
+  ;; debugger while holding the mutex would lose badly.
+  `(sb!thread::with-system-mutex (*available-buffers-lock*)
      ,@body))
 
 (defconstant +bytes-per-buffer+ (* 4 1024)
index 933b390..4b3da96 100644 (file)
@@ -67,8 +67,8 @@
   ;; respective key.
   (hash-vector nil :type (or null (simple-array sb!vm:word (*))))
   ;; Used for locking GETHASH/(SETF GETHASH)/REMHASH
-  (spinlock (sb!thread::make-spinlock :name "hash-table lock")
-            :type sb!thread::spinlock :read-only t)
+  (lock (sb!thread:make-mutex :name "hash-table lock")
+        :type sb!thread:mutex :read-only t)
   ;; The GC will set this to T if it moves an EQ-based key. This used
   ;; to be signaled by a bit in the header of the kv vector, but that
   ;; implementation caused some concurrency issues when we stopped
@@ -144,10 +144,10 @@ unspecified."
   ;; Needless to say, this also excludes some internal bits, but
   ;; getting there is too much detail when "unspecified" says what
   ;; is important -- unpredictable, but harmless.
-  `(sb!thread::with-recursive-spinlock ((hash-table-spinlock ,hash-table))
+  `(sb!thread::with-recursive-lock ((hash-table-lock ,hash-table))
      ,@body))
 
 (defmacro-mundanely with-locked-system-table ((hash-table) &body body)
-  `(sb!thread::with-recursive-system-spinlock
-       ((hash-table-spinlock ,hash-table))
+  `(sb!thread::with-recursive-system-lock
+       ((hash-table-lock ,hash-table))
      ,@body))
index 27b7322..5c5bdb7 100644 (file)
@@ -628,19 +628,19 @@ multiple threads accessing the same hash-table without locking."
            (hash-table-needs-rehash-p hash-table)))
     (declare (inline rehash-p rehash-without-growing-p))
     (cond ((rehash-p)
-           ;; Use recursive spinlocks since for weak tables the
-           ;; spinlock has already been acquired. GC must be inhibited
-           ;; to prevent the GC from seeing a rehash in progress.
-           (sb!thread::with-recursive-system-spinlock
-               ((hash-table-spinlock hash-table) :without-gcing t)
+           ;; Use recursive locks since for weak tables the lock has
+           ;; already been acquired. GC must be inhibited to prevent
+           ;; the GC from seeing a rehash in progress.
+           (sb!thread::with-recursive-system-lock
+               ((hash-table-lock hash-table) :without-gcing t)
              ;; Repeat the condition inside the lock to ensure that if
              ;; two reader threads enter MAYBE-REHASH at the same time
              ;; only one rehash is performed.
              (when (rehash-p)
                (rehash hash-table))))
           ((rehash-without-growing-p)
-           (sb!thread::with-recursive-system-spinlock
-               ((hash-table-spinlock hash-table) :without-gcing t)
+           (sb!thread::with-recursive-system-lock
+               ((hash-table-lock hash-table) :without-gcing t)
              (when (rehash-without-growing-p)
                (rehash-without-growing hash-table)))))))
 
@@ -660,15 +660,16 @@ multiple threads accessing the same hash-table without locking."
                 (locally (declare (inline ,@inline))
                   ,@body))))
        (if (hash-table-weakness ,hash-table)
-           (sb!thread::with-recursive-system-spinlock
-               ((hash-table-spinlock ,hash-table) :without-gcing t)
+           (sb!thread::with-recursive-system-lock
+               ((hash-table-lock ,hash-table) :without-gcing t)
              (,body-fun))
            (with-pinned-objects ,pin
              (if ,synchronized
-                 ;; We use a "system" spinlock here because it is very
-                 ;; slightly faster, as it doesn't re-enable interrupts.
-                 (sb!thread::with-recursive-system-spinlock
-                     ((hash-table-spinlock ,hash-table))
+                 ;; We use a "system" lock here because it is very
+                 ;; slightly faster, as it doesn't re-enable
+                 ;; interrupts.
+                 (sb!thread::with-recursive-system-lock
+                     ((hash-table-lock ,hash-table))
                    (,body-fun))
                  (,body-fun)))))))
 
index 4569a11..87f1da1 100644 (file)
@@ -61,9 +61,6 @@
   (declare (function function))
   ;; FIXME: Since name conflicts can be signalled while holding the
   ;; mutex, user code can be run leading to lock ordering problems.
-  ;;
-  ;; This used to be a spinlock, but there it can be held for a long
-  ;; time while the debugger waits for user input.
   (sb!thread:with-recursive-lock (*package-graph-lock*)
     (funcall function)))
 
index 7b21c14..0d0ccb9 100644 (file)
@@ -200,9 +200,6 @@ arbitrary printable objects, and need not be unique.")
 (def!method print-object ((mutex mutex) stream)
   (print-lock mutex (mutex-name mutex) (mutex-owner mutex) stream))
 
-(def!method print-object ((spinlock spinlock) stream)
-  (print-lock spinlock (spinlock-name spinlock) (spinlock-value spinlock) stream))
-
 (defun thread-alive-p (thread)
   #!+sb-doc
   "Return T if THREAD is still alive. Note that the return value is
@@ -307,8 +304,6 @@ created and old ones may exit at any time."
   (sb!vm::current-thread-offset-sap n))
 \f
 
-;;;; Spinlocks
-
 (defmacro with-deadlocks ((thread lock &optional (timeout nil timeoutp)) &body forms)
   (with-unique-names (n-thread n-lock new n-timeout)
     `(let* ((,n-thread ,thread)
@@ -332,62 +327,7 @@ created and old ones may exit at any time."
          ;; Interrupt handlers and GC save and restore any
          ;; previous wait marks using WITHOUT-DEADLOCKS below.
          (setf (thread-waiting-for ,n-thread) nil)))))
-
-(declaim (inline get-spinlock release-spinlock))
-
-;;; Should always be called with interrupts disabled.
-(defun get-spinlock (spinlock)
-  (declare (optimize (speed 3) (safety 0)))
-  (let* ((new *current-thread*)
-         (old (sb!ext:compare-and-swap (spinlock-value spinlock) nil new)))
-    (when old
-      (when (eq old new)
-        (error "Recursive lock attempt on ~S." spinlock))
-      #!+sb-thread
-      (with-deadlocks (new spinlock)
-        (flet ((cas ()
-                 (if (sb!ext:compare-and-swap (spinlock-value spinlock) nil new)
-                     (thread-yield)
-                     (return-from get-spinlock t))))
-          ;; Try once.
-          (cas)
-          ;; Check deadlocks
-          (with-interrupts (check-deadlock))
-          (if (and (not *interrupts-enabled*) *allow-with-interrupts*)
-              ;; If interrupts are disabled, but we are allowed to
-              ;; enabled them, check for pending interrupts every once
-              ;; in a while. %CHECK-INTERRUPTS is taking shortcuts, make
-              ;; sure that deferrables are unblocked by doing an empty
-              ;; WITH-INTERRUPTS once.
-              (progn
-                (with-interrupts)
-                (loop
-                  (loop repeat 128 do (cas)) ; 128 is arbitrary here
-                  (sb!unix::%check-interrupts)))
-              (loop (cas)))))))
-    t)
-
-(defun release-spinlock (spinlock)
-  (declare (optimize (speed 3) (safety 0)))
-  ;; On x86 and x86-64 we can get away with no memory barriers, (see
-  ;; Linux kernel mailing list "spin_unlock optimization(i386)"
-  ;; thread, summary at
-  ;; http://kt.iserv.nl/kernel-traffic/kt19991220_47.html#1.
-  ;;
-  ;; If the compiler may reorder this with other instructions, insert
-  ;; compiler barrier here.
-  ;;
-  ;; FIXME: this does not work on SMP Pentium Pro and OOSTORE systems,
-  ;; neither on most non-x86 architectures (but we don't have threads
-  ;; on those).
-  (setf (spinlock-value spinlock) nil)
-
-  ;; FIXME: Is a :memory barrier too strong here?  Can we use a :write
-  ;; barrier instead?
-  #!+(not (or x86 x86-64))
-  (barrier (:memory)))
 \f
-
 ;;;; Mutexes
 
 #!+sb-doc
@@ -421,14 +361,8 @@ HOLDING-MUTEX-P."
 (defun check-deadlock ()
   (let* ((self *current-thread*)
          (origin (thread-waiting-for self)))
-    (labels ((lock-owner (lock)
-               (etypecase lock
-                 (mutex (mutex-%owner lock))
-                 (spinlock (spinlock-value lock))))
-             (lock-p (thing)
-               (typep thing '(or mutex spinlock)))
-             (detect-deadlock (lock)
-               (let ((other-thread (lock-owner lock)))
+    (labels ((detect-deadlock (lock)
+               (let ((other-thread (mutex-%owner lock)))
                  (cond ((not other-thread))
                        ((eq self other-thread)
                         (let* ((chain (deadlock-chain self origin))
@@ -451,10 +385,10 @@ HOLDING-MUTEX-P."
                           ;; If the thread is waiting with a timeout OTHER-LOCK
                           ;; is a cons, and we don't consider it a deadlock -- since
                           ;; it will time out on its own sooner or later.
-                          (when (lock-p other-lock)
+                          (when (mutex-p other-lock)
                             (detect-deadlock other-lock)))))))
              (deadlock-chain (thread lock)
-               (let* ((other-thread (lock-owner lock))
+               (let* ((other-thread (mutex-owner lock))
                       (other-lock (when other-thread
                                     (thread-waiting-for other-thread))))
                  (cond ((not other-thread)
@@ -477,7 +411,7 @@ HOLDING-MUTEX-P."
                             ;; Again, the deadlock is gone?
                             (return-from check-deadlock nil)))))))
       ;; Timeout means there is no deadlock
-      (when (lock-p origin)
+      (when (mutex-p origin)
         (detect-deadlock origin)
         t))))
 
index 4c688bf..71dc92b 100644 (file)
@@ -63,11 +63,40 @@ stale value, use MUTEX-OWNER instead."
         '(setf mutex-value))
   form)
 
-(def!struct spinlock
-  #!+sb-doc
+;;; SPINLOCK no longer exists as a type -- provided for backwards compatibility.
+
+(deftype spinlock ()
   "Spinlock type."
-  (name  nil :type (or null thread-name))
-  (value nil))
+  (deprecation-warning :early "1.0.53.11" 'spinlock 'mutex)
+  'mutex)
+
+(define-deprecated-function :early "1.0.53.11" make-spinlock make-mutex (&key name)
+  (make-mutex :name name))
+
+(define-deprecated-function :early "1.0.5.x" spinlock-name mutex-name (lock)
+  (mutex-name lock))
+
+(define-deprecated-function :early "1.0.53.11" (setf spinlock-name) (setf mutex-name) (name lock)
+  (setf (mutex-name lock) name))
+
+(define-deprecated-function :early "1.0.53.11" spinlock-value mutex-owner (lock)
+  (mutex-owner lock))
+
+(define-deprecated-function :early "1.0.53.11" get-spinlock grab-mutex (lock)
+  (grab-mutex lock))
+
+(define-deprecated-function :early "1.0.53.11" release-spinlock release-mutex (lock)
+  (release-mutex lock))
+
+(sb!xc:defmacro with-recursive-spinlock ((lock) &body body)
+  (deprecation-warning :early "1.0.53.11" 'with-recursive-spinlock 'with-recursive-lock)
+  `(with-recursive-lock (,lock)
+     ,@body))
+
+(sb!xc:defmacro with-spinlock ((lock) &body body)
+  (deprecation-warning :early "1.0.53.11" 'with-recursive-spinlock 'with-mutex)
+  `(with-lock (,lock)
+     ,@body))
 
 (sb!xc:defmacro without-thread-waiting-for ((&key already-without-interrupts) &body body)
   (with-unique-names (thread prev)
@@ -115,12 +144,6 @@ is in use, sleep until it is available"
        #'with-system-mutex-thunk
        ,mutex)))
 
-(sb!xc:defmacro with-system-spinlock ((spinlock &key) &body body)
-  `(dx-flet ((with-system-spinlock-thunk () ,@body))
-     (call-with-system-spinlock
-       #'with-system-spinlock-thunk
-       ,spinlock)))
-
 (sb!xc:defmacro with-recursive-lock ((mutex) &body body)
   #!+sb-doc
   "Acquires MUTEX for the dynamic scope of BODY. Within that scope
@@ -132,28 +155,16 @@ provided the default value is used for the mutex."
       #'with-recursive-lock-thunk
       ,mutex)))
 
-(sb!xc:defmacro with-recursive-spinlock ((spinlock) &body body)
-  `(dx-flet ((with-recursive-spinlock-thunk () ,@body))
-     (call-with-recursive-spinlock
-      #'with-recursive-spinlock-thunk
-      ,spinlock)))
-
-(sb!xc:defmacro with-recursive-system-spinlock ((spinlock
-                                                 &key without-gcing)
-                                                &body body)
-  `(dx-flet ((with-recursive-system-spinlock-thunk () ,@body))
+(sb!xc:defmacro with-recursive-system-lock ((lock
+                                             &key without-gcing)
+                                            &body body)
+  `(dx-flet ((with-recursive-system-lock-thunk () ,@body))
      (,(cond (without-gcing
-               'call-with-recursive-system-spinlock/without-gcing)
+              'call-with-recursive-system-lock/without-gcing)
              (t
-              'call-with-recursive-system-spinlock))
-       #'with-recursive-system-spinlock-thunk
-       ,spinlock)))
-
-(sb!xc:defmacro with-spinlock ((spinlock) &body body)
-  `(dx-flet ((with-spinlock-thunk () ,@body))
-     (call-with-spinlock
-      #'with-spinlock-thunk
-      ,spinlock)))
+              'call-with-recursive-system-lock))
+      #'with-recursive-system-lock-thunk
+       ,lock)))
 
 (macrolet ((def (name &optional variant)
              `(defun ,(if variant (symbolicate name "/" variant) name)
@@ -181,22 +192,6 @@ provided the default value is used for the mutex."
 
 #!-sb-thread
 (progn
-  (macrolet ((def (name &optional variant)
-               `(defun ,(if variant (symbolicate name "/" variant) name)
-                    (function lock)
-                  (declare (ignore lock) (function function))
-                  ,(ecase variant
-                    (:without-gcing
-                      `(without-gcing (funcall function)))
-                    (:allow-with-interrupts
-                      `(without-interrupts
-                         (allow-with-interrupts (funcall function))))
-                    ((nil)
-                      `(without-interrupts (funcall function)))))))
-    (def call-with-system-spinlock)
-    (def call-with-recursive-system-spinlock)
-    (def call-with-recursive-system-spinlock :without-gcing))
-
   (defun call-with-mutex (function mutex value waitp)
     (declare (ignore mutex value waitp)
              (function function))
@@ -206,65 +201,21 @@ provided the default value is used for the mutex."
     (declare (ignore mutex) (function function))
     (funcall function))
 
-  (defun call-with-spinlock (function spinlock)
-    (declare (ignore spinlock) (function function))
-    (funcall function))
+  (defun call-with-recursive-system-lock (function lock)
+    (declare (function function) (ignore lock))
+    (without-interrupts
+      (funcall function)))
 
-  (defun call-with-recursive-spinlock (function spinlock)
-    (declare (ignore spinlock) (function function))
-    (funcall function)))
+  (defun call-with-recursive-system-lock/without-gcing (function mutex)
+    (declare (function function) (ignore lock))
+    (without-gcing
+      (funcall function))))
 
 #!+sb-thread
 ;;; KLUDGE: These need to use DX-LET, because the cleanup form that
 ;;; closes over GOT-IT causes a value-cell to be allocated for it --
 ;;; and we prefer that to go on the stack since it can.
 (progn
-  (defun call-with-system-spinlock (function spinlock)
-    (declare (function function))
-    (without-interrupts
-      (dx-let (got-it)
-        (unwind-protect
-             (when (setf got-it (get-spinlock spinlock))
-               (funcall function))
-          (when got-it
-            (release-spinlock spinlock))))))
-
-  (macrolet ((def (name &optional variant)
-               `(defun ,(if variant (symbolicate name "/" variant) name)
-                    (function spinlock)
-                  (declare (function function))
-                  (flet ((%call-with-system-spinlock ()
-                           (dx-let ((inner-lock-p
-                                     (eq *current-thread*
-                                         (spinlock-value spinlock)))
-                                    (got-it nil))
-                             (unwind-protect
-                                  (when (or inner-lock-p
-                                            (setf got-it
-                                                  (get-spinlock spinlock)))
-                                    (funcall function))
-                               (when got-it
-                                 (release-spinlock spinlock))))))
-                    (declare (inline %call-with-system-spinlock))
-                    ,(ecase variant
-                      (:without-gcing
-                        `(without-gcing (%call-with-system-spinlock)))
-                      ((nil)
-                        `(without-interrupts (%call-with-system-spinlock))))))))
-    (def call-with-recursive-system-spinlock)
-    (def call-with-recursive-system-spinlock :without-gcing))
-
-  (defun call-with-spinlock (function spinlock)
-    (declare (function function))
-    (dx-let ((got-it nil))
-      (without-interrupts
-        (unwind-protect
-             (when (setf got-it (allow-with-interrupts
-                                 (get-spinlock spinlock)))
-               (with-local-interrupts (funcall function)))
-          (when got-it
-            (release-spinlock spinlock))))))
-
   (defun call-with-mutex (function mutex value waitp)
     (declare (function function))
     (dx-let ((got-it nil))
@@ -288,14 +239,25 @@ provided the default value is used for the mutex."
           (when got-it
             (release-mutex mutex))))))
 
-  (defun call-with-recursive-spinlock (function spinlock)
-    (declare (function function))
-    (dx-let ((inner-lock-p (eq (spinlock-value spinlock) *current-thread*))
-          (got-it nil))
-      (without-interrupts
-        (unwind-protect
-             (when (or inner-lock-p (setf got-it (allow-with-interrupts
-                                                  (get-spinlock spinlock))))
-               (with-local-interrupts (funcall function)))
-          (when got-it
-            (release-spinlock spinlock)))))))
+  (macrolet ((def (name &optional variant)
+               `(defun ,(if variant (symbolicate name "/" variant) name)
+                    (function lock)
+                  (declare (function function))
+                  (flet ((%call-with-recursive-system-lock ()
+                           (dx-let ((inner-lock-p
+                                     (eq *current-thread* (mutex-owner lock)))
+                                    (got-it nil))
+                             (unwind-protect
+                                  (when (or inner-lock-p
+                                            (setf got-it (grab-mutex lock)))
+                                    (funcall function))
+                               (when got-it
+                                 (release-mutex lock))))))
+                    (declare (inline %call-with-recursive-system-lock))
+                    ,(ecase variant
+                      (:without-gcing
+                        `(without-gcing (%call-with-recursive-system-lock)))
+                      ((nil)
+                        `(without-interrupts (%call-with-recursive-system-lock))))))))
+    (def call-with-recursive-system-lock)
+    (def call-with-recursive-system-lock :without-gcing)))
index 1b573bc..33b76a3 100644 (file)
@@ -2128,7 +2128,7 @@ bootstrapping.
       ((eq **boot-state** 'complete)
        ;; Check that we are under the lock.
        #+sb-thread
-       (aver (eq sb-thread:*current-thread* (sb-thread::spinlock-value (gf-lock gf))))
+       (aver (eq sb-thread:*current-thread* (sb-thread:mutex-owner (gf-lock gf))))
        (setf (safe-gf-dfun-state gf) new-state))
       (t
        (setf (clos-slots-ref (get-slots gf) +sgf-dfun-state-index+)
index e7e825d..f1e50b9 100644 (file)
     :accessor gf-dfun-state)
    ;; Used to make DFUN-STATE & FIN-FUNCTION updates atomic.
    (%lock
-    :initform (sb-thread::make-spinlock :name "GF lock")
+    :initform (sb-thread:make-mutex :name "GF lock")
     :reader gf-lock)
    ;; Set to true by ADD-METHOD, REMOVE-METHOD; to false by
    ;; MAYBE-UPDATE-INFO-FOR-GF.
index 86019d2..35e9fba 100644 (file)
@@ -1700,10 +1700,6 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
       ;; are part of this same code path (done while the lock is held),
       ;; which we AVER.
       ;;
-      ;; FIXME: When our mutexes are smart about the need to wake up
-      ;; sleepers we can put a mutex here instead -- but in the meantime
-      ;; we use a spinlock to avoid a syscall for every dfun update.
-      ;;
       ;; KLUDGE: No need to lock during bootstrap.
       (if early-p
           (update)
@@ -1712,7 +1708,7 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
             ;; where we can end up in a metacircular loop here? In
             ;; case there are, better fetch it while interrupts are
             ;; still enabled...
-            (sb-thread::call-with-recursive-system-spinlock #'update lock))))))
+            (sb-thread::call-with-recursive-system-lock #'update lock))))))
 \f
 (defvar *dfun-count* nil)
 (defvar *dfun-list* nil)
index 3c6b614..7efb80d 100644 (file)
           ;; System lock because interrupts need to be disabled as
           ;; well: it would be bad to unwind and leave the gf in an
           ;; inconsistent state.
-          (sb-thread::with-recursive-system-spinlock (lock)
+          (sb-thread::with-recursive-system-lock (lock)
             (let ((existing (get-method generic-function
                                         qualifiers
                                         specializers
       ;; System lock because interrupts need to be disabled as well:
       ;; it would be bad to unwind and leave the gf in an inconsistent
       ;; state.
-      (sb-thread::with-recursive-system-spinlock (lock)
+      (sb-thread::with-recursive-system-lock (lock)
         (let* ((specializers (method-specializers method))
                (methods (generic-function-methods generic-function))
                (new-methods (remove method methods)))
index 101a635..261dbbd 100644 (file)
 ;;; This needs to be used recursively, in case a non-trivial user
 ;;; defined ADD/REMOVE-DIRECT-METHOD method ends up calling another
 ;;; function using the same lock.
-(defvar *specializer-lock* (sb-thread::make-spinlock :name "Specializer lock"))
+(defvar *specializer-lock* (sb-thread:make-mutex :name "Specializer lock"))
 
 (defmethod add-direct-method :around ((specializer specializer) method)
   ;; All the actions done under this lock are done in an order
   ;; that is safe to unwind at any point.
-  (sb-thread::with-recursive-system-spinlock (*specializer-lock*)
+  (sb-thread::with-recursive-system-lock (*specializer-lock*)
     (call-next-method)))
 
 (defmethod remove-direct-method :around ((specializer specializer) method)
   ;; All the actions done under this lock are done in an order
   ;; that is safe to unwind at any point.
-  (sb-thread::with-recursive-system-spinlock (*specializer-lock*)
+  (sb-thread::with-recursive-system-lock (*specializer-lock*)
     (call-next-method)))
 
 (defmethod add-direct-method ((specializer class) (method method))
     ;; we behave as if we got just first or just after -- it's just
     ;; for update that we need to lock.
     (or (cdr cell)
-        (sb-thread::with-spinlock (*specializer-lock*)
+        (sb-thread:with-mutex (*specializer-lock*)
           (setf (cdr cell)
                 (let (collect)
                   (dolist (m (car cell))
          (entry (gethash object (specializer-method-table specializer))))
     (when entry
       (or (cdr entry)
-          (sb-thread::with-spinlock (*specializer-lock*)
+          (sb-thread:with-mutex (*specializer-lock*)
             (setf (cdr entry)
                   (let (collect)
                     (dolist (m (car entry))
index 6a000b4..db9882c 100644 (file)
 ;;; used.
 (defvar *pv-tables* (make-hash-table :test 'equal))
 
-;;; ...and one lock to rule them. Spinlock because for certain (rare)
+;;; ...and one lock to rule them. Lock because for certain (rare)
 ;;; cases this lock might be grabbed in the course of method dispatch
 ;;; -- and mostly this is already under the *world-lock*
 (defvar *pv-lock*
-  (sb-thread::make-spinlock :name "pv table index lock"))
+  (sb-thread:make-mutex :name "pv table index lock"))
 
 (defun intern-pv-table (&key slot-name-lists)
   (flet ((intern-slot-names (slot-names)
@@ -77,7 +77,7 @@
                                     :pv-size (* 2 (reduce #'+ snl
                                                           :key (lambda (slots)
                                                                  (length (cdr slots))))))))))
-    (sb-thread::with-spinlock (*pv-lock*)
+    (sb-thread:with-mutex (*pv-lock*)
       (%intern-pv-table (mapcar #'intern-slot-names slot-name-lists)))))
 \f
 (defun use-standard-slot-access-p (class slot-name type)
index 4e0b077..ab00e06 100644 (file)
   (gethash 5 *table*))
 
 ;; This fails on threaded PPC because the hash-table implementation
-;; uses recursive system spinlocks, which cons (see below for test
-;; (:no-consing :spinlock), which also fails on threaded PPC).
+;; uses recursive system locks, which cons (see below for test
+;; (:no-consing :lock), which also fails on threaded PPC).
 (with-test (:name (:no-consing :hash-tables) :fails-on '(and :ppc :sb-thread))
   (assert-no-consing (test-hash-table)))
 
-;;; with-spinlock and with-mutex should use DX and not cons
-
-(defvar *slock* (sb-thread::make-spinlock :name "slocklock"))
-
-(defun test-spinlock ()
-  (sb-thread::with-spinlock (*slock*)
-    (true *slock*)))
+;;; with-mutex should use DX and not cons
 
 (defvar *mutex* (sb-thread::make-mutex :name "mutexlock"))
 
 
 (with-test (:name (:no-consing :mutex) :fails-on :ppc :skipped-on '(not :sb-thread))
   (assert-no-consing (test-mutex)))
-
-(with-test (:name (:no-consing :spinlock) :fails-on :ppc :skipped-on '(not :sb-thread))
-  (assert-no-consing (test-spinlock)))
-
 \f
 
 ;;; Bugs found by Paul F. Dietz
index 9672f49..75bb628 100644 (file)
     (with-mutex (mutex)
       mutex)))
 
-(with-test (:name (:with-spinlock :basics))
-  (let ((spinlock (make-spinlock)))
-    (with-spinlock (spinlock))))
-
 (sb-alien:define-alien-routine "check_deferrables_blocked_or_lose"
     void
   (where sb-alien:unsigned-long))
 
 ;;;; Now the real tests...
 
-(with-test (:name (:interrupt-thread :deferrables-unblocked-by-spinlock))
-  (let ((spinlock (sb-thread::make-spinlock))
+(with-test (:name (:interrupt-thread :deferrables-unblocked-by-lock))
+  (let ((lock (sb-thread::make-mutex))
         (thread (sb-thread:make-thread (lambda ()
                                          (loop (sleep 1))))))
-    (sb-thread::get-spinlock spinlock)
+    (sb-thread::grab-mutex lock)
     (sb-thread:interrupt-thread thread
                                 (lambda ()
                                   (check-deferrables-blocked-or-lose 0)
-                                  (sb-thread::get-spinlock spinlock)
+                                  (sb-thread::grab-mutex lock)
                                   (check-deferrables-unblocked-or-lose 0)
                                   (sb-ext:quit)))
     (sleep 1)
-    (sb-thread::release-spinlock spinlock)))
+    (sb-thread::release-mutex lock)))
 
 ;;; compare-and-swap
 
         (assert (ours-p (mutex-value l)) nil "5"))
       (assert (eql (mutex-value l) nil) nil "6"))))
 
-(with-test (:name (:with-recursive-spinlock :basics))
-  (labels ((ours-p (value)
-             (eq *current-thread* value)))
-    (let ((l (make-spinlock :name "rec")))
-      (assert (eql (spinlock-value l) nil) nil "1")
-      (with-recursive-spinlock (l)
-        (assert (ours-p (spinlock-value l)) nil "3")
-        (with-recursive-spinlock (l)
-          (assert (ours-p (spinlock-value l)) nil "4"))
-        (assert (ours-p (spinlock-value l)) nil "5"))
-      (assert (eql (spinlock-value l) nil) nil "6"))))
-
 (with-test (:name (:mutex :nesting-mutex-and-recursive-lock))
   (let ((l (make-mutex :name "a mutex")))
     (with-mutex (l)
       (with-recursive-lock (l)))))
 
-(with-test (:name (:spinlock :nesting-spinlock-and-recursive-spinlock))
-  (let ((l (make-spinlock :name "a spinlock")))
-    (with-spinlock (l)
-      (with-recursive-spinlock (l)))))
-
-(with-test (:name (:spinlock :more-basics))
-  (let ((l (make-spinlock :name "spinlock")))
-    (assert (eql (spinlock-value l) nil) ((spinlock-value l))
-            "spinlock not free (1)")
-    (with-spinlock (l)
-      (assert (eql (spinlock-value l) *current-thread*) ((spinlock-value l))
-              "spinlock not taken"))
-    (assert (eql (spinlock-value l) nil) ((spinlock-value l))
-            "spinlock not free (2)")))
-
 ;; test that SLEEP actually sleeps for at least the given time, even
 ;; if interrupted by another thread exiting/a gc/anything
 (with-test (:name (:sleep :continue-sleeping-after-interrupt))
index c9db294..3d6d119 100644 (file)
       (release-mutex mutex))
     (assert (not (mutex-value mutex)))))
 
-(with-test (:name spinlock-owner)
-  ;; Make sure basics are sane on unithreaded ports as well
-  (let ((spinlock (sb-thread::make-spinlock)))
-    (sb-thread::get-spinlock spinlock)
-    (assert (eq *current-thread* (sb-thread::spinlock-value spinlock)))
-    (handler-bind ((warning #'error))
-      (sb-thread::release-spinlock spinlock))
-    (assert (not (sb-thread::spinlock-value spinlock)))))
-
 ;;; Terminating a thread that's waiting for the terminal.
 
 #+sb-thread
                     :deadlock))))
     (assert (eq :ok (join-thread t1)))))
 
-(with-test (:name deadlock-detection.4  :skipped-on '(not :sb-thread))
-  (loop
-    repeat 1000
-    do (flet ((test (ma mb sa sb)
-                (lambda ()
-                  (handler-case
-                      (sb-thread::with-spinlock (ma)
-                        (sb-thread:signal-semaphore sa)
-                        (sb-thread:wait-on-semaphore sb)
-                        (sb-thread::with-spinlock (mb)
-                          :ok))
-                    (sb-thread:thread-deadlock (e)
-                      (princ e)
-                      :deadlock)))))
-         (let* ((m1 (sb-thread::make-spinlock :name "M1"))
-                (m2 (sb-thread::make-spinlock :name "M2"))
-                (s1 (sb-thread:make-semaphore :name "S1"))
-                (s2 (sb-thread:make-semaphore :name "S2"))
-                (t1 (sb-thread:make-thread (test m1 m2 s1 s2) :name "T1"))
-                (t2 (sb-thread:make-thread (test m2 m1 s2 s1) :name "T2")))
-           ;; One will deadlock, and the other will then complete normally
-           ;; ...except sometimes, when we get unlucky, and both will do
-           ;; the deadlock detection in parallel and both signal.
-           (let ((res (list (sb-thread:join-thread t1)
-                            (sb-thread:join-thread t2))))
-             (assert (or (equal '(:deadlock :ok) res)
-                         (equal '(:ok :deadlock) res)
-                         (equal '(:deadlock :deadlock) res))))))))
-
-(with-test (:name deadlock-detection.5 :skipped-on '(not :sb-thread))
-  (let* ((m1 (sb-thread::make-spinlock :name "M1"))
-         (m2 (sb-thread::make-spinlock :name "M2"))
-         (s1 (sb-thread:make-semaphore :name "S1"))
-         (s2 (sb-thread:make-semaphore :name "S2"))
-         (t1 (sb-thread:make-thread
-              (lambda ()
-                (sb-thread::with-spinlock (m1)
-                  (sb-thread:signal-semaphore s1)
-                  (sb-thread:wait-on-semaphore s2)
-                  (sb-thread::with-spinlock (m2)
-                    :ok)))
-              :name "T1")))
-    (prog (err)
-     :retry
-       (handler-bind ((sb-thread:thread-deadlock
-                       (lambda (e)
-                         (unless err
-                           ;; Make sure we can print the condition
-                           ;; while it's active
-                           (let ((*print-circle* nil))
-                             (setf err (princ-to-string e)))
-                           (go :retry)))))
-         (when err
-           (sleep 1))
-         (assert (eq :ok (sb-thread::with-spinlock (m2)
-                           (unless err
-                             (sb-thread:signal-semaphore s2)
-                             (sb-thread:wait-on-semaphore s1)
-                             (sleep 1))
-                           (sb-thread::with-spinlock (m1)
-                             :ok)))))
-       (assert (stringp err)))
-    (assert (eq :ok (sb-thread:join-thread t1)))))
-
-(with-test (:name deadlock-detection.7 :skipped-on '(not :sb-thread))
-  (let* ((m1 (sb-thread::make-spinlock :name "M1"))
-         (m2 (sb-thread::make-spinlock :name "M2"))
-         (s1 (sb-thread:make-semaphore :name "S1"))
-         (s2 (sb-thread:make-semaphore :name "S2"))
-         (t1 (sb-thread:make-thread
-              (lambda ()
-                (sb-thread::with-spinlock (m1)
-                  (sb-thread:signal-semaphore s1)
-                  (sb-thread:wait-on-semaphore s2)
-                  (sb-thread::with-spinlock (m2)
-                    :ok)))
-              :name "T1")))
-    (assert (eq :deadlock
-                (handler-case
-                    (sb-thread::with-spinlock (m2)
-                      (sb-thread:signal-semaphore s2)
-                      (sb-thread:wait-on-semaphore s1)
-                      (sleep 1)
-                      (sb-sys:with-deadline (:seconds 0.1)
-                        (sb-thread::with-spinlock (m1)
-                          :ok)))
-                  (sb-sys:deadline-timeout ()
-                    :deadline)
-                  (sb-thread:thread-deadlock ()
-                    :deadlock))))
-    (assert (eq :ok (join-thread t1)))))
-
 #+sb-thread
 (with-test (:name :pass-arguments-to-thread)
   (assert (= 3 (join-thread (make-thread #'+ :arguments '(1 2))))))