Beginnings of work stealing

* fibers/deque.scm (update!): Don't spin if value didn't change.
  (dequeue!): New function.
* fibers/internal.scm (schedule-fibers-for-fd): Add comment about
  stealing and fd's.
  (steal-work!): New internal function.

2 files changed, 26 insertions, 4 deletions

diff --git a/fibers/deque.scm b/fibers/deque.scm
index 8e65d61..6a41583 100644
--- a/fibers/deque.scm
+++ b/fibers/deque.scm
@@ -28,6 +28,7 @@
             dequeue-all
             dequeue-match
             undequeue
+            dequeue!
             dequeue-all!
             enqueue!))
 
@@ -85,10 +86,20 @@
   (let spin ((x (atomic-box-ref box)))
     (call-with-values (lambda () (f x))
       (lambda (x* ret)
-        (let ((x** (atomic-box-compare-and-swap! box x x*)))
-          (if (eq? x x**)
-              ret
-              (spin x**)))))))
+        (if (eq? x x*)
+            ret
+            (let ((x** (atomic-box-compare-and-swap! box x x*)))
+              (if (eq? x x**)
+                  ret
+                  (spin x**))))))))
+
+(define* (dequeue! dqbox #:optional default)
+  (update! dqbox (lambda (dq)
+                   (call-with-values (lambda () (dequeue dq))
+                     (lambda (dq* fiber)
+                       (if dq*
+                           (values dq* fiber)
+                           (values dq default)))))))
 
 (define (dequeue-all! dqbox)
   (update! dqbox (lambda (dq)
diff --git a/fibers/internal.scm b/fibers/internal.scm
index 033b714..7369c27 100644
--- a/fibers/internal.scm
+++ b/fibers/internal.scm
@@ -193,6 +193,10 @@ current."
                  ;; operations aren't proper CML operations, though.
                  (unless (zero? (logand revents
                                         (logior (source-events source) EPOLLERR)))
+                   ;; Fibers can't be stolen while they are in the
+                   ;; sources table; the scheduler of the fiber must
+                   ;; be SCHED, and so we are indeed responsible for
+                   ;; resuming the fiber.
                    (resume-fiber (source-fiber source) (lambda () revents))))
                (cdr sources))
      (cond
@@ -286,6 +290,13 @@ Return zero values."
        (for-each run-fiber runnables)
        (lp)))))
 
+(define (steal-work! sched)
+  "Steal some work from @var{sched}.  Return a list of runnable fibers
+in FIFO order, or the empty list if no work could be stolen."
+  (match (dequeue! (scheduler-runqueue sched) #f)
+    (#f '())
+    (fiber (list fiber))))
+
 (define (destroy-scheduler sched)
   "Release any resources associated with @var{sched}."
   #;