1.0.10.51: New function: THREAD-YIELD

An interface to sched_yield().  And use it in busy loops in some tests.

diff --git a/doc/manual/threading.texinfo b/doc/manual/threading.texinfo
index 7e84de5..57eaf58 100644 (file)
--- a/doc/manual/threading.texinfo
+++ b/doc/manual/threading.texinfo
@@ -43,6 +43,7 @@ threading on Darwin (Mac OS X) and FreeBSD on the x86 is experimental.
 @include fun-sb-thread-interrupt-thread-error-thread.texinfo
 @include fun-sb-thread-interrupt-thread.texinfo
 @include fun-sb-thread-terminate-thread.texinfo
+@include fun-sb-thread-thread-yield.texinfo
 
 @node Special Variables
 @comment  node-name,  next,  previous,  up

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index a74cd99..c93e2c4 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1691,6 +1691,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
                "INTERRUPT-THREAD-ERROR"
                "INTERRUPT-THREAD-ERROR-THREAD"
                "INTERRUPT-THREAD" "TERMINATE-THREAD" "DESTROY-THREAD"
+               "THREAD-YIELD"
                "MUTEX" "MAKE-MUTEX" "MUTEX-NAME" "MUTEX-VALUE"
                "GET-MUTEX" "RELEASE-MUTEX" "WITH-MUTEX"
                "WITH-RECURSIVE-LOCK"

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 38549a3..b60ce71 100644 (file)
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -844,6 +844,12 @@ SB-EXT:QUIT - the usual cleanup forms will be evaluated"
              (sap-ref-sap thread-sap (* sb!vm:n-word-bytes
                                         sb!vm::thread-next-slot)))))))
 
+(define-alien-routine "thread_yield" int)
+
+#!+sb-doc
+(setf (fdocumentation 'thread-yield 'function)
+      "Yield the processor to other threads.")
+
 #!+sb-thread
 (defun symbol-value-in-thread (symbol thread-sap)
   (let* ((index (sb!vm::symbol-tls-index symbol))

diff --git a/src/runtime/thread.c b/src/runtime/thread.c
index 9044dfd..d38fd72 100644 (file)
--- a/src/runtime/thread.c
+++ b/src/runtime/thread.c
@@ -729,3 +729,13 @@ void gc_start_the_world()
     FSHOW_SIGNAL((stderr,"/gc_start_the_world:end\n"));
 }
 #endif
+
+int
+thread_yield()
+{
+#ifdef LISP_FEATURE_SB_THREAD
+    return sched_yield();
+#else
+    return 0;
+#endif
+}

diff --git a/tests/clos-add-remove-method.impure.lisp b/tests/clos-add-remove-method.impure.lisp
index 6d09340..b4ac601 100644 (file)
--- a/tests/clos-add-remove-method.impure.lisp
+++ b/tests/clos-add-remove-method.impure.lisp
@@ -77,12 +77,12 @@
 (defvar *run* nil)
 
 (defun remove-methods (list)
-  (loop until *run*)
+  (loop until *run* do (sb-thread:thread-yield))
   (dolist (method list)
     (remove-method #'foo method)))
 
 (defun add-methods (list)
-  (loop until *run*)
+  (loop until *run* do (sb-thread:thread-yield))
   (dolist (method list)
     (add-method #'foo method)))
 

diff --git a/tests/clos-cache.impure.lisp b/tests/clos-cache.impure.lisp
index 4959a3f..c3e07d6 100644 (file)
--- a/tests/clos-cache.impure.lisp
+++ b/tests/clos-cache.impure.lisp
@@ -65,7 +65,7 @@
 
 (defun test-loop ()
   (note "/~S waiting for permission to run" sb-thread:*current-thread*)
-  (loop until *run-cache-test*)
+  (loop until *run-cache-test* do (sb-thread:thread-yield))
   (note "/~S joining the thundering herd" sb-thread:*current-thread*)
   (handler-case
       (loop repeat 1024 do (test-cache))

diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp
index 867f408..c68b615 100644 (file)
--- a/tests/threads.impure.lisp
+++ b/tests/threads.impure.lisp
@@ -73,7 +73,8 @@
                (loop repeat 10
                      collect (sb-thread:make-thread
                               (lambda ()
-                                (loop until run)
+                                (loop until run
+                                   do (sb-thread:thread-yield))
                                 (loop repeat n do (,incf x)))))))
          (setf run t)
          (dolist (th threads)

diff --git a/version.lisp-expr b/version.lisp-expr
index 02d1ab1..f1a6863 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.10.50"
+"1.0.10.51"