Merge branch 'master' into Gtk.
authorMatt Birkholz <puck@birchwood-abbey.net>
Mon, 4 Jan 2016 02:21:56 +0000 (19:21 -0700)
committerMatt Birkholz <puck@birchwood-abbey.net>
Mon, 4 Jan 2016 02:21:56 +0000 (19:21 -0700)
22 files changed:
1  2 
dist/shared.sh
src/Makefile.in
src/compiler/Stage.sh
src/edwin/editor.scm
src/etc/compile-boot-compiler.sh
src/microcode/cmpauxmd/i386.m4
src/microcode/cmpauxmd/x86-64.m4
src/microcode/cmpintmd/x86-64.c
src/microcode/ntio.c
src/microcode/os2io.c
src/microcode/osio.h
src/microcode/prosio.c
src/microcode/pruxffi.c
src/microcode/uxio.c
src/microcode/uxsig.c
src/runtime/ffi.scm
src/runtime/option.scm
src/runtime/process.scm
src/runtime/runtime.pkg
src/runtime/syncproc.scm
src/runtime/thread.scm
tests/check.scm

diff --cc dist/shared.sh
Simple merge
diff --cc src/Makefile.in
Simple merge
Simple merge
Simple merge
Simple merge
Simple merge
Simple merge
Simple merge
Simple merge
Simple merge
Simple merge
Simple merge
Simple merge
index 8011c9ece2a6c5be7e9e022e47a9be0b10bfb7fe,6ee00f59b189d89c5a06401b9991fa2241937329..6badbeb1778da66ad23737c952a93e1cb62727eb
@@@ -889,25 -874,16 +889,29 @@@ safe_pause (void
        n = SELECT_INTERRUPT;
      }
    UX_sigprocmask (SIG_SETMASK, &old, NULL);
-   return (n);
- #else
-   /* Wait-for-io must spin. */
-   return
-     ((OS_process_any_status_change ())
-      ? SELECT_PROCESS_STATUS_CHANGE
-      : SELECT_INTERRUPT);
+ #else /* not HAVE_SIGSUSPEND */
+   INTERRUPTABLE_EXTENT
+     (n, (((OS_process_any_status_change ())
+         || (pending_interrupts_p ()))
+        ? ((errno = EINTR), (-1))
+        : ((UX_pause ()), (0))));
+   if (OS_process_any_status_change())
+     n = SELECT_PROCESS_STATUS_CHANGE;
+   else
+     n = SELECT_INTERRUPT;
  #endif
+   return (n);
  }
 +
 +int
 +OS_pause (int blockp)
 +{
 +  if (!blockp)
 +    {
 +      return ((OS_process_any_status_change ())
 +            ? SELECT_PROCESS_STATUS_CHANGE
 +            : SELECT_INTERRUPT);
 +    }
 +  else
 +    return (safe_pause ());
 +}
Simple merge
Simple merge
Simple merge
index d8a0a8274d6222d842a42ead131bebe9b1ac1758,655a9a4d25cafde5a1b40c07beaae7fd8685edb3..d7e2b30f7ed9a7c516f57649e5c9952493ae6226
@@@ -183,36 -180,37 +180,49 @@@ USA
      process))
  
  (define (subprocess-delete process)
-   (without-interrupts
-    (lambda ()
-      (if (subprocess-index process)
-        (begin
-          (remove-from-gc-finalizer! subprocess-finalizer process)
-          (%close-subprocess-i/o process))))))
+   (if (subprocess-index process)
+       (begin
+       (poll-subprocess-status process)
+       (close-subprocess-i/o process)
+       (deregister-subprocess process)
+       (remove-from-gc-finalizer! subprocess-finalizer process))))
  \f
- (define (subprocess-status process)
-   (convert-subprocess-status (%subprocess-status process)))
  (define (subprocess-wait process)
-   (let loop ()
-     (hook/subprocess-wait process)
-     (let ((status (%subprocess-status process)))
-       (if (eqv? status 0)
-         (loop)
-         (convert-subprocess-status status)))))
+   (let ((result #f)
+       (registration))
+     (dynamic-wind
+      (lambda ()
+        (set! registration
+            (register-subprocess-event
+             process 'RUNNING (current-thread)
+             (named-lambda (subprocess-wait-event status)
+               (set! result status)))))
+      (lambda ()
+        (let loop ()
+        (with-thread-events-blocked
+         (lambda ()
+           (if (eq? result '#f)
+               (suspend-current-thread))
+           (if (eq? result 'RUNNING)
+               (set! result #f))))
+        (if (not result)
+            (loop)
+            result)))
+      (lambda ()
+        (deregister-subprocess-event registration)))))
  
 +(define (normal/subprocess-wait process)
 +  ((ucode-primitive process-wait 1) (subprocess-index process)))
 +
 +(define (nonblocking/subprocess-wait process)
 +  (without-interrupts
 +   (lambda ()
 +     (let ((status (%subprocess-status process)))
 +       (if (eqv? status 0)
 +         (block-on-process-status-change))))))
 +
 +(define hook/subprocess-wait normal/subprocess-wait)
 +
  (define (subprocess-continue-foreground process)
    (let loop ()
      ((ucode-primitive process-continue-foreground 1)
Simple merge
Simple merge
index 5b1a6c939006be49c04d366cfdb1a6bad6089145,7dea7c180f89238dc69e1bfee3a3e805084344c7..f3eee99ddfba29b17eb151e72e8f397712ed3fdc
@@@ -455,15 -509,8 +528,9 @@@ USA
    prev
    next)
  
- (define (initialize-io-blocking)
-   (set! io-registry (and have-select? (make-select-registry)))
-   (set! io-registrations #f)
-   unspecific)
  (define (wait-for-io)
    (%maybe-toggle-thread-timer #f)
 +  (%trace ";wait-for-io: next timeout = "next-scheduled-timeout"\n")
    (let ((catch-errors
         (lambda (thunk)
           (let ((thread (console-thread)))
diff --cc tests/check.scm
index 560ea469eb82c1c1818567f5d24a15b91dc03ebf,5a988550bbf000bcaa489d9fe83fe33fd544e2d9..4fb3cfaadeab37b70655c7e67d9d9c9fc8e8afd3
@@@ -53,9 -55,10 +55,10 @@@ USA
      "runtime/test-process"
      "runtime/test-readwrite"
      "runtime/test-regsexp"
+     "runtime/test-string"
      "runtime/test-url"
      ("runtime/test-wttree" (runtime wt-tree))
 -    ;;"ffi/test-ffi"
 +    "ffi/test-ffi.scm"
      ))
  
  (with-working-directory-pathname