blob: d708567c7aafa63b452c615fa25abf4a2b683901 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
(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-chn downstream-chn)
;; 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))
(define (upstream)
(define current-message 0)
(forever
(sleep (rand-time))
(put-message upstream-chn (make-message current-message id channel 'data-start))
(sleep time-on-air)
(put-message upstream-chn (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 (downstream)
(forever
(let ((msg (get-message downstream-chn)))
(when (atomic-box-ref listening?)
(ll "Device: ~a Received: ~a" id msg)
#;(match (message-body msg)
(('ack) (confirm X)))))))
(lambda ()
(spawn-fiber upstream)
(spawn-fiber downstream)))
(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
(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))
(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)))
(spawn-fiber (make-class-a 1 1 radio-chn (make-channel)))
(spawn-fiber (make-class-a 2 1 radio-chn (make-channel)))
(spawn-fiber (make-class-a 3 1 radio-chn (make-channel)))
(spawn-fiber (make-class-a 4 1 radio-chn (make-channel)))
(spawn-fiber (make-gateway 5 radio-chn gateway-chn))
(spawn-fiber (make-radio radio-chn (list gateway-chn)))))
(run-fibers
run-simulation
#:drain? #t)
|
