Use sigsuspend in new OS_pause, else wait-for-io must spin.

The test-select-registry primitive now calls OS_pause instead of
OS_test_select_registry to block with an empty registry.

diff --git a/src/microcode/configure.ac b/src/microcode/configure.ac
index dddf87eebb55311eae2aecd3fe9eca0d9301c827..5b966151ace833f1e830435f322a959a7c07eae2 100644 (file)
--- a/src/microcode/configure.ac
+++ b/src/microcode/configure.ac
@@ -536,7 +536,7 @@ AC_CHECK_FUNCS([openpty])
 AC_CHECK_FUNCS([poll pollts ppoll posix_madvise posix_openpt prealloc])
 AC_CHECK_FUNCS([rename rmdir])
 AC_CHECK_FUNCS([pselect select setitimer setpgrp setpgrp2 shmat sigaction])
-AC_CHECK_FUNCS([sighold socket statfs strchr strerror strstr strtol])
+AC_CHECK_FUNCS([sighold sigsuspend socket statfs strchr strerror strstr strtol])
 AC_CHECK_FUNCS([strtoul symlink sync_file_range sysconf])
 AC_CHECK_FUNCS([times truncate])
 AC_CHECK_FUNCS([uname utime])

diff --git a/src/microcode/ntio.c b/src/microcode/ntio.c
index 2750eeee807e52d74fa52f27dfa5c7f03cd8135c..3a4781ff2b9b9aa93a80d870cf3b74a77f9e2137 100644 (file)
--- a/src/microcode/ntio.c
+++ b/src/microcode/ntio.c
@@ -847,6 +847,16 @@ OS_test_select_registry (select_registry_t registry, int blockp)
   }
 }
 
+int
+OS_pause (void)
+{
+  /* Wait-for-io must spin. */
+  return
+    ((OS_process_any_status_change ())
+     ? SELECT_PROCESS_STATUS_CHANGE
+     : SELECT_INTERRUPT);
+}
+
 static int
 wait_on_multiple_objects (struct select_registry_s * r)
 {

diff --git a/src/microcode/os2io.c b/src/microcode/os2io.c
index 4a0e331305e803b3296e436aad95940b1b6319de..5511c057e836f445afe4ac1e83e715744095a1fe 100644 (file)
--- a/src/microcode/os2io.c
+++ b/src/microcode/os2io.c
@@ -564,3 +564,13 @@ OS_test_select_registry (select_registry_t registry, int blockp)
        interruptp = 1;
     }
 }
+
+int
+OS_pause (void)
+{
+  /* Wait-for-io must spin. */
+  return
+    ((OS_process_any_status_change ())
+     ? SELECT_PROCESS_STATUS_CHANGE
+     : SELECT_INTERRUPT);
+}

diff --git a/src/microcode/osio.h b/src/microcode/osio.h
index e80421430c901173beb489045a8563dab5f68f1d..73616c2e3464f0cc6146f6cc5077761da7b24069 100644 (file)
--- a/src/microcode/osio.h
+++ b/src/microcode/osio.h
@@ -109,5 +109,6 @@ extern int OS_test_select_registry
   (select_registry_t registry, int blockp);
 extern int OS_test_select_descriptor
   (int fd, int blockp, unsigned int mode);
+extern int OS_pause (void);
 
 #endif /* SCM_OSIO_H */

diff --git a/src/microcode/prosio.c b/src/microcode/prosio.c
index 344320bcbddb8e4a6a1f40f96639cd5d8c771fe2..d0a06c548946a597f8845bb8821281f10bbbeea5 100644 (file)
--- a/src/microcode/prosio.c
+++ b/src/microcode/prosio.c
@@ -331,7 +331,9 @@ DEFINE_PRIMITIVE ("TEST-SELECT-REGISTRY", Prim_test_selreg, 4, 4, 0)
       error_bad_range_arg (3);
     if ((VECTOR_LENGTH (vmode)) < rl)
       error_bad_range_arg (4);
-    result = (OS_test_select_registry (r, blockp));
+    result = ((rl == 0)
+             ? (blockp ? (OS_pause ()) : SELECT_INTERRUPT)
+             : (OS_test_select_registry (r, blockp)));
     if (result > 0)
       {
        unsigned int i = 0;

diff --git a/src/microcode/uxio.c b/src/microcode/uxio.c
index 533fe6eb38db727b5f6680a8fd8633361799fe0f..02f91a5661839e6b62adb0ce549b3a954cb8212e 100644 (file)
--- a/src/microcode/uxio.c
+++ b/src/microcode/uxio.c
@@ -851,3 +851,29 @@ OS_test_select_descriptor (int fd, int blockp, unsigned int mode)
 }
 
 #endif /* not HAVE_POLL */
+
+int
+OS_pause (void)
+{
+#ifdef HAVE_SIGSUSPEND
+  sigset_t old, new;
+
+  UX_sigfillset (&new);
+  UX_sigprocmask (SIG_SETMASK, &new, &old);
+  if (OS_process_any_status_change ())
+    return (SELECT_PROCESS_STATUS_CHANGE);
+  if (pending_interrupts_p ())
+    return (SELECT_INTERRUPT);
+  UX_sigsuspend (&old);
+  UX_sigprocmask (SIG_SETMASK, &old, NULL);
+  if (OS_process_any_status_change ())
+    return (SELECT_PROCESS_STATUS_CHANGE);
+  return (SELECT_INTERRUPT);
+#else
+  /* Wait-for-io must spin. */
+  return
+    ((OS_process_any_status_change ())
+     ? SELECT_PROCESS_STATUS_CHANGE
+     : SELECT_INTERRUPT);
+#endif
+}

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 6c8ab61955f28095cd05df25b7ed2833dc568f14..9f51e466af4e14d5016ade589c46aa666e64fd89 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -454,28 +454,19 @@ USA.
                          condition
                          (within-continuation k thunk))
                      thunk))))))))
-    (if (not io-registrations)
-       (begin
-         ;; Busy-waiting here is a bad idea -- should implement a
-         ;; primitive to block the Scheme process while waiting for a
-         ;; signal.
-         (catch-errors
-          (lambda ()
-            (set-interrupt-enables! interrupt-mask/all)
-            (do () (#f)))))
-       (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
-               (if (thread/continuation thread)
-                   (run-thread thread)
-                   (%maybe-toggle-thread-timer))
-               (wait-for-io)))))))
+    (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
+           (if (thread/continuation thread)
+               (run-thread thread)
+               (%maybe-toggle-thread-timer))
+           (wait-for-io))))))
 \f
 (define (signal-select-result result)
   (cond ((vector? result)