Fix test-select-registry to "atomically" unmask interrupts.

When SMPing the machine cannot miss e.g a global-GC interrupt, else
the whole world grinds to a halt.  Using (set-interrupt-enables!
interrupt-mask/all) and then (test-select-registry ... #t) admits a
small "hole" wherein such an interrupt can drop, allowing the machine
to block without realizing it missed an interrupt intended to wake it.

The test-select-registry primitive does not actually "atomically
unmask interrupts" but simply ignores the mask inside its critical
section -- as if the mask was interrupt-mask/all.

Adjust branches so that, when not blocking, the simpler poll/select is
called (rather than ppoll/pselect).

Eliminate loops that re-try after masked interrupts arrive since all
interrupts are considered unmasked here.

diff --git a/src/microcode/uxio.c b/src/microcode/uxio.c
index 8bbb260bc939d9fc66c290c00f442f1031e6c946..d132d8a6385c102e5b14e1348c5b1d6965a6cc37 100644 (file)
--- a/src/microcode/uxio.c
+++ b/src/microcode/uxio.c
@@ -554,19 +554,27 @@ safe_poll (struct pollfd *fds, nfds_t nfds, int blockp)
 {
   int n;
 
-#ifdef HAVE_PPOLL
   if (!blockp)
     {
-      n = (UX_poll (fds, nfds, 0));
+      if ((OS_process_any_status_change ()))
+       {
+         errno = EINTR;
+         n = -1;
+       }
+      else
+       {
+         n = (UX_poll (fds, nfds, 0));
+       }
     }
   else
+#ifdef HAVE_PPOLL
     {
       sigset_t old, new;
 
       UX_sigfillset (&new);
       UX_sigprocmask (SIG_SETMASK, &new, &old);
       if ((OS_process_any_status_change ())
-         || (pending_interrupts_p ()))
+         || ((GET_INT_CODE) != 0))
        {
          errno = EINTR;
          n = -1;
@@ -578,12 +586,13 @@ safe_poll (struct pollfd *fds, nfds_t nfds, int blockp)
       UX_sigprocmask (SIG_SETMASK, &old, NULL);
     }
 #else /* not HAVE_PPOLL */
-  /* There is a signal "hole" here, but what can we do without ppoll()? */
-  INTERRUPTABLE_EXTENT
-    (n, (((OS_process_any_status_change ())
-         || (pending_interrupts_p ()))
-        ? ((errno = EINTR), (-1))
-        : (UX_poll (fds, nfds, (blockp ? INFTIM : 0)))));
+    {
+      INTERRUPTABLE_EXTENT
+       (n, (((OS_process_any_status_change ())
+             || ((GET_INT_CODE) != 0))
+            ? ((errno = EINTR), (-1))
+            : (UX_poll (fds, nfds, (blockp ? INFTIM : 0)))));
+    }
 #endif
 
   return (n);
@@ -592,41 +601,37 @@ safe_poll (struct pollfd *fds, nfds_t nfds, int blockp)
 int
 OS_test_select_registry (select_registry_t registry, int blockp)
 {
+  int nfds;
   struct select_registry_s * r = registry;
-  while (1)
-    {
-      int nfds = (safe_poll ((SR_ENTRIES (r)), (SR_N_FDS (r)), blockp));
-      if (nfds >= 0)
-       return (nfds);
-      if (errno != EINTR)
-       error_system_call (errno, syscall_select);
-      if (OS_process_any_status_change ())
-       return (SELECT_PROCESS_STATUS_CHANGE);
-      if (pending_interrupts_p ())
-       return (SELECT_INTERRUPT);
-    }
+
+  nfds = (safe_poll ((SR_ENTRIES (r)), (SR_N_FDS (r)), blockp));
+  if (nfds >= 0)
+    return (nfds);
+  if (errno != EINTR)
+    error_system_call (errno, syscall_select);
+  if (OS_process_any_status_change ())
+    return (SELECT_PROCESS_STATUS_CHANGE);
+  return (SELECT_INTERRUPT);
 }
 
 int
 OS_test_select_descriptor (int fd, int blockp, unsigned int mode)
 {
+  int nfds;
   struct pollfd pfds [1];
   ((pfds [0]) . fd) = fd;
   ((pfds [0]) . events) = (DECODE_MODE (mode));
-  while (1)
-    {
-      int nfds = (safe_poll (pfds, 1, blockp));
-      if (nfds > 0)
-       return (ENCODE_MODE ((pfds [0]) . revents));
-      if (nfds == 0)
-       return (0);
-      if (errno != EINTR)
-       error_system_call (errno, syscall_select);
-      if (OS_process_any_status_change ())
-       return (SELECT_PROCESS_STATUS_CHANGE);
-      if (pending_interrupts_p ())
-       return (SELECT_INTERRUPT);
-    }
+
+  nfds = (safe_poll (pfds, 1, blockp));
+  if (nfds > 0)
+    return (ENCODE_MODE ((pfds [0]) . revents));
+  if (nfds == 0)
+    return (0);
+  if (errno != EINTR)
+    error_system_call (errno, syscall_select);
+  if (OS_process_any_status_change ())
+    return (SELECT_PROCESS_STATUS_CHANGE);
+  return (SELECT_INTERRUPT);
 }
 
 #else /* not HAVE_POLL */
@@ -748,19 +753,27 @@ safe_select (int nfds, SELECT_TYPE *readfds, SELECT_TYPE *writefds, int blockp)
 {
   int n;
 
-#ifdef HAVE_PSELECT
   if (!blockp)
     {
-      n = (UX_select (nfds, readfds, writefds, NULL, &zero_timeout));
+      if ((OS_process_any_status_change ()))
+       {
+         errno = EINTR;
+         n = -1;
+       }
+      else
+       {
+         n = (UX_select (nfds, readfds, writefds, NULL, &zero_timeout));
+       }
     }
   else
+#ifdef HAVE_PSELECT
     {
       sigset_t old, new;
 
       UX_sigfillset (&new);
       UX_sigprocmask (SIG_SETMASK, &new, &old);
       if ((OS_process_any_status_change ())
-         || (pending_interrupts_p ()))
+         || ((GET_INT_CODE) != 0))
        {
          errno = EINTR;
          n = -1;
@@ -772,13 +785,14 @@ safe_select (int nfds, SELECT_TYPE *readfds, SELECT_TYPE *writefds, int blockp)
       UX_sigprocmask (SIG_SETMASK, &old, NULL);
     }
 #else /* not HAVE_PSELECT */
-  /* There is a signal "hole" here, but what can we do without pselect()? */
-  INTERRUPTABLE_EXTENT
-    (n, (((OS_process_any_status_change ())
-         || (pending_interrupts_p ()))
-        ? ((errno = EINTR), (-1))
-        : (UX_select (nfds, readfds, writefds, NULL,
-                      (blockp ? NULL : &zero_timeout)))));
+    {
+      INTERRUPTABLE_EXTENT
+       (n, (((OS_process_any_status_change ())
+             || ((GET_INT_CODE) != 0))
+            ? ((errno = EINTR), (-1))
+            : (UX_select (nfds, readfds, writefds, NULL,
+                          (blockp ? NULL : &zero_timeout)))));
+    }
 #endif
 
   return (n);
@@ -788,25 +802,22 @@ int
 OS_test_select_registry (select_registry_t registry, int blockp)
 {
 #ifdef HAVE_SELECT
+  int nfds;
   struct select_registry_s * r = registry;
 
   (* (SR_RREADERS (r))) = (* (SR_QREADERS (r)));
   (* (SR_RWRITERS (r))) = (* (SR_QWRITERS (r)));
-  while (1)
-    {
-      int nfds = (safe_select (FD_SETSIZE,
-                              (SR_RREADERS (r)),
-                              (SR_RWRITERS (r)),
-                              blockp));
-      if (nfds >= 0)
-       return (nfds);
-      if (errno != EINTR)
-       error_system_call (errno, syscall_select);
-      if (OS_process_any_status_change ())
-       return (SELECT_PROCESS_STATUS_CHANGE);
-      if (pending_interrupts_p ())
-       return (SELECT_INTERRUPT);
-    }
+  nfds = (safe_select (FD_SETSIZE,
+                      (SR_RREADERS (r)),
+                      (SR_RWRITERS (r)),
+                      blockp));
+  if (nfds >= 0)
+    return (nfds);
+  if (errno != EINTR)
+    error_system_call (errno, syscall_select);
+  if (OS_process_any_status_change ())
+    return (SELECT_PROCESS_STATUS_CHANGE);
+  return (SELECT_INTERRUPT);
 #else
   error_system_call (ENOSYS, syscall_select);
   return (1);
@@ -817,6 +828,7 @@ int
 OS_test_select_descriptor (int fd, int blockp, unsigned int mode)
 {
 #ifdef HAVE_SELECT
+  int nfds;
   SELECT_TYPE readable;
   SELECT_TYPE writeable;
 
@@ -828,22 +840,18 @@ OS_test_select_descriptor (int fd, int blockp, unsigned int mode)
   if ((mode & SELECT_MODE_WRITE) != 0)
     FD_SET (fd, (&writeable));
 
-  while (1)
-    {
-      int nfds = (safe_select (fd + 1, &readable, &writeable, blockp));
-      if (nfds > 0)
-       return
-         (((FD_ISSET (fd, (&readable))) ? SELECT_MODE_READ : 0)
-          | ((FD_ISSET (fd, (&writeable))) ? SELECT_MODE_WRITE : 0));
-      if (nfds == 0)
-       return (0);
-      if (errno != EINTR)
-       error_system_call (errno, syscall_select);
-      if (OS_process_any_status_change ())
-       return (SELECT_PROCESS_STATUS_CHANGE);
-      if (pending_interrupts_p ())
-       return (SELECT_INTERRUPT);
-    }
+  nfds = (safe_select (fd + 1, &readable, &writeable, blockp));
+  if (nfds > 0)
+    return
+      (((FD_ISSET (fd, (&readable))) ? SELECT_MODE_READ : 0)
+       | ((FD_ISSET (fd, (&writeable))) ? SELECT_MODE_WRITE : 0));
+  if (nfds == 0)
+    return (0);
+  if (errno != EINTR)
+    error_system_call (errno, syscall_select);
+  if (OS_process_any_status_change ())
+    return (SELECT_PROCESS_STATUS_CHANGE);
+  return (SELECT_INTERRUPT);
 #else
   error_system_call (ENOSYS, syscall_select);
   return (1);
@@ -863,7 +871,7 @@ OS_pause (void)
   UX_sigprocmask (SIG_SETMASK, &new, &old);
   if (OS_process_any_status_change ())
     n = SELECT_PROCESS_STATUS_CHANGE;
-  else if (pending_interrupts_p ())
+  else if ((GET_INT_CODE) != 0)
     n = SELECT_INTERRUPT;
   else
     {
@@ -877,7 +885,7 @@ OS_pause (void)
 #else /* not HAVE_SIGSUSPEND */
   INTERRUPTABLE_EXTENT
     (n, (((OS_process_any_status_change ())
-         || (pending_interrupts_p ()))
+         || ((GET_INT_CODE) != 0))
         ? ((errno = EINTR), (-1))
         : ((UX_pause ()), (0))));
   if (OS_process_any_status_change())

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 82bfab33d54ec285efefb4c90977af99de8c54e2..591819386d999e55a6e904cb3ee2aede02653eb7 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -517,9 +517,7 @@ USA.
     (let ((result
           (catch-errors
            (lambda ()
-             (set-interrupt-enables! interrupt-mask/all)
              (test-select-registry io-registry #t)))))
-      (set-interrupt-enables! interrupt-mask/gc-ok)
       (signal-select-result result)
       (let ((thread first-running-thread))
        (if thread
@@ -534,7 +532,14 @@ USA.
                                  (vector-ref result 1)
                                  (vector-ref result 2)))
        ((eq? 'PROCESS-STATUS-CHANGE result)
-        (%handle-subprocess-status-change))))
+        (%handle-subprocess-status-change))
+        ((eq? 'INTERRUPT result)
+        (set-interrupt-enables! interrupt-mask/all)
+        (handle-interrupts)
+        (set-interrupt-enables! interrupt-mask/gc-ok))))
+
+(define (handle-interrupts)
+  #t)
 
 (define (maybe-signal-io-thread-events)
   (if io-registrations