Rework internals resume interface

* fibers/internal.scm (resume-on-fd-events, resume-on-readable-fd)
  (resume-on-writable-fd, resume-on-timer): Rework primitive resume
  interface.
* fibers.scm:
* fibers/timers.scm: Adapt users.

3 files changed, 37 insertions, 26 deletions

diff --git a/fibers.scm b/fibers.scm
index ffdb251..b3ebd6b 100644
--- a/fibers.scm
+++ b/fibers.scm
@@ -18,7 +18,6 @@
 ;;;; 
 
 (define-module (fibers)
-  #:use-module (fibers epoll)
   #:use-module (fibers internal)
   #:use-module (fibers repl)
   #:use-module (fibers timers)
@@ -37,17 +36,14 @@
   "Return the current fiber, or @code{#f} if no fiber is current."
   (current-fiber))
 
-(define (wait-for-events port fd events)
-  (let ((revents (suspend-current-fiber
-                  (lambda (fiber)
-                    (add-fd-events! (fiber-scheduler fiber) fd events fiber)))))
-    (unless (zero? (logand revents EPOLLERR))
-      (error "error reading from port" port))))
-
 (define (wait-for-readable port)
-  (wait-for-events port (port-read-wait-fd port) (logior EPOLLIN EPOLLRDHUP)))
+  (suspend-current-fiber
+   (lambda (fiber)
+     (resume-on-readable-fd (port-read-wait-fd port) fiber))))
 (define (wait-for-writable port)
-  (wait-for-events port (port-write-wait-fd port) EPOLLOUT))
+  (suspend-current-fiber
+   (lambda (fiber)
+     (resume-on-writable-fd (port-read-wait-fd port) fiber))))
 
 (define* (run-fibers #:optional (init #f)
                      #:key (scheduler (make-scheduler))
diff --git a/fibers/internal.scm b/fibers/internal.scm
index bd7ba64..a74bc0f 100644
--- a/fibers/internal.scm
+++ b/fibers/internal.scm
@@ -34,8 +34,10 @@
             (scheduler-kernel-thread/public . scheduler-kernel-thread)
             run-scheduler
             destroy-scheduler
-            add-fd-events!
-            add-timer!
+
+            resume-on-readable-fd
+            resume-on-writable-fd
+            resume-on-timer
 
             create-fiber
             current-fiber
@@ -332,10 +334,11 @@ from a finalizer thread."
                                       (1- (scheduler-active-fd-count sched)))
       (hashv-remove! sources-table fd))))
 
-(define (add-fd-events! sched fd events fiber)
+(define (resume-on-fd-events fd events fiber)
   "Arrange to resume @var{fiber} when the file descriptor @var{fd} has
 the given @var{events}, expressed as an epoll bitfield."
-  (let ((sources (hashv-ref (scheduler-sources sched) fd)))
+  (let* ((sched (fiber-scheduler fiber))
+         (sources (hashv-ref (scheduler-sources sched) fd)))
     (cond
      (sources
       (set-cdr! sources (cons (make-source events #f fiber) (cdr sources)))
@@ -357,8 +360,22 @@ the given @var{events}, expressed as an epoll bitfield."
       (add-fdes-finalizer! fd (lambda (fd) (finalize-fd sched fd)))
       (epoll-add! (scheduler-epfd sched) fd (logior events EPOLLONESHOT))))))
 
-(define (add-timer! sched thunk expiry)
-  (set-scheduler-timers! sched
-                         (psq-set (scheduler-timers sched)
-                                  (cons expiry thunk)
-                                  expiry)))
+(define (resume-on-readable-fd fd fiber)
+  "Arrange to resume @var{fiber} when the file descriptor @var{fd}
+becomes readable."
+  (resume-on-fd-events fd (logior EPOLLIN EPOLLRDHUP) fiber))
+
+(define (resume-on-writable-fd fd fiber)
+  "Arrange to resume @var{fiber} when the file descriptor @var{fd}
+becomes writable."
+  (resume-on-fd-events fd EPOLLOUT fiber))
+
+(define (resume-on-timer fiber expiry get-thunk)
+  (let ((sched (fiber-scheduler fiber)))
+    (define (maybe-resume)
+      (let ((thunk (get-thunk)))
+        (when thunk (resume-fiber fiber thunk))))
+    (set-scheduler-timers! sched
+                           (psq-set (scheduler-timers sched)
+                                    (cons expiry maybe-resume)
+                                    expiry))))
diff --git a/fibers/timers.scm b/fibers/timers.scm
index b4d8d16..9c743ae 100644
--- a/fibers/timers.scm
+++ b/fibers/timers.scm
@@ -35,14 +35,12 @@ units.  The operation will succeed with no values."
                          (and (< expiry (get-internal-real-time))
                               values))
                        (lambda (flag fiber wrap-fn)
-                         (define (maybe-resume-fiber)
+                         (define (get-resume-thunk)
                            (match (atomic-box-compare-and-swap! flag 'W 'S)
-                             ('W (resume-fiber fiber (or wrap-fn values)))
-                             ('C (maybe-resume-fiber))
-                             ('S (values))))
-                         (add-timer! (fiber-scheduler fiber)
-                                     maybe-resume-fiber
-                                     expiry))))
+                             ('W (or wrap-fn values))
+                             ('C (get-resume-thunk))
+                             ('S #f)))
+                         (resume-on-timer fiber expiry get-resume-thunk))))
 
 (define (wait-operation seconds)
   "Make an operation that will succeed with no values when