• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1#!/bin/bash
2# -*- scheme -*-
3exec guile --debug -l $0 -e main -- "$@"
4!#
5
6;; GStreamer
7;; Copyright (C) 2005 Andy Wingo <wingo at pobox.com>
8
9;; This program is free software; you can redistribute it and/or
10;; modify it under the terms of the GNU General Public License as
11;; published by the Free Software Foundation; either version 2 of
12;; the License, or (at your option) any later version.
13;;
14;; This program is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17;; GNU General Public License for more details.
18;;
19;; You should have received a copy of the GNU General Public License
20;; along with this program; if not, contact:
21;;
22;; Free Software Foundation           Voice:  +1-617-542-5942
23;; 51 Franklin St, Fifth Floor        Fax:    +1-617-542-2652
24;; Boston, MA  02110-1301,  USA       gnu@gnu.org
25
26
27;;; Commentary:
28;;
29;; Network clock simulator.
30;;
31;; Simulates the attempts of one clock to synchronize with another over
32;; the network. Packets are sent out with a local timestamp, and come
33;; back with the remote time added on to the packet. The remote time is
34;; assumed to have been observed at the local time in between sending
35;; the query and receiving the reply.
36;;
37;; The local clock will attempt to adjust its rate and offset by fitting
38;; a line to the last N datapoints on hand, by default 32. A better fit,
39;; as measured by the correlation coefficient, will result in a longer
40;; time before the next query. Bad fits or a not-yet-full set of data
41;; will result in many queries in quick succession.
42;;
43;; The rate and offset are set directly to the slope and intercept from
44;; the linear regression. This results in discontinuities in the local
45;; time. As clock times must be monotonically increasing, a jump down in
46;; time will result instead in time standing still for a while. Smoothly
47;; varying the rate such that no discontinuities are present has not
48;; been investigated.
49;;
50;; Implementation-wise, this simulator processes events and calculates
51;; times discretely. Times are represented as streams, also known as
52;; lazy lists. This is an almost-pure functional simulator. The thing to
53;; remember while reading is that stream-cons does not evaluate its
54;; second argument, rather deferring that calculation until stream-cdr
55;; is called. In that way all times are actually infinite series.
56;;
57;; Usage: See network-clock.scm --help.
58;;
59;;; Code:
60
61
62(use-modules (ice-9 popen))
63
64
65(load "network-clock-utils.scm")
66
67
68(define (time->samples t)
69  (iround (* t *sample-frequency*)))
70
71
72(define (schedule-event events e time)
73  (let lp ((response-time (time->samples time))
74           (stream events))
75    (if (zero? response-time)
76        (if (not (stream-car stream))
77            (stream-cons e (stream-cdr stream))
78            (stream-cons (stream-car stream) (lp 0 (stream-cdr stream))))
79        (stream-cons (stream-car stream) (lp (1- response-time) (stream-cdr stream))))))
80
81(define (schedule-send-time-query events time)
82  (schedule-event events (list 'send-time-query) time))
83
84(define (schedule-time-query events l)
85  (schedule-event events (list 'time-query l)
86                  (+ *send-delay* (random *send-jitter*))))
87
88(define (schedule-time-response events l r)
89  (schedule-event events (list 'time-response l r)
90                  (+ *recv-delay* (random *recv-jitter*))))
91
92(define (network-time remote-time local-time events m b x y t)
93  (let ((r (stream-car remote-time))
94        (l (stream-car local-time))
95        (event (stream-car events))
96        (events (stream-cdr events)))
97
98    (define (next events m b x y t)
99      (stream-cons
100       (+ (* m l) b)
101       (network-time
102        (stream-cdr remote-time) (stream-cdr local-time) events m b x y t)))
103
104    (case (and=> event car)
105      ((send-time-query)
106       (cond
107        ((< (random 1.0) *packet-loss*)
108         (debug "; dropped time query: ~a\n" l)
109         (print-event 'packet-lost l (+ (* m l) b))
110         (next events m b x y (time->samples *timeout*)))
111        (else
112         (debug "; sending time query: ~a\n" l)
113         (print-event 'packet-sent l (+ (* m l) b))
114         (next (schedule-time-query events l) m b x y (time->samples *timeout*)))))
115
116      ((time-query)
117       (debug "; time query received, replying with ~a\n" r)
118       (next (schedule-time-response events (cadr event) r) m b x y (and t (1- t))))
119
120      ((time-response)
121       (let ((x (q-push x (avg (cadr event) l)))
122             (y (q-push y (caddr event))))
123         (call-with-values
124             (lambda () (least-squares (q-head x) (q-head y)))
125           (lambda (m b r-squared)
126             (define (next-time)
127               (max
128                (if (< (length (q-head x)) *window-size*)
129                    0
130                    (/ 1 (- 1 (min r-squared 0.99999)) 1000))
131                0.10))
132             (debug "; new slope and offset: ~a ~a (~a)\n" m b r-squared)
133             (print-event 'packet-observed (avg (cadr event) l) (caddr event))
134             (print-event 'packet-received l (+ (* m l) b))
135             (next (schedule-send-time-query events (next-time)) m b x y #f)))))
136
137      (else
138       (cond
139        ((not t)
140         ;; not waiting for a response
141         (next events m b x y t))
142        ((<= t 0)
143         ;; we timed out
144         (next (schedule-send-time-query events 0.0) m b x y 0))
145        (else
146         (next events m b x y (1- t))))))))
147
148(define (run-simulation remote-speed local-speed)
149  (let ((absolute-time (arithmetic-series 0.0 (/ 1.0 *sample-frequency*)))
150        (event-stream (stream-of #f)))
151    (let ((remote-time (scale-stream absolute-time remote-speed))
152          (local-time (scale-stream absolute-time local-speed)))
153      (values
154       absolute-time
155       remote-time
156       local-time
157       (network-time
158        remote-time
159        local-time
160        (schedule-send-time-query event-stream 0.0)
161        1.0
162        (stream-car local-time)
163        (make-q (list (stream-car local-time)))
164        (make-q (list (stream-car remote-time)))
165        #f)))))
166
167(define (print-simulation)
168  (display "Absolute time; Remote time; Local time; Network time\n")
169  (call-with-values
170      (lambda () (run-simulation *remote-rate* *local-rate*))
171    (lambda streams
172      (apply
173       stream-while
174       (lambda (a r l n) (<= a *total-time*))
175       (lambda (a r l n) (format #t "~a ~a ~a ~a\n" a r l n))
176       streams))))
177
178(define (plot-simulation)
179  (let ((port (open-output-pipe "./plot-data Network Clock Simulation")))
180    (with-output-to-port port
181      print-simulation)
182    (close-pipe port)))
183
184
185(define-parameter *sample-frequency* 40)
186(define-parameter *send-delay* 0.1)
187(define-parameter *recv-delay* 0.1)
188(define-parameter *packet-loss* 0.01)
189(define-parameter *send-jitter* 0.1)
190(define-parameter *recv-jitter* 0.1)
191(define-parameter *window-size* 32)
192(define-parameter *local-rate* 1.0)
193(define-parameter *remote-rate* 1.1)
194(define-parameter *total-time* 5.0)
195(define-parameter *timeout* 1.0)
196(define-parameter *debug* #f)
197(define-parameter *with-graph* #t)
198
199
200(define (main args)
201  (parse-parameter-arguments (cdr args))
202  (if *with-graph*
203      (plot-simulation)
204      (print-simulation))
205  (quit))
206