simulation: sink vs actual-device on class-a

1 files changed, 60 insertions, 71 deletions

diff --git a/simulation.scm b/simulation.scm
index 938500d..314c15d 100644
--- a/simulation.scm
+++ b/simulation.scm
@@ -11,18 +11,6 @@
   #:use-module (fibers operations)
   #:use-module (fibers timers))
 
-(define (put-message/timeout chan msg to)
-  (perform-operation (choice-operation
-                       (sleep-operation to)
-                       (put-operation chan msg))))
-
-(define (get-message/timeout chan to default)
-  (perform-operation (choice-operation
-                       (wrap-operation (sleep-operation to)
-                         (lambda _ default))
-                       (get-operation chan))))
-
-
 (define RX1 1) ; s (has to be between 1-15s)
 (define RX2 (1+ RX1)) ; s
 (define RECEIVE_DELAY1 1) ; s
@@ -120,8 +108,13 @@
 
 (define (make-class-a id initial-channel upstream-chn downstream-chn)
   (define window (make-channel))
+  ;; Activates/deactivates the message sink to avoid blocking on messages we
+  ;; don't need
+  (define internal-com (make-channel))
   ;; Make all atomic
   (define channel initial-channel)
+  (define (listening-to? chn)
+    (= channel chn))
 
   ;; TODO: Unhardcode me
   (define time-on-air 0.01)
@@ -132,20 +125,6 @@
 
   (define retransmissions NbTrans) ;; decrement in each transmission
 
-  ;; Handle the receive windows
-  (define listening? (make-atomic-box #f))
-  (define (start-waiting-for! chn frame-counter)
-    (ll "Device ~a started listening" id)
-    (atomic-box-set! listening? (list chn frame-counter)))
-  (define (stop-waiting!)
-    (ll "Device ~a stopped listening" id)
-    (atomic-box-set! listening? #f))
-  (define (waiting-for? chn frame)
-    (let ((listen (atomic-box-ref listening?)))
-      (and listen
-           (= chn (car listen))
-           (= (frame-FCnt frame) (cadr listen)))))
-
   (define (process-downlink! frame)
     ;; TODO
     (ll "Device ~a got downlink frame ~a" id frame))
@@ -168,58 +147,68 @@
       (sleep time-on-air)
       (put-message upstream-chn (make-radio-event 'uplink-end event-id channel frame))))
 
-  (define (upstream)
+  (define (device-operation)
     (define current-frame 0)
     (forever
-      (when (eq? #f (atomic-box-ref to-confirm))
-        (ll "Device ~a waiting for data" id)
-        (sleep (rand-time))) ;; wait for more data
+      ;; TODO check to-confirm
+      (ll "Device ~a waiting for data" id)
+      (sleep (rand-time)) ;; wait for more data
+
       (send-uplink-frame current-frame id #t)
       (set! current-frame (1+ current-frame)) ;; TODO: improve
       (sleep RECEIVE_DELAY1) ;; TODO: make sure this is ok
-
-      (start-waiting-for! channel (1- current-frame))
-      (let ((maybe-downstream-event (get-message/timeout window RX1 #f)))
-        (match maybe-downstream-event
-          (($ <radio-event> 'downlink-start event-id chn frame)
-           (let ((event (get-message window)))
-             (stop-waiting!)
-             (match event
-               (($ <radio-event> 'downlink-end event-id chn frame)
-                (process-downlink! frame))
-               (_ #f))))
-          (_ (stop-waiting!)))
-
-        #;(when (in-time?)
-          (wait-until-rx2)
-          (start-waiting-for! answer-to-x)
-          (open-RX2)
-          (stop-waiting! answer-to-x)))
-
-      #;(when (atomic-box-ref to-confirm)
-        (sleep (- RECEIVE_DELAY2 RECEIVE_DELAY1 RX1))
-        (start-listening!)
-        (sleep RX2)
-        (stop-listening!))))
-
-  (define (downstream)
+      (put-message internal-com 'wait)
+      (let ((until (+ (get-internal-real-time)
+                      (* RX1 internal-time-units-per-second))))
+        ;; TODO: listen to the first, and then hook to its radio-event-id
+        (let wait-for-downlink-start ()
+          (let ((msg (perform-operation
+                       (choice-operation
+                         (wrap-operation (timer-operation until)
+                                         (lambda _ 'time-is-out))
+                         (get-operation downstream-chn)))))
+            (ll "~a" msg)
+            (match msg
+              ;; We got the preamble in time
+              (($ <radio-event> 'downlink-start message-id (= listening-to? chn) frame)
+               (ll "Device ~a got preamble" id)
+               (let wait-for-downlink-end ((interference? #f))
+                 (let ((part-of-same-message? (lambda (i) (= message-id i)))
+                       (msg (get-message downstream-chn)))
+                   (match msg
+                     (($ <radio-event> 'interference
+                         (= part-of-same-message? id)
+                         (= listening-to? chn)
+                         frame)
+                      (wait-for-downlink-end #t)) ;; Got interference
+                     (($ <radio-event> 'downlink-end
+                         (= part-of-same-message? id)
+                         (= listening-to? chn)
+                         frame)
+                      (unless interference?
+                        (process-downlink! frame))) ;; TODO try RX2
+                     (_ (wait-for-downlink-end interference?))))))
+              ;; No preamble in time
+              ('time-is-out #f)
+              ;; Current message is not a preamble, continue
+              (_ (wait-for-downlink-start))))))
+      (put-message internal-com 'continue)))
+
+  (define (downstream-sink)
     (forever
-      (let ((ev (get-message downstream-chn)))
-        ;; TODO:
-        ;; If the same message is sent by several gateways how to identify
-        ;; which start corresponds to each end??
+      (let ((ev (perform-operation
+                  (choice-operation (get-operation internal-com)
+                                    (get-operation downstream-chn)))))
         (match ev
-          (($ <radio-event> type event-id chn frame)
-           ;; TODO: listen to the first, and then hook to its radio-event-id
-           (when (waiting-for? chn frame)
-             ;; do not add timeout if it's waiting for an end???
-             (spawn-fiber (lambda ()
-                            (put-message window ev)))
-             ))))))
+          ('wait
+           (ll "RX window started")
+           (get-message internal-com)
+           (ll "Sinking again"))
+          (_ #f)))))
 
   (lambda ()
-    (spawn-fiber upstream)
-    (spawn-fiber downstream)))
+    (spawn-fiber device-operation)
+    (spawn-fiber downstream-sink)))
 
 (define (make-gateway id in radio network)
   (define time-on-air 0.01) ;s (TODO)
@@ -232,9 +221,9 @@
         ;; TODO: choose channel properly
         (let ((event-id (new-id)))
           (ll "Gateway ~a sending downlink ~a" id frame)
-          (put-message radio (make-radio-event 'downlink-start event-id 0 frame))
+          (put-message radio (make-radio-event 'downlink-start event-id 1 frame))
           (sleep time-on-air)
-          (put-message radio (make-radio-event 'downlink-end   event-id 0 frame))))))
+          (put-message radio (make-radio-event 'downlink-end   event-id 1 frame))))))
 
   (define (send-to-network-server x)
     (ll "Gateway ~a forwarding ~a" id x)