diff options
| -rw-r--r-- | simulation.scm | 112 |
1 files changed, 90 insertions, 22 deletions
diff --git a/simulation.scm b/simulation.scm index dd78fa1..d3f2c96 100644 --- a/simulation.scm +++ b/simulation.scm @@ -7,8 +7,21 @@ #:use-module (ice-9 match) #:use-module (fibers) #:use-module (fibers channels) + #: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 @@ -87,6 +100,7 @@ (random 2.)) (define (make-class-a id initial-channel upstream-chn downstream-chn) + (define window (make-channel)) ;; Make all atomic (define channel initial-channel) @@ -101,16 +115,23 @@ ;; Handle the receive windows (define listening? (make-atomic-box #f)) - (define (start-listening!) + (define (start-waiting-for! chn frame-counter) (ll "Device ~a started listening" id) - (atomic-box-set! listening? #t)) - (define (stop-listening!) + (atomic-box-set! listening? (list chn frame-counter))) + (define (stop-waiting!) (ll "Device ~a stopped listening" id) (atomic-box-set! listening? #f)) - (define (im-listening?) - (atomic-box-ref listening?)) + (define (waiting-for? chn frame) + (let ((listen (atomic-box-ref listening?))) + (and listen + (= chn (car listen)) + (= (frame-FCnt frame) (cadr listen))))) - (define (confirm frame-FCnt) + (define (process-downlink! frame) + ;; TODO + (ll "Device ~a got downlink frame ~a" id frame)) + + #;(define (confirm frame-FCnt) (when (eq? frame-FCnt (atomic-box-compare-and-swap! to-confirm frame-FCnt #f)) (spawn-fiber (lambda () "confirm confirmation frame")))) @@ -134,12 +155,28 @@ (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: fix - (sleep RECEIVE_DELAY1) - (start-listening!) - (sleep RX1) - (stop-listening!) - (when (atomic-box-ref to-confirm) + (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 chn frame) + (let ((event (get-message window))) + (stop-waiting!) + (match event + (($ <radio-event> 'downlink-end 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) @@ -147,10 +184,17 @@ (define (downstream) (forever - (let ((msg (get-message downstream-chn))) - (when (im-listening?) - (match (frame-body msg) - ('ack (confirm (frame-FCnt msg)))))))) + (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?? + (match ev + (($ <radio-event> type chn frame) + (when (waiting-for? chn frame) + ;; do not add timeout if it's waiting for an end??? + (spawn-fiber (lambda () + (put-message window ev))) + )))))) (lambda () (spawn-fiber upstream) @@ -160,7 +204,17 @@ (define time-on-air 0.01) ;s (TODO) (define pending-interferences '()) - (define (forward-frame x) + (define (send-to-device frame) + (ll "Trying to downlink") + (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))))) + + (define (send-to-network-server x) (ll "Gateway ~a forwarding ~a" id x) (put-message network (make-network-event id x))) @@ -169,6 +223,8 @@ (forever (let* ((ev (get-message in))) (match ev + (($ <network-event> id frame) + (send-to-device frame)) (($ <radio-event> 'uplink-start channel-n frame) #f) (($ <radio-event> 'interference channel-n frame) (set! pending-interferences (cons ev pending-interferences))) @@ -179,7 +235,7 @@ pending-interferences))) (set! pending-interferences not-mine) (when (null? mine) ;; TODO - (forward-frame frame))))))))) + (send-to-network-server frame))))))))) (define (make-radio in end-devices gateways) @@ -238,8 +294,8 @@ (frame-FCnt frame) channel-n) (use-lorawan-channel! channel-n ev) - (let ((chan (hash-table-ref end-devices - (frame-DeviceAddr frame))) + (let ((chan (device-channel (hash-table-ref end-devices + (frame-DeviceAddr frame)))) (ints (interferences ev channel-n))) (put-message chan ev) (for-each @@ -261,7 +317,7 @@ (put-message (device-channel gateway) ev)))))) (($ <radio-event> 'downlink-end channel-n frame) - (ll "Device ~a ended uplink-frame #~a on channel ~a" + (ll "Device ~a ended downlink-frame #~a on channel ~a" (frame-DeviceAddr frame) (frame-FCnt frame) channel-n) @@ -278,7 +334,19 @@ (forever (match (get-message upstream) (($ <network-event> gateway-id frame) - (ll "Network event happend!")))))) + (ll "Network event happend!") + ;; TODO answer properly + (spawn-fiber + (lambda () + (sleep RECEIVE_DELAY1) + (put-message + (device-channel (hash-table-ref gateways gateway-id)) + (make-network-event + gateway-id + (make-frame (frame-FCnt frame) + (frame-DeviceAddr frame) + #f + 'hello)))))))))) |