From 6a14fc35a2684b5be69df7dc4046a3b9c459627d Mon Sep 17 00:00:00 2001 From: Ekaitz Zarraga Date: Sun, 15 Dec 2024 21:00:21 +0100 Subject: simulation: send events to radio, messages to devices --- simulation.scm | 78 ++++++++++++++++++++++++++++++++-------------------------- 1 file changed, 43 insertions(+), 35 deletions(-) diff --git a/simulation.scm b/simulation.scm index 01f31a1..c667750 100644 --- a/simulation.scm +++ b/simulation.scm @@ -20,6 +20,12 @@ (let ((now (gettimeofday))) (format #t "~a~a - ~?~%" (car now) (cdr now) f data))) +(define-record-type + (make-event type data) + event? + (type event-type) + (data event-data)) + (define-record-type (make-message id device-id channel-n uplink? body) message? @@ -29,6 +35,11 @@ (uplink? message-uplink?) (body message-body)) +(define-record-type + (make-device channel thunk) + device? + (channel device-channel) + (thunk device-thunk)) (define (rand-time) (random 20)) @@ -50,9 +61,10 @@ (define current-message 0) (forever (sleep (rand-time)) - (put-message upstream-chn (make-message current-message id channel #t 'data-start)) - (sleep time-on-air) - (put-message upstream-chn (make-message current-message id channel #t 'data-end)) + (let ((message (make-message current-message id channel #t 'data))) + (put-message upstream-chn (make-event 'start message)) + (sleep time-on-air) + (put-message upstream-chn (make-event 'end message))) (set! current-message (1+ current-message)) (sleep receive-delay-1) (atomic-box-set! listening? #t) @@ -107,40 +119,36 @@ (lambda () (forever - (let ((msg (get-message in))) - (match (message-body msg) - ('data-start - (set! started (cons msg started))) - ('data-end - (set! started - (remove! (lambda (x) - (and (= (message-id msg) (message-id x)) - (= (message-device-id msg) (message-device-id x)))) started)) - (if (interference? msg started) - (ll "Interference!!!!!!") - (if (message-uplink? msg) - (hash-for-each (lambda (k gateway) - (put-message (device-channel gateway) - (make-message (message-id msg) - (message-device-id msg) - (message-channel-n msg) - #t - 'data))) - gateways) - (put-message - (device-channel (hash-ref end-devices (message-device-id msg))) - (make-message (message-id msg) - (message-device-id msg) - (message-channel-n msg) - #f - 'ack)))))))))) + (let ((ev (get-message in))) + (match (event-type ev) + ('start + (let ((msg (event-data ev))) + (ll "Device ~a started ~a of message ~a" + (message-device-id msg) + (message-body msg) + (message-id msg)) + (set! started (cons msg started)))) + ('end + (let ((msg (event-data ev))) + (ll "Device ~a finished ~a of message ~a" + (message-device-id msg) + (message-body msg) + (message-id msg)) + (set! started + (remove! (lambda (x) + (and (= (message-id msg) (message-id x)) + (= (message-device-id msg) (message-device-id x)))) started)) + (if (interference? msg started) + (ll "Interference!!!!!!") + (if (message-uplink? msg) + (hash-table-walk gateways + (lambda (k gateway) + (put-message (device-channel gateway) msg))) + (put-message + (device-channel (hash-ref end-devices (message-device-id msg))) + msg)))))))))) -(define-record-type - (make-device channel thunk) - device? - (channel device-channel) - (thunk device-thunk)) (define (run-simulation) -- cgit v1.2.3