simulation: don't run fibers automatically, return thunk instead

1 files changed, 64 insertions, 66 deletions

diff --git a/simulation.scm b/simulation.scm
index 9e7a506..d708567 100644
--- a/simulation.scm
+++ b/simulation.scm
@@ -34,7 +34,7 @@
 (define (rand-time)
   (random 20))
 
-(define (make-class-a id initial-channel upstream downstream)
+(define (make-class-a id initial-channel upstream-chn downstream-chn)
   ;; Make all atomic
   (define channel initial-channel)
   (define listening? (make-atomic-box #f))
@@ -47,36 +47,36 @@
   (define receive-delay-2 2)
   ;(define sent-to-confirm (make-vector))
 
-  ;; Downstream, always listen and update my state
-  (spawn-fiber
-    (lambda ()
-      (forever
-        (let ((msg (get-message downstream)))
-          (when (atomic-box-ref listening?)
-            (ll "Device: ~a Received: ~a" id msg)
-           #;(match (message-body msg)
-                  (('ack) (confirm X))))))))
-
-  ;; Upstream send data randomply
-  (spawn-fiber
-    (lambda ()
-      (define current-message 0)
-      (forever
-        (sleep (rand-time))
-        (put-message upstream (make-message current-message id channel 'data-start))
-        (sleep time-on-air)
-        (put-message upstream (make-message current-message id channel 'data-end))
-        (set! current-message (1+ current-message))
-        (sleep receive-delay-1)
-        (atomic-box-set! listening? #t)
-        ;; TODO: maybe synchronization doesn't work because we do too many things
-        (sleep rx1)
-        (atomic-box-set! listening? #f)
-        ;; (when not-answered ...)
-        (sleep (- receive-delay-2 receive-delay-1))
-        (atomic-box-set! listening? #t)
-        (sleep rx2)
-        (atomic-box-set! listening? #f)))))
+  (define (upstream)
+    (define current-message 0)
+    (forever
+      (sleep (rand-time))
+      (put-message upstream-chn (make-message current-message id channel 'data-start))
+      (sleep time-on-air)
+      (put-message upstream-chn (make-message current-message id channel 'data-end))
+      (set! current-message (1+ current-message))
+      (sleep receive-delay-1)
+      (atomic-box-set! listening? #t)
+      ;; TODO: maybe synchronization doesn't work because we do too many things
+      (sleep rx1)
+      (atomic-box-set! listening? #f)
+      ;; (when not-answered ...)
+      (sleep (- receive-delay-2 receive-delay-1))
+      (atomic-box-set! listening? #t)
+      (sleep rx2)
+      (atomic-box-set! listening? #f)))
+
+  (define (downstream)
+    (forever
+      (let ((msg (get-message downstream-chn)))
+        (when (atomic-box-ref listening?)
+          (ll "Device: ~a Received: ~a" id msg)
+          #;(match (message-body msg)
+          (('ack) (confirm X)))))))
+
+  (lambda ()
+    (spawn-fiber upstream)
+    (spawn-fiber downstream)))
 
 (define (make-gateway id upstream downstream)
   #;(define (ack-confirmed-data to channel seq-number)
@@ -85,14 +85,13 @@
       (put-message downstream (make-message to channel 'ack seq-number))))
 
   ;; Upstream: listen, and answer in new fibers
-  (spawn-fiber
-    (lambda ()
-      (forever
-        (let ((msg (get-message upstream)))
-          (ll "Gateway ~a: Data #~a got from ~a"
-               id
-               (message-id msg)
-               (message-device-id msg)))))))
+  (lambda ()
+    (forever
+      (let ((msg (get-message upstream)))
+        (ll "Gateway ~a: Data #~a got from ~a"
+            id
+            (message-id msg)
+            (message-device-id msg))))))
 
 
 (define (make-radio in gateways)
@@ -107,39 +106,38 @@
     (any (lambda (x) (= (message-channel-n msg) (message-channel-n x)))
          started-messages))
 
-  (spawn-fiber
-    (lambda ()
-      (forever
-        (let ((msg (get-message in)))
-          (match (message-body msg)
-            ('data-start
-             (set! started (cons msg started)))
-            ('data-end
-             (set! started
-               (remove! (lambda (x)
-                          (and (= (message-id msg) (message-id x))
-                               (= (message-device-id msg) (message-device-id x)))) started))
-             (if (interference? msg started)
-               (ll "Interference!!!!!!")
-               (for-each (lambda (gateway)
-                           (put-message gateways
-                                        (make-message (message-id msg)
-                                                      (message-device-id msg)
-                                                      (message-channel-n msg)
-                                                      'data)))
-                         gateways)))))))))
+  (lambda ()
+    (forever
+      (let ((msg (get-message in)))
+        (match (message-body msg)
+          ('data-start
+           (set! started (cons msg started)))
+          ('data-end
+           (set! started
+             (remove! (lambda (x)
+                        (and (= (message-id msg) (message-id x))
+                             (= (message-device-id msg) (message-device-id x)))) started))
+           (if (interference? msg started)
+             (ll "Interference!!!!!!")
+             (for-each (lambda (gateway)
+                         (put-message gateways
+                                      (make-message (message-id msg)
+                                                    (message-device-id msg)
+                                                    (message-channel-n msg)
+                                                    'data)))
+                       gateways))))))))
 
 
 
 (define (run-simulation)
   (let* ((radio-chn (make-channel))
          (gateway-chn (make-channel)))
-    (make-class-a 1 1 radio-chn (make-channel))
-    (make-class-a 2 1 radio-chn (make-channel))
-    (make-class-a 3 1 radio-chn (make-channel))
-    (make-class-a 4 1 radio-chn (make-channel))
-    (make-gateway 5 radio-chn gateway-chn)
-    (make-radio radio-chn (list gateway-chn))))
+    (spawn-fiber (make-class-a 1 1 radio-chn (make-channel)))
+    (spawn-fiber (make-class-a 2 1 radio-chn (make-channel)))
+    (spawn-fiber (make-class-a 3 1 radio-chn (make-channel)))
+    (spawn-fiber (make-class-a 4 1 radio-chn (make-channel)))
+    (spawn-fiber (make-gateway 5 radio-chn gateway-chn))
+    (spawn-fiber (make-radio radio-chn (list gateway-chn)))))
 
 (run-fibers
   run-simulation