simulation: radio channel usage control

1 files changed, 56 insertions, 43 deletions

diff --git a/simulation.scm b/simulation.scm
index 50c97e4..a710fa0 100644
--- a/simulation.scm
+++ b/simulation.scm
@@ -184,57 +184,70 @@
 
 
 (define (make-radio in end-devices gateways)
+  "Fiber for radio resource allocation/control."
 
-  ;; Semaphore-like channel adquisition-release
+  ;; We can access it only from one fiber! Careful!
   (define lorawan-channels (make-hash-table))
-  (define (use-lorawan-channel chn)
-    #f)
-  (define (release-lorawan-channel chn)
-    #f)
-
-
-  ;; TODO: this is broken, only accounts for the interference of the frame
-  ;; that was already being sent, and not from the new one that produced the
-  ;; interference => both should be affected.
-  (define (interference?)
-    #f)
+  (define (interference? chn)
+    (< 1 (length (hash-table-ref lorawan-channels chn))))
+  (define (use-lorawan-channel! chn start-event)
+    (hash-table-update!/default lorawan-channels chn
+                        (lambda (event-list)
+                          (cons start-event event-list))
+                        '()))
+  (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)))
+                 event-list))))
 
   (lambda ()
     (forever
-      (match (get-message in)
-        (($ <radio-event> 'uplink-start channel-n frame)
-         (ll "Device ~a started ~a of frame ~a"
-             (frame-DeviceAddr frame)
-             (frame-body frame)
-             (frame-FCnt frame)))
-
-        (($ <radio-event> 'downlink-start channel-n frame)
-         (ll "Device ~a started ~a of frame ~a"
-             (frame-DeviceAddr frame)
-             (frame-body frame)
-             (frame-FCnt frame)))
-
-        (($ <radio-event> 'uplink-end channel-n frame)
-         (ll "Device ~a finished ~a of frame ~a"
-             (frame-DeviceAddr frame)
-             (frame-body frame)
-             (frame-FCnt frame))
-         (if (interference?) ;; TODO: interferences are broken
-           (ll "Interference!!!!!!")
+      (let ((ev (get-message in)))
+        (match ev
+          (($ <radio-event> 'uplink-start channel-n frame)
+           (ll "Device ~a started uplink-frame #~a on channel ~a"
+               (frame-DeviceAddr frame)
+               (frame-FCnt frame)
+               channel-n)
+           (use-lorawan-channel! channel-n ev)
+           (when (interference? channel-n)
+             ;; TODO: send an 'interference event to the device
+             (ll "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA")))
+
+          (($ <radio-event> 'downlink-start channel-n frame)
+           (ll "Device ~a started downlink-frame #~a on channel ~a"
+               (frame-DeviceAddr frame)
+               (frame-FCnt frame)
+               channel-n)
+           (use-lorawan-channel! channel-n ev)
+           (when (interference? channel-n)
+             ;; TODO: send an 'interference event to the device
+             (ll "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA")))
+
+          (($ <radio-event> 'uplink-end channel-n frame)
+           (ll "Device ~a ended uplink-frame #~a on channel ~a"
+               (frame-DeviceAddr frame)
+               (frame-FCnt frame)
+               channel-n)
+           (release-lorawan-channel! channel-n ev)
            (hash-table-walk gateways
                             (lambda (k gateway)
-                              (put-message (device-channel gateway) frame)))))
-
-        (($ <radio-event> 'downlink-end channel-n frame)
-         (ll "Device ~a finished ~a of frame ~a"
-             (frame-DeviceAddr frame)
-             (frame-body frame)
-             (frame-FCnt frame))
-         (if (interference?) ;; TODO: interferences are broken
-           (ll "Interference!!!!!!")
+                              (put-message (device-channel gateway) frame))))
+
+          (($ <radio-event> 'downlink-end channel-n frame)
+           (ll "Device ~a ended uplink-frame #~a on channel ~a"
+               (frame-DeviceAddr frame)
+               (frame-FCnt frame)
+               channel-n)
+           (release-lorawan-channel! channel-n ev)
            (put-message
-               (device-channel (hash-table-ref end-devices (frame-DeviceAddr frame)))
-               frame)))))))
+             (device-channel (hash-table-ref end-devices
+                                             (frame-DeviceAddr frame)))
+             frame)))))))
 
 
 (define (make-network-server upstream gateways end-devices)