Merge branch 'master' into Gtk

diff --cc src/microcode/osio.h
index ee70c639e53873c86ae779d0814687e384c2125e,73616c2e3464f0cc6146f6cc5077761da7b24069..3265f763616942dedb6f8e2b60f353a0fcf524fa
--- 1/src/microcode/osio.h
--- 2/src/microcode/osio.h
+++ b/src/microcode/osio.h
@@@ -112,6 -109,6 +112,7 @@@ extern int OS_test_select_registr
    (select_registry_t registry, int blockp);
  extern int OS_test_select_descriptor
    (int fd, int blockp, unsigned int mode);
+ extern int OS_pause (void);
 +extern select_registry_t arg_select_registry (int arg_number);
  
  #endif /* SCM_OSIO_H */

diff --cc src/microcode/prosio.c
Simple merge

diff --cc src/microcode/uxio.c
index d939e3a3303f641f246b08886131daf69687e591,2781a0182cd58eee532a2fd1fbed77d6bec71b22..d8af4a2ad57f146d43ce5cf2fa53d5342db3d034
--- 1/src/microcode/uxio.c
--- 2/src/microcode/uxio.c
+++ b/src/microcode/uxio.c
@@@ -566,13 -595,10 +606,10 @@@ OS_test_select_registry (select_registr
    struct select_registry_s * r = registry;
    while (1)
      {
-       int nfds
-       = (poll ((SR_ENTRIES (r)),
-                (SR_N_FDS (r)),
-                (blockp ? INFTIM : 0)));
-       if (nfds > 0)
+       int nfds = (safe_poll ((SR_ENTRIES (r)), (SR_N_FDS (r)), blockp));
+       if (nfds >= 0)
        return (nfds);
 -      if (errno != EINTR)
 +      if (nfds < 0 && errno != EINTR)
        error_system_call (errno, syscall_select);
        if (OS_process_any_status_change ())
        return (SELECT_PROCESS_STATUS_CHANGE);
@@@ -591,10 -615,12 +626,10 @@@ OS_test_select_descriptor (int fd, int 
    ((pfds [0]) . events) = (DECODE_MODE (mode));
    while (1)
      {
-       int nfds = (poll (pfds, 1, (blockp ? INFTIM : 0)));
+       int nfds = (safe_poll (pfds, 1, blockp));
        if (nfds > 0)
        return (ENCODE_MODE ((pfds [0]) . revents));
 -      if (nfds == 0)
 -      return (0);
 -      if (errno != EINTR)
 +      if (nfds < 0 && errno != EINTR)
        error_system_call (errno, syscall_select);
        if (OS_process_any_status_change ())
        return (SELECT_PROCESS_STATUS_CHANGE);
@@@ -724,24 -789,18 +800,18 @@@ OS_test_select_registry (select_registr
  {
  #ifdef HAVE_SELECT
    struct select_registry_s * r = registry;
+ 
+   (* (SR_RREADERS (r))) = (* (SR_QREADERS (r)));
+   (* (SR_RWRITERS (r))) = (* (SR_QWRITERS (r)));
    while (1)
      {
-       int nfds;
- 
-       (* (SR_RREADERS (r))) = (* (SR_QREADERS (r)));
-       (* (SR_RWRITERS (r))) = (* (SR_QWRITERS (r)));
-       INTERRUPTABLE_EXTENT
-       (nfds,
-        ((OS_process_any_status_change ())
-         ? ((errno = EINTR), (-1))
-         : (UX_select (FD_SETSIZE,
-                       (SR_RREADERS (r)),
-                       (SR_RWRITERS (r)),
-                       0,
-                       (blockp ? 0 : (&zero_timeout))))));
-       if (nfds > 0)
+       int nfds = (safe_select (FD_SETSIZE,
+                              (SR_RREADERS (r)),
+                              (SR_RWRITERS (r)),
+                              blockp));
+       if (nfds >= 0)
        return (nfds);
 -      if (errno != EINTR)
 +      if (nfds < 0 && errno != EINTR)
        error_system_call (errno, syscall_select);
        if (OS_process_any_status_change ())
        return (SELECT_PROCESS_STATUS_CHANGE);

diff --cc src/runtime/runtime.pkg
Simple merge

diff --cc src/runtime/thread.scm
index 4e41e456c978bb63c1bf8827b3231c7f83f30768,9f51e466af4e14d5016ade589c46aa666e64fd89..2a99f9e04bc804ee15eb25fccfe5917f497033aa
--- 1/src/runtime/thread.scm
--- 2/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@@ -475,35 -454,19 +475,26 @@@ 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 ()
-                 (%trace ";wait-for-io: blocking for i/o\n")
-                 (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)
-                   (begin
-                     (%trace ";wait-for-io: running "thread"\n")
-                     (run-thread thread))
-                   (begin
-                     (%trace ";wait-for-io: continuing "thread"\n")
-                     (%maybe-toggle-thread-timer)))
+     (let ((result
+          (catch-errors
+           (lambda ()
++            (%trace ";wait-for-io: blocking for i/o\n")
+             (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))))))
++              (begin
++                (%trace ";wait-for-io: running "thread"\n")
++                (run-thread thread))
 +              (begin
-                 (%trace ";wait-for-io: looping\n")
-                 (wait-for-io))))))))
++                (%trace ";wait-for-io: continuing "thread"\n")
++                (%maybe-toggle-thread-timer)))
++          (begin
++            (%trace ";wait-for-io: looping\n")
++            (wait-for-io)))))))
  \f
  (define (signal-select-result result)
    (cond ((vector? result)

diff --cc tests/check.scm
Simple merge