1 files changed, 146 insertions, 0 deletions
diff --git a/simulation.scm b/simulation.scm
new file mode 100644
index 0000000..9e7a506
--- /dev/null
+++ b/simulation.scm
@@ -0,0 +1,146 @@
+(define-module (simulation)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (ice-9 atomic)
+  #:use-module (ice-9 match)
+  #:use-module (fibers)
+  #:use-module (fibers channels)
+  #:use-module (fibers conditions)
+  #:use-module (fibers operations)
+  #:use-module (fibers timers))
+
+;; TODO: put a time limit as a parameter
+(define-syntax-rule (forever exp ...)
+  (let loop ()
+    (begin exp ...)
+    (loop)))
+
+(define (ll f . data)
+  (let ((now (gettimeofday)))
+    (format #t "~a~a - ~?~%" (car now) (cdr now) f data)))
+
+(define (vector-append! vec value)
+  (vector-set! vec (vector-length vec) value))
+
+(define-record-type message
+  (make-message id device-id channel-n body)
+  message?
+  (id message-id)
+  (device-id message-device-id)
+  (channel-n message-channel-n)
+  (body message-body))
+
+
+(define (rand-time)
+  (random 20))
+
+(define (make-class-a id initial-channel upstream downstream)
+  ;; Make all atomic
+  (define channel initial-channel)
+  (define listening? (make-atomic-box #f))
+
+  ;; TODO: Unhardcode me
+  (define time-on-air 1)
+  (define rx1 1)
+  (define rx2 (+ 1 rx1))
+  (define receive-delay-1 1)
+  (define receive-delay-2 2)
+  ;(define sent-to-confirm (make-vector))
+
+  ;; Downstream, always listen and update my state
+  (spawn-fiber
+    (lambda ()
+      (forever
+        (let ((msg (get-message downstream)))
+          (when (atomic-box-ref listening?)
+            (ll "Device: ~a Received: ~a" id msg)
+           #;(match (message-body msg)
+                  (('ack) (confirm X))))))))
+
+  ;; Upstream send data randomply
+  (spawn-fiber
+    (lambda ()
+      (define current-message 0)
+      (forever
+        (sleep (rand-time))
+        (put-message upstream (make-message current-message id channel 'data-start))
+        (sleep time-on-air)
+        (put-message upstream (make-message current-message id channel 'data-end))
+        (set! current-message (1+ current-message))
+        (sleep receive-delay-1)
+        (atomic-box-set! listening? #t)
+        ;; TODO: maybe synchronization doesn't work because we do too many things
+        (sleep rx1)
+        (atomic-box-set! listening? #f)
+        ;; (when not-answered ...)
+        (sleep (- receive-delay-2 receive-delay-1))
+        (atomic-box-set! listening? #t)
+        (sleep rx2)
+        (atomic-box-set! listening? #f)))))
+
+(define (make-gateway id upstream downstream)
+  #;(define (ack-confirmed-data to channel seq-number)
+    (spawn-fiber
+      (sleep RX1)
+      (put-message downstream (make-message to channel 'ack seq-number))))
+
+  ;; Upstream: listen, and answer in new fibers
+  (spawn-fiber
+    (lambda ()
+      (forever
+        (let ((msg (get-message upstream)))
+          (ll "Gateway ~a: Data #~a got from ~a"
+               id
+               (message-id msg)
+               (message-device-id msg)))))))
+
+
+(define (make-radio in gateways)
+
+  ;(define devices (hash-map ...)) ;; it needs a device-id <-> channel mapping
+  ;; in: listen from devices: check collisions and power transmission
+  ;; capabilities: we could check distance to other devices for this!
+  ;;
+  (define started '())
+
+  (define (interference? msg started-messages)
+    (any (lambda (x) (= (message-channel-n msg) (message-channel-n x)))
+         started-messages))
+
+  (spawn-fiber
+    (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!!!!!!")
+               (for-each (lambda (gateway)
+                           (put-message gateways
+                                        (make-message (message-id msg)
+                                                      (message-device-id msg)
+                                                      (message-channel-n msg)
+                                                      'data)))
+                         gateways)))))))))
+
+
+
+(define (run-simulation)
+  (let* ((radio-chn (make-channel))
+         (gateway-chn (make-channel)))
+    (make-class-a 1 1 radio-chn (make-channel))
+    (make-class-a 2 1 radio-chn (make-channel))
+    (make-class-a 3 1 radio-chn (make-channel))
+    (make-class-a 4 1 radio-chn (make-channel))
+    (make-gateway 5 radio-chn gateway-chn)
+    (make-radio radio-chn (list gateway-chn))))
+
+(run-fibers
+  run-simulation
+  #:drain? #t)