diff options
Diffstat (limited to 'simulation.scm')
| -rw-r--r-- | simulation.scm | 138 |
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) |