simulation: identifying events enables discrimination

1 files changed, 42 insertions, 27 deletions

diff --git a/simulation.scm b/simulation.scm
index d3f2c96..bdba9d6 100644
--- a/simulation.scm
+++ b/simulation.scm
@@ -55,6 +55,18 @@
           *output-channel*
           (format #f "~d~6'0d - ~?~%" (car now) (cdr now) f data))))))
 
+;; Synchronized id generator
+(define *id-channel-in* (make-channel))
+(define *id-channel-out* (make-channel))
+(define (counter)
+   (let loop ((id 0))
+     (let ((msg (get-message *id-channel-in*)))
+       (put-message *id-channel-out* id)
+       (loop (1+ id)))))
+
+(define (new-id)
+  (put-message *id-channel-in* #t)
+  (get-message *id-channel-out*))
 
 ;; For End-Device <--> Radio <--> Gateway
 ;; type can be:
@@ -62,9 +74,10 @@
 ;; '[up/down]link-end
 ;; 'interference
 (define-record-type <radio-event>
-  (make-radio-event type channel-n frame)
+  (make-radio-event type id channel-n frame)
   radio-event?
   (type radio-event-type)
+  (id radio-event-id)  ;; Match the start-interference-end events
   (channel-n radio-event-channel-n)
   (frame radio-event-frame))
 
@@ -137,16 +150,17 @@
         (lambda () "confirm confirmation frame"))))
 
   (define (send-uplink-frame frame-number device-addr confirmed?)
-    (let* ((frame (make-frame
+    (let* ((event-id id)
+           (frame (make-frame
                     frame-number
                     id
                     '()
                     (if confirmed? 'confirmed-data 'unconfirmed-data))))
       (when confirmed?
         (atomic-box-compare-and-swap! to-confirm #f frame-number))
-      (put-message upstream-chn (make-radio-event 'uplink-start channel frame))
+      (put-message upstream-chn (make-radio-event 'uplink-start event-id channel frame))
       (sleep time-on-air)
-      (put-message upstream-chn (make-radio-event 'uplink-end channel frame))))
+      (put-message upstream-chn (make-radio-event 'uplink-end event-id channel frame))))
 
   (define (upstream)
     (define current-frame 0)
@@ -161,11 +175,11 @@
       (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 chn frame)
+          (($ <radio-event> 'downlink-start event-id chn frame)
            (let ((event (get-message window)))
              (stop-waiting!)
              (match event
-               (($ <radio-event> 'downlink-end chn frame)
+               (($ <radio-event> 'downlink-end event-id chn frame)
                 (process-downlink! frame))
                (_ #f))))
           (_ (stop-waiting!)))
@@ -189,7 +203,8 @@
         ;; If the same message is sent by several gateways how to identify
         ;; which start corresponds to each end??
         (match ev
-          (($ <radio-event> type chn frame)
+          (($ <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 ()
@@ -209,10 +224,11 @@
     (spawn-fiber
       (lambda ()
         ;; TODO: choose channel properly
-        (ll "Gateway ~a sending downlink ~a" id frame)
-        (put-message radio (make-radio-event 'downlink-start 0 frame))
-        (sleep time-on-air)
-        (put-message radio (make-radio-event 'downlink-end  0 frame)))))
+        (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))
+          (sleep time-on-air)
+          (put-message radio (make-radio-event 'downlink-end   event-id 0 frame))))))
 
   (define (send-to-network-server x)
     (ll "Gateway ~a forwarding ~a" id x)
@@ -225,13 +241,13 @@
         (match ev
           (($ <network-event> id frame)
            (send-to-device frame))
-          (($ <radio-event> 'uplink-start channel-n frame) #f)
-          (($ <radio-event> 'interference channel-n frame)
+          (($ <radio-event> 'uplink-start event-id channel-n frame) #f)
+          (($ <radio-event> 'interference event-id channel-n frame)
            (set! pending-interferences (cons ev pending-interferences)))
-          (($ <radio-event> 'uplink-end channel-n frame)
+          (($ <radio-event> 'uplink-end event-id channel-n frame)
            (let-values (((mine not-mine)
-                         (partition (lambda (x) (eq? (radio-event-frame x)
-                                                     (radio-event-frame ev)))
+                         (partition (lambda (x) (eq? (radio-event-id x)
+                                                     (radio-event-id ev)))
                                     pending-interferences)))
              (set! pending-interferences not-mine)
              (when (null? mine) ;; TODO
@@ -254,22 +270,20 @@
   (define (release-lorawan-channel! chn end-event)
     (hash-table-update! lorawan-channels chn
       (lambda (event-list)
-        ;; what if we have more than one?
-        ;; is that possible?
-        (remove! (lambda (x) (eq? (radio-event-frame x)
-                                  (radio-event-frame end-event)))
+        (remove! (lambda (x) (eq? (radio-event-id x)
+                                  (radio-event-id end-event)))
                  event-list))))
   (define (radio-event->interference ev)
     "Make a new radio-event of type 'interference from another radio-event"
     (match ev
-      (($ <radio-event> type channel-n frame)
-       (make-radio-event 'interference channel-n frame))))
+      (($ <radio-event> type id channel-n frame)
+       (make-radio-event 'interference id channel-n frame))))
 
   (lambda ()
     (forever
       (let ((ev (get-message in)))
         (match ev
-          (($ <radio-event> 'uplink-start channel-n frame)
+          (($ <radio-event> 'uplink-start event-id channel-n frame)
            (ll "Device ~a started uplink-frame #~a on channel ~a"
                (frame-DeviceAddr frame)
                (frame-FCnt frame)
@@ -288,7 +302,7 @@
                                       (radio-event->interference ev)))
                        ints)))))))
 
-          (($ <radio-event> 'downlink-start channel-n frame)
+          (($ <radio-event> 'downlink-start event-id channel-n frame)
            (ll "Device ~a started downlink-frame #~a on channel ~a"
                (frame-DeviceAddr frame)
                (frame-FCnt frame)
@@ -304,7 +318,7 @@
                  (put-message chan (radio-event->interference ev)))
                ints)))
 
-          (($ <radio-event> 'uplink-end channel-n frame)
+          (($ <radio-event> 'uplink-end event-id channel-n frame)
            (ll "Device ~a ended uplink-frame #~a on channel ~a"
                (frame-DeviceAddr frame)
                (frame-FCnt frame)
@@ -316,7 +330,7 @@
                  (lambda ()
                    (put-message (device-channel gateway) ev))))))
 
-          (($ <radio-event> 'downlink-end channel-n frame)
+          (($ <radio-event> 'downlink-end event-id channel-n frame)
            (ll "Device ~a ended downlink-frame #~a on channel ~a"
                (frame-DeviceAddr frame)
                (frame-FCnt frame)
@@ -351,8 +365,9 @@
 
 
 (define (run-simulation)
-  ;; We need a synchronized logger running in a fiber
+  ;; We need synchronized logger and counter running in fibers
   (spawn-fiber logger)
+  (spawn-fiber counter)
 
   (let* ((radio-chn   (make-channel))
          (end-devices (make-hash-table))