Use wait-on-semaphore in lieu of spin loops

Author: snuglas

contrib/sb-concurrency/tests/test-frlock.lisp

@@ -26,7 +26,7 @@
           (a 0)
           (b 0)
           (c 0)
-          (run! nil)
+          (run! (sb-thread:make-semaphore))
           (w-e! (cons :write-oops nil))
           (r-e! (cons :read-oops nil)))
       (flet ((maybe-pause (pause &optional value)
@@ -41,7 +41,7 @@
                     collect
                        (make-thread
                         (lambda ()
-                          (loop until run! do (thread-yield))
+                          (sb-thread:wait-on-semaphore run!)
                           (handler-case
                               (loop repeat read-count
                                     do (multiple-value-bind (a b c)
@@ -56,7 +56,7 @@
               (loop repeat writer-count
                     collect (make-thread
                              (lambda ()
-                               (loop until run! do (thread-yield))
+                               (sb-thread:wait-on-semaphore run!)
                                (handler-case
                                    (loop repeat write-count
                                          do (frlock-write (rw)
@@ -76,7 +76,7 @@
                                  (error (e)
                                    (sb-ext:atomic-update (cdr w-e!) #'cons e))))))
               (progn
-                (setf run! t)
+                (sb-thread:signal-semaphore run! (+ reader-count writer-count))
                 nil))))
       (values (cdr w-e!) (cdr r-e!))))
 

tests/clos-add-remove-method.impure.lisp

@@ -129,15 +129,15 @@
                 ,@(to-add 'f))))
   (def))
 
-(defvar *run* nil)
+(defvar *run* (sb-thread:make-semaphore))
 
 (defun remove-methods (list)
-  (loop until *run* do (sb-thread:thread-yield))
+  (sb-thread:wait-on-semaphore *run*)
   (dolist (method list)
     (remove-method #'foo method)))
 
 (defun add-methods (list)
-  (loop until *run* do (sb-thread:thread-yield))
+  (sb-thread:wait-on-semaphore *run*)
   (dolist (method list)
     (add-method #'foo method)))
 
@@ -148,7 +148,7 @@
                      (make-thread (lambda () (add-methods *to-add-d*)))
                      (make-thread (lambda () (add-methods *to-add-e*)))
                      (make-thread (lambda () (add-methods *to-add-f*))))))
-  (setf *run* t)
+  (sb-thread:signal-semaphore *run* 6)
   (mapcar #'join-thread threads))
 
 #-sb-thread

tests/clos-cache.impure.lisp

@@ -68,7 +68,7 @@
                              (push (find-class ',c) *cache-test-classes*)))))))
   (def))
 
-(defvar *run-cache-test* nil)
+(defvar *run-cache-test* (sb-thread:make-semaphore))
 
 (let* ((instances (map 'vector #'make-instance *cache-test-classes*))
        (limit (length instances)))
@@ -90,7 +90,7 @@
         (write-line string)))))
 
 (defun test-loop ()
-  (loop until *run-cache-test* do (sb-thread:thread-yield))
+  (sb-thread:wait-on-semaphore *run-cache-test*)
   (handler-case
       (loop repeat 1024 do (test-cache))
     (error (e)
@@ -103,7 +103,7 @@
   #+sb-thread
   (let ((threads (loop repeat 32
                        collect (sb-thread:make-thread 'test-loop))))
-    (setf *run-cache-test* t)
+    (sb-thread:signal-semaphore *run-cache-test* 32)
     (mapcar #'sb-thread:join-thread threads))
 
   #-sb-thread

tests/threads.impure.lisp

@@ -112,16 +112,17 @@
        `(with-test (:name ,name)
           (let* ((n 200000)
                  (x ,init)
-                 (run nil)
+                 (run (sb-thread:make-semaphore))
+                 (threadcount 10)
                  (threads
-                  (loop repeat 10
+                  (loop repeat threadcount
                         collect (make-thread
                                  (lambda ()
-                                   (loop until run do (thread-yield))
+                                   (sb-thread:wait-on-semaphore run)
                                    (loop repeat n do (,incf x)))))))
-            (setf run t)
+            (sb-thread:signal-semaphore run threadcount)
             (map nil #'join-thread threads)
-            (assert (= (,op x) (* 10 n)))))))
+            (assert (= (,op x) (* threadcount n)))))))
 
   (def (cas car) (cons 0 nil) incf-car car)
   (def (cas cdr) (cons nil 0) incf-cdr cdr)