1.0.37.33: Add SB-THREAD:GRAB-MUTEX.

  * I unintentionally comitted the bulk of what was supposed to become
    this commit with 1.0.37.31. Sorry.

  * SB-THREAD:GRAB-MUTEX is like GET-MUTEX except it takes &key, not
    &optional parameters.

  * Also add a :TIMEOUT key parameter on non-lutex platforms.

  * Tests included. News updated. Phew.

diff --git a/NEWS b/NEWS
index 3dcd723..19e4cde 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,11 +1,17 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
 changes relative to sbcl-1.0.36:
-  * INCOMPATIBLE CHANGE: the SB-QUEUE contrib was merged into the
-    SB-CONCURRENCY contrib module.
+  * DEPRECIATION: the SB-QUEUE contrib was merged into the SB-CONCURRENCY
+    contrib module. New code should depend on SB-CONCURRENCY, not SB-QUEUE.
+  * DEPRECIATION: SB-THEAD:GET-MUTEX was deprecated in favor of
+    SB-THREAD:GRAB-MUTEX.
   * new contrib: SB-CONCURRENCY is a new contrib; it's supposed to contain
     additional data structures and tools for concurrent programming; at the
     moment it contains a lock-free queue, and a lock-free mailbox
     implementation.
+  * new feature: added SB-THREAD:GRAB-MUTEX; it's like the now deprecated
+    GET-MUTEX but takes &key rather than &optional parameters.  Also added
+    :TIMEOUT argument to GRAB-MUTEX on non-sb-lutex platforms like Linux and
+    BSD.
   * new feature: added SB-THREAD:TRY-SEMAPHORE, a non-blocking variant of
     SB-THREAD:WAIT-ON-SEMAPHORE.
   * new feature: SB-EXT:ATOMIC-DECF has been added as a companion to

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 1d66239..9ce98a5 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1929,6 +1929,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
                "THREAD-YIELD"
                ;; Mutexes
                "GET-MUTEX"
+               "GRAB-MUTEX"
                "HOLDING-MUTEX-P"
                "MAKE-MUTEX"
                "MUTEX"

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 422ee96..47d07d2 100644 (file)
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -468,19 +468,19 @@ Notes:
     ALLOW-WITH-INTERRUPTS allows the call to be interrupted from
     sleep.
 
-   - The TIMEOUT parameter is currently only supported on non-SB-LUTEX
-     platforms like Linux or BSD.
+  - The TIMEOUT parameter is currently only supported on non-SB-LUTEX
+    platforms like Linux or BSD.
 
-   - (GRAB-MUTEX <mutex> :timeout 0.0) differs from
-     (GRAB-MUTEX <mutex> :waitp nil) in that the former may signal a
-     DEADLINE-TIMEOUT if the global deadline was due already on
-     entering GRAB-MUTEX.
+  - (GRAB-MUTEX <mutex> :timeout 0.0) differs from
+    (GRAB-MUTEX <mutex> :waitp nil) in that the former may signal a
+    DEADLINE-TIMEOUT if the global deadline was due already on
+    entering GRAB-MUTEX.
 
-     The exact interplay of GRAB-MUTEX and deadlines are reserved to
-     change in future versions.
+    The exact interplay of GRAB-MUTEX and deadlines are reserved to
+    change in future versions.
 
-   - It is recommended that you use WITH-MUTEX instead of calling
-     GRAB-MUTEX directly.
+  - It is recommended that you use WITH-MUTEX instead of calling
+    GRAB-MUTEX directly.
 "
   (get-mutex mutex new-owner waitp timeout))
 

diff --git a/src/code/thread.lisp b/src/code/thread.lisp
index 887ef3e..7a2e567 100644 (file)
--- a/src/code/thread.lisp
+++ b/src/code/thread.lisp
@@ -21,7 +21,6 @@ in future versions."
   (name          nil :type (or thread-name null))
   (%alive-p      nil :type boolean)
   (os-thread     nil :type (or integer null))
-  (whostate      nil :type (or null simple-string))
   (interruptions nil :type list)
   (result        nil :type list)
   (interruptions-lock

diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp
index 6df83ca..21422d7 100644 (file)
--- a/tests/threads.impure.lisp
+++ b/tests/threads.impure.lisp
@@ -126,7 +126,7 @@
                 (setf run t)
                 (dolist (th threads)
                   (sb-thread:join-thread th))
-                (assert (= (,op x) (* 10 n))))))       
+                (assert (= (,op x) (* 10 n))))))
        (,name 200000))))
 
 (def-test-cas test-cas-car (cons 0 nil) incf-car car)
@@ -336,6 +336,54 @@
         (format t "contention ~A ~A~%" kid1 kid2)
         (wait-for-threads (list kid1 kid2))))))
 
+;;; GRAB-MUTEX
+
+(with-test (:name (:grab-mutex :waitp nil))
+  (let ((m (make-mutex)))
+    (with-mutex (m)
+      (assert (null (join-thread (make-thread
+                                  #'(lambda ()
+                                      (grab-mutex m :waitp nil)))))))))
+
+(with-test (:name (:grab-mutex :timeout :acquisition-fail))
+  (let ((m (make-mutex)))
+    (with-mutex (m)
+      (assert (null (join-thread (make-thread
+                                  #'(lambda ()
+                                      (grab-mutex m :timeout 0.1)))))))))
+
+(with-test (:name (:grab-mutex :timeout :acquisition-success))
+  (let ((m (make-mutex))
+        (child))
+    (with-mutex (m)
+      (setq child (make-thread #'(lambda () (grab-mutex m :timeout 1.0))))
+      (sleep 0.2))
+    (assert (eq (join-thread child) 't))))
+
+(with-test (:name (:grab-mutex :timeout+deadline))
+  (let ((m (make-mutex)))
+    (with-mutex (m)
+      (assert (eq (join-thread
+                   (make-thread #'(lambda ()
+                                    (sb-sys:with-deadline (:seconds 0.0)
+                                      (handler-case
+                                          (grab-mutex m :timeout 0.0)
+                                        (sb-sys:deadline-timeout ()
+                                          :deadline))))))
+                  :deadline)))))
+
+(with-test (:name (:grab-mutex :waitp+deadline))
+  (let ((m (make-mutex)))
+    (with-mutex (m)
+      (assert (eq (join-thread
+                   (make-thread #'(lambda ()
+                                    (sb-sys:with-deadline (:seconds 0.0)
+                                      (handler-case
+                                          (grab-mutex m :waitp nil)
+                                        (sb-sys:deadline-timeout ()
+                                          :deadline))))))
+                  'nil)))))
+
 ;;; semaphores
 
 (defmacro raises-timeout-p (&body body)

diff --git a/version.lisp-expr b/version.lisp-expr
index 01bc7b4..a21d614 100644 (file)
--- 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".)
-"1.0.37.32"
+"1.0.37.33"