run-fibers returns when initial fiber finishes

* epoll.c (scm_primitive_epoll_wait): Accept timeout in internal time
  units instead of milliseconds.  Avoid some overhead if the timeout is
  zero.
* fibers/epoll.scm (epoll): Adapt to primitive-epoll-wait chance.
  Change get-timeout callback to an "expiry" argument and an
  update-expiry last-minute function.  Tighten the window around the
  "waiting" epoll-state.
* fibers.scm (%run-fibers): Remove current-read-waiter /
  current-write-waiter parameterization, given that fibers individually
  each have this parameterization.
  (run-fibers): Add #:drain? argument.
* fibers/internal.scm (schedule-runnables-for-next-turn): Simplify a
  bit, inlining scheduler-poll-timeout and adapting to epoll change.
  (scheduler-work-pending?): New function.
  (run-scheduler): Simplify finish? logic.
* tests/basic.scm:
* tests/speedup.scm: Update to drain where needed.
* fibers.texi: Update for new run-fibers termination condition.

1 files changed, 16 insertions, 14 deletions

diff --git a/fibers.scm b/fibers.scm
index ee02f67..2aa9354 100644
--- a/fibers.scm
+++ b/fibers.scm
@@ -55,19 +55,17 @@
    affinity
    (with-scheduler
     scheduler
-    (parameterize ((current-read-waiter wait-for-readable)
-                   (current-write-waiter wait-for-writable))
-      (with-interrupts
-       hz
-       (let ((last-runcount 0))
-         (lambda ()
-           (let* ((runcount (scheduler-runcount scheduler))
-                  (res (eqv? runcount last-runcount)))
-             (set! last-runcount runcount)
-             res)))
-       yield-current-fiber
+    (with-interrupts
+     hz
+     (let ((last-runcount 0))
        (lambda ()
-         (run-scheduler scheduler finished?)))))))
+         (let* ((runcount (scheduler-runcount scheduler))
+                (res (eqv? runcount last-runcount)))
+           (set! last-runcount runcount)
+           res)))
+     yield-current-fiber
+     (lambda ()
+       (run-scheduler scheduler finished?))))))
 
 (define (start-auxiliary-threads scheduler hz finished? affinities)
   (for-each (lambda (sched affinity)
@@ -105,7 +103,8 @@
                      #:key (hz 100) (scheduler #f)
                      (parallelism (current-processor-count))
                      (cpus (getaffinity 0))
-                     (install-suspendable-ports? #t))
+                     (install-suspendable-ports? #t)
+                     (drain? #f))
   (when install-suspendable-ports? (install-suspendable-ports!))
   (cond
    (scheduler
@@ -115,7 +114,10 @@
    (else
     (let* ((scheduler (make-scheduler #:parallelism parallelism))
            (ret (make-atomic-box #f))
-           (finished? (lambda () (atomic-box-ref ret)))
+           (finished? (lambda ()
+                        (and (atomic-box-ref ret)
+                             (or (not drain?)
+                                 (not (scheduler-work-pending? scheduler))))))
            (affinities (compute-affinities cpus parallelism)))
       (unless init
         (error "run-fibers requires initial fiber thunk when creating sched"))