1.0.25.45: fix futex_wait deadlines when interrupted

When the syscall returned with EINTR futex_wait called again with the
same timeout. Now it lets Lisp recalculate the relative timeout from
the deadline.

diff --git a/NEWS b/NEWS
index fdce7b6..c3511f3 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -35,6 +35,7 @@ changes in sbcl-1.0.26 relative to 1.0.25:
   * bug fix: finalizers, gc hooks never run in a WITHOUT-INTERRUPTS
   * bug fix: fix random memory faults related to interrupts on alpha
   * bug fix: fix deadlocks related to starting threads
+  * bug fix: fix deadlines on locks on futex platforms
 
 changes in sbcl-1.0.25 relative to 1.0.24:
   * incompatible change: SB-INTROSPECT:FUNCTION-ARGLIST is deprecated, to be

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 87ba3b8..2d02713 100644 (file)
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -342,13 +342,16 @@ directly."
                                                         +lock-taken+
                                                         +lock-contested+))))
              ;; Wait on the contested lock.
-             (multiple-value-bind (to-sec to-usec) (decode-timeout nil)
-               (when (= 1 (with-pinned-objects (mutex)
-                            (futex-wait (mutex-state-address mutex)
-                                        (get-lisp-obj-address +lock-contested+)
-                                        (or to-sec -1)
-                                        (or to-usec 0))))
-                 (signal-deadline))))
+             (loop
+              (multiple-value-bind (to-sec to-usec) (decode-timeout nil)
+                (case (with-pinned-objects (mutex)
+                        (futex-wait (mutex-state-address mutex)
+                                    (get-lisp-obj-address +lock-contested+)
+                                    (or to-sec -1)
+                                    (or to-usec 0)))
+                  ((1) (signal-deadline))
+                  ((2))
+                  (otherwise (return))))))
            (setf old (sb!ext:compare-and-swap (mutex-state mutex)
                                               +lock-free+
                                               +lock-contested+))
@@ -472,16 +475,19 @@ time we reacquire MUTEX and return to the caller."
              ;; futex-wait returns immediately instead of sleeping.
              ;; Ergo, no lost wakeup. We may get spurious wakeups, but
              ;; that's ok.
-             (multiple-value-bind (to-sec to-usec) (decode-timeout nil)
-               (when (= 1 (with-pinned-objects (queue me)
-                            (allow-with-interrupts
-                              (futex-wait (waitqueue-data-address queue)
-                                          (get-lisp-obj-address me)
-                                          ;; our way if saying "no
-                                          ;; timeout":
-                                          (or to-sec -1)
-                                          (or to-usec 0)))))
-                 (signal-deadline))))
+             (loop
+              (multiple-value-bind (to-sec to-usec) (decode-timeout nil)
+                (case (with-pinned-objects (queue me)
+                        (allow-with-interrupts
+                          (futex-wait (waitqueue-data-address queue)
+                                      (get-lisp-obj-address me)
+                                      ;; our way if saying "no
+                                      ;; timeout":
+                                      (or to-sec -1)
+                                      (or to-usec 0))))
+                  ((1) (signal-deadline))
+                  ((2))
+                  (otherwise (return))))))
         ;; If we are interrupted while waiting, we should do these
         ;; things before returning. Ideally, in the case of an
         ;; unhandled signal, we should do them before entering the

diff --git a/src/runtime/bsd-os.c b/src/runtime/bsd-os.c
index 794e98a..3d06aa3 100644 (file)
--- a/src/runtime/bsd-os.c
+++ b/src/runtime/bsd-os.c
@@ -414,7 +414,6 @@ futex_wait(int *lock_word, long oldval, long sec, unsigned long usec)
     struct timespec timeout;
     int ret;
 
-again:
     if (sec < 0)
         ret = umtx_wait((void *)lock_word, oldval, NULL);
     else {
@@ -429,8 +428,7 @@ again:
     case ETIMEDOUT:
         return 1;
     case EINTR:
-        /* spurious wakeup from interrupt */
-        goto again;
+        return 2;
     default:
         /* EWOULDBLOCK and others, need to check the lock */
         return -1;

diff --git a/src/runtime/linux-os.c b/src/runtime/linux-os.c
index 62a482b..d273b13 100644 (file)
--- a/src/runtime/linux-os.c
+++ b/src/runtime/linux-os.c
@@ -89,7 +89,6 @@ futex_wait(int *lock_word, int oldval, long sec, unsigned long usec)
   struct timespec timeout;
   int t;
 
- again:
   if (sec<0) {
     t = sys_futex(lock_word,FUTEX_WAIT,oldval, 0);
   }
@@ -103,8 +102,7 @@ futex_wait(int *lock_word, int oldval, long sec, unsigned long usec)
   else if (errno==ETIMEDOUT)
       return 1;
   else if (errno==EINTR)
-      /* spurious wakeup from interrupt */
-      goto again;
+      return 2;
   else
       /* EWOULDBLOCK and others, need to check the lock */
       return -1;

diff --git a/tests/deadline.impure.lisp b/tests/deadline.impure.lisp
index 5d24ec9..10bae09 100644 (file)
--- a/tests/deadline.impure.lisp
+++ b/tests/deadline.impure.lisp
@@ -60,4 +60,30 @@
   (assert-timeout
    (sb-impl::with-deadline (:seconds 1)
      (sb-thread:join-thread
-      (sb-thread:make-thread (lambda () (loop (sleep 1))))))))
+      (sb-thread:make-thread (lambda () (loop (sleep 1)))))))
+
+  (with-test (:name (:deadline :futex-wait-eintr))
+    (let ((lock (sb-thread:make-mutex))
+          (waitp t))
+      (sb-thread:make-thread (lambda ()
+                               (sb-thread:get-mutex lock)
+                               (setf waitp nil)
+                               (sleep 5)))
+      (loop while waitp do (sleep 0.01))
+      (let ((thread (sb-thread:make-thread
+                     (lambda ()
+                       (let ((start (get-internal-real-time)))
+                         (handler-case
+                             (sb-impl::with-deadline (:seconds 1)
+                               (sb-thread:get-mutex lock))
+                           (sb-sys:deadline-timeout (x)
+                             (declare (ignore x))
+                             (let ((end (get-internal-real-time)))
+                               (float (/ (- end start)
+                                         internal-time-units-per-second)
+                                      0.0)))))))))
+        (sleep 0.3)
+        (sb-thread:interrupt-thread thread (lambda () 42))
+        (let ((seconds-passed (sb-thread:join-thread thread)))
+          (format t "Deadline in ~S~%" seconds-passed)
+          (assert (< seconds-passed 1.2)))))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 16d3626..4bbaf0c 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.25.44"
+"1.0.25.45"