blob: c667750f151e552c27e2a568225e000a237d712d (
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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
(define-module (simulation)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-69)
#: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-record-type <event>
(make-event type data)
event?
(type event-type)
(data event-data))
(define-record-type <message>
(make-message id device-id channel-n uplink? body)
message?
(id message-id)
(device-id message-device-id)
(channel-n message-channel-n)
(uplink? message-uplink?)
(body message-body))
(define-record-type <device>
(make-device channel thunk)
device?
(channel device-channel)
(thunk device-thunk))
(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))
(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)
;; 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 end-devices 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 ((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 (run-simulation)
(let* ((radio-chn (make-channel))
(end-devices (make-hash-table))
(gateways (make-hash-table)))
(for-each
(lambda (id)
(let ((chn (make-channel)))
(hash-table-set!
end-devices id
(make-device chn (make-class-a id 1 radio-chn chn)))))
(iota 6))
(for-each
(lambda (id)
(let ((chn (make-channel)))
(hash-table-set!
gateways id
(make-device chn (make-gateway id chn radio-chn)))))
(iota 6 10))
(spawn-fiber (make-radio radio-chn end-devices gateways))
(hash-table-walk end-devices
(lambda (_ device) (spawn-fiber (device-thunk device))))
(hash-table-walk gateways
(lambda (_ device) (spawn-fiber (device-thunk device))))))
(run-fibers
run-simulation
#:drain? #t)
|
