Flesh out remote peers interface

* fibers/internal.scm (<scheduler>): Add remote-peers setter, and expose
  getter publically.
  (make-scheduler): Change remote-peers arg to "parallelism", and use
  setter to initialize remote peers.

1 files changed, 14 insertions, 3 deletions

diff --git a/fibers/internal.scm b/fibers/internal.scm
index 813330b..b283777 100644
--- a/fibers/internal.scm
+++ b/fibers/internal.scm
@@ -33,6 +33,7 @@
             with-scheduler
             scheduler-name
             (scheduler-kernel-thread/public . scheduler-kernel-thread)
+            scheduler-remote-peers
             run-scheduler
             destroy-scheduler
 
@@ -96,7 +97,7 @@ name is known."
   ;; atomic parameter of thread
   (kernel-thread scheduler-kernel-thread)
   ;; vector of sched
-  (remote-peers scheduler-remote-peers))
+  (remote-peers scheduler-remote-peers set-scheduler-remote-peers!))
 
 (define-record-type <fiber>
   (make-fiber scheduler continuation)
@@ -118,7 +119,7 @@ name is known."
              (unless (eq? prev init)
                (error "owned by other thread" prev))))))))
 
-(define* (make-scheduler #:key (remote-peers #()))
+(define* (make-scheduler #:key parallelism)
   "Make a new scheduler in which to run fibers."
   (let ((epfd (epoll-create))
         (active-fd-count 0)
@@ -129,12 +130,22 @@ name is known."
         (timers (make-psq (match-lambda*
                             (((t1 . c1) (t2 . c2)) (< t1 t2)))
                           <))
-        (kernel-thread (make-atomic-parameter #f)))
+        (kernel-thread (make-atomic-parameter #f))
+        (remote-peers (if parallelism
+                          (list->vector (map (lambda (_) (make-scheduler))
+                                             (iota (1- parallelism))))
+                          #())))
     (let ((sched (%make-scheduler #f epfd active-fd-count prompt-tag
                                   next-runqueue current-runqueue
                                   sources timers kernel-thread
                                   remote-peers)))
       (set-scheduler-name! sched (nameset-add! schedulers-nameset sched))
+      (let lp ((i 0))
+        (when (< i (vector-length remote-peers))
+          (let ((peers (vector-copy remote-peers)))
+            (vector-set! peers i sched)
+            (set-scheduler-remote-peers! (vector-ref remote-peers i) peers))
+          (lp (1+ i))))
       sched)))
 
 (define-syntax-rule (with-scheduler scheduler body ...)