From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Wed, 5 Sep 2012 19:39:21 +0000 (-0700)
Subject: Use sigsuspend in new OS_pause, else wait-for-io must spin.
X-Git-Tag: release-9.2.0~222
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3f6d8ea68439a0d8aa9d15aebf7dec7f7cae7f80;p=mit-scheme.git

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 dddf87eeb..5b966151a 100644
--- 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 2750eeee8..3a4781ff2 100644
--- 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 4a0e33130..5511c057e 100644
--- 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 e80421430..73616c2e3 100644
--- 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 344320bcb..d0a06c548 100644
--- 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 533fe6eb3..02f91a566 100644
--- 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 6c8ab6195..9f51e466a 100644
--- 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))))))
 
 (define (signal-select-result result)
   (cond ((vector? result)