diff options
Diffstat (limited to 'simulation.scm')
| -rw-r--r-- | simulation.scm | 130 |
1 files changed, 64 insertions, 66 deletions
diff --git a/simulation.scm b/simulation.scm index 9e7a506..d708567 100644 --- a/simulation.scm +++ b/simulation.scm @@ -34,7 +34,7 @@ (define (rand-time) (random 20)) -(define (make-class-a id initial-channel upstream downstream) +(define (make-class-a id initial-channel upstream-chn downstream-chn) ;; Make all atomic (define channel initial-channel) (define listening? (make-atomic-box #f)) @@ -47,36 +47,36 @@ (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 (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) @@ -85,14 +85,13 @@ (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))))))) + (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) @@ -107,39 +106,38 @@ (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))))))))) + (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)))) + (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 |