simulation: prepare for better interference system

1 files changed, 77 insertions, 61 deletions

diff --git a/simulation.scm b/simulation.scm
index f5115e7..95933e6 100644
--- a/simulation.scm
+++ b/simulation.scm
@@ -12,6 +12,7 @@
 (define RX2 (1+ RX1)) ; s
 (define RECEIVE_DELAY1 1) ; s
 (define RECEIVE_DELAY2 (1+ RECEIVE_DELAY1)) ; s
+(define RETRANSMISSION_DELAY 2) ; s
 ;; From RP002 (Regional Parameters):
 ;; MAC commands exist in the LoRaWAN® specification to change the value of
 ;; RECEIVE_DELAY1 (using RXTimingSetupReq, RXTimingSetupAns) as well as
@@ -42,28 +43,27 @@
 
 
 ;; type can be:
-;; 'start
-;; 'end
+;; '[up/down]link-start
+;; '[up/down]link-end
 (define-record-type <event>
-  (make-event type data)
+  (make-event type channel-n frame)
   event?
   (type event-type)
-  (data event-data))
+  (channel-n event-channel-n)
+  (frame event-frame))
 
 ;; body can be:
 ;; 'unconfirmed-data (uplink)
 ;; 'confirmed-data (uplink)
 ;; 'ack (downlink)
 (define-record-type <frame>
-  (make-frame FCnt DeviceAddr mac-commands channel-n uplink? body)
+  (make-frame FCnt DeviceAddr mac-commands body)
   frame?
 
   (FCnt frame-FCnt)
   (DeviceAddr frame-DeviceAddr)
 
   (mac-commands frame-mac-commands)
-  (channel-n frame-channel-n)
-  (uplink? frame-uplink?) ;; TODO: we could check this
   (body frame-body))
 
 
@@ -105,26 +105,26 @@
       (spawn-fiber
         (lambda () "confirm confirmation frame"))))
 
+  (define (send-uplink-frame frame-number device-addr confirmed?)
+    (let* ((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-event 'uplink-start channel frame))
+      (sleep time-on-air)
+      (put-message upstream-chn (make-event 'uplink-end channel frame))))
+
   (define (upstream)
     (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
-      (let* ((confirmed? #t) ;; random?
-             (frame (make-frame
-                        current-frame
-                        id
-                        '()
-                        channel
-                        #t
-                        (if confirmed? 'confirmed-data 'unconfirmed-data))))
-        (when confirmed?
-          (atomic-box-compare-and-swap! to-confirm #f current-frame))
-        (put-message upstream-chn (make-event 'start frame))
-        (sleep time-on-air)
-        (put-message upstream-chn (make-event 'end frame)))
-      (set! current-frame (1+ current-frame))
+      (send-uplink-frame current-frame id #t)
+      (set! current-frame (1+ current-frame)) ;; TODO: fix
       (sleep RECEIVE_DELAY1)
       (start-listening!)
       (sleep RX1)
@@ -153,16 +153,16 @@
     (spawn-fiber
       ;; TODO: answer in the second window??
       (lambda ()
-      (sleep RECEIVE_DELAY1)
-      (let ((frame (make-frame seq-number to '() channel #f 'ack)))
-        (put-message downstream (make-event 'start frame))
-        (sleep time-on-air) ;; TODO: size / data-rate
-        (put-message downstream (make-event 'end frame))))))
+        (sleep RECEIVE_DELAY1)
+        (let ((frame (make-frame seq-number to '() 'ack)))
+          (put-message downstream (make-event 'downlink-start channel frame))
+          (sleep time-on-air) ;; TODO: size / data-rate
+          (put-message downstream (make-event 'downlink-end channel frame))))))
 
   ;; Upstream: listen, and answer in new fibers
   (lambda ()
     (forever
-      (let ((msg (get-message upstream)))
+      (let* ((msg (get-message upstream))) ;; TODO: make this get events instead
         (ll "Gateway ~a: Data #~a got from ~a"
             id
             (frame-FCnt msg)
@@ -170,51 +170,67 @@
         (match (frame-body msg)
           ('confirmed-data
            (ack-confirmed-data (frame-DeviceAddr msg)
-                               (frame-channel-n msg) ;; TODO: not right
-                               (frame-FCnt msg)))
+                               1
+                               (frame-FCnt msg))) ;; TODO: wrong!
           ('unconfirmed-data #f))))))
 
 
 (define (make-radio in end-devices gateways)
 
-  (define started '())
+  ;; Semaphore-like channel adquisition-release
+  (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? msg started-frames)
-    (any (lambda (x) (= (frame-channel-n msg) (frame-channel-n x)))
-         started-frames))
+  ;; interference => both should be affected.
+  (define (interference?)
+    #f)
 
   (lambda ()
     (forever
-      (let ((ev (get-message in)))
-        (match ev
-          (($ <event> 'start msg)
-           (ll "Device ~a started ~a of frame ~a"
-               (frame-DeviceAddr msg)
-               (frame-body msg)
-               (frame-FCnt msg))
-           (set! started (cons msg started)))
-          (($ <event> 'end msg)
-           (ll "Device ~a finished ~a of frame ~a"
-               (frame-DeviceAddr msg)
-               (frame-body msg)
-               (frame-FCnt msg))
-           (set! started
-             (remove! (lambda (x)
-                        (and (= (frame-FCnt msg) (frame-FCnt x))
-                             (= (frame-DeviceAddr msg) (frame-DeviceAddr x)))) started))
-           (if (interference? msg started) ;; TODO: interferences are broken
-             (ll "Interference!!!!!!")
-             (if (frame-uplink? msg)
-               (hash-table-walk gateways
-                                (lambda (k gateway)
-                                  (put-message (device-channel gateway) msg)))
-               (put-message
-                 (device-channel (hash-table-ref end-devices (frame-DeviceAddr msg)))
-                 msg)))))))))
-
+      (match (get-message in)
+        (($ <event> 'uplink-start channel-n frame)
+         (ll "Device ~a started ~a of frame ~a"
+             (frame-DeviceAddr frame)
+             (frame-body frame)
+             (frame-FCnt frame)))
+
+        (($ <event> 'downlink-start channel-n frame)
+         (ll "Device ~a started ~a of frame ~a"
+             (frame-DeviceAddr frame)
+             (frame-body frame)
+             (frame-FCnt frame)))
+
+        (($ <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!!!!!!")
+           (hash-table-walk gateways
+                            (lambda (k gateway)
+                              (put-message (device-channel gateway) frame)))))
+
+        (($ <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 (hash-table-ref end-devices (frame-DeviceAddr frame)))
+               frame)))))))
+
+
+(define (make-network-server upstream)
+  #f)