mirror of
https://gitlab.freedesktop.org/gstreamer/gstreamer.git
synced 2024-09-08 13:18:52 +00:00
Original commit message from CVS: 2005-11-17 Andy Wingo <wingo@pobox.com> * check/Makefile.am (check_PROGRAMS): * check/net/gstnetclientclock.c: Add a most minimal test for the net client clock. More to come later. * gst/net/gstnet.h: * gst/net/Makefile.am: Add netclientclock. * gst/net/gstnetclientclock.h: * gst/net/gstnetclientclock.c: New files, implement an untested GstClock that takes its time from a network time provider. Implements the algorithm in network-clock.scm. * tests/network-clock.scm (*window-size*): Rename from *queue-length*. * tests/network-clock.scm (network-time): * tests/network-clock-utils.scm (q-push): Update callers.
205 lines
7.3 KiB
Scheme
Executable file
205 lines
7.3 KiB
Scheme
Executable file
#!/bin/bash
|
|
# -*- scheme -*-
|
|
exec guile --debug -l $0 -e main -- "$@"
|
|
!#
|
|
|
|
;; GStreamer
|
|
;; Copyright (C) 2005 Andy Wingo <wingo at pobox.com>
|
|
|
|
;; This program is free software; you can redistribute it and/or
|
|
;; modify it under the terms of the GNU General Public License as
|
|
;; published by the Free Software Foundation; either version 2 of
|
|
;; the License, or (at your option) any later version.
|
|
;;
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program; if not, contact:
|
|
;;
|
|
;; Free Software Foundation Voice: +1-617-542-5942
|
|
;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
|
|
;; Boston, MA 02111-1307, USA gnu@gnu.org
|
|
|
|
|
|
;;; Commentary:
|
|
;;
|
|
;; Network clock simulator.
|
|
;;
|
|
;; Simulates the attempts of one clock to synchronize with another over
|
|
;; the network. Packets are sent out with a local timestamp, and come
|
|
;; back with the remote time added on to the packet. The remote time is
|
|
;; assumed to have been observed at the local time in between sending
|
|
;; the query and receiving the reply.
|
|
;;
|
|
;; The local clock will attempt to adjust its rate and offset by fitting
|
|
;; a line to the last N datapoints on hand, by default 32. A better fit,
|
|
;; as measured by the correlation coefficient, will result in a longer
|
|
;; time before the next query. Bad fits or a not-yet-full set of data
|
|
;; will result in many queries in quick succession.
|
|
;;
|
|
;; The rate and offset are set directly to the slope and intercept from
|
|
;; the linear regression. This results in discontinuities in the local
|
|
;; time. As clock times must be monotonically increasing, a jump down in
|
|
;; time will result instead in time standing still for a while. Smoothly
|
|
;; varying the rate such that no discontinuities are present has not
|
|
;; been investigated.
|
|
;;
|
|
;; Implementation-wise, this simulator processes events and calculates
|
|
;; times discretely. Times are represented as streams, also known as
|
|
;; lazy lists. This is an almost-pure functional simulator. The thing to
|
|
;; remember while reading is that stream-cons does not evaluate its
|
|
;; second argument, rather deferring that calculation until stream-cdr
|
|
;; is called. In that way all times are actually infinite series.
|
|
;;
|
|
;; Usage: See network-clock.scm --help.
|
|
;;
|
|
;;; Code:
|
|
|
|
|
|
(use-modules (ice-9 popen))
|
|
|
|
|
|
(load "network-clock-utils.scm")
|
|
|
|
|
|
(define (time->samples t)
|
|
(iround (* t *sample-frequency*)))
|
|
|
|
|
|
(define (schedule-event events e time)
|
|
(let lp ((response-time (time->samples time))
|
|
(stream events))
|
|
(if (zero? response-time)
|
|
(if (not (stream-car stream))
|
|
(stream-cons e (stream-cdr stream))
|
|
(stream-cons (stream-car stream) (lp 0 (stream-cdr stream))))
|
|
(stream-cons (stream-car stream) (lp (1- response-time) (stream-cdr stream))))))
|
|
|
|
(define (schedule-send-time-query events time)
|
|
(schedule-event events (list 'send-time-query) time))
|
|
|
|
(define (schedule-time-query events l)
|
|
(schedule-event events (list 'time-query l)
|
|
(+ *send-delay* (random *send-jitter*))))
|
|
|
|
(define (schedule-time-response events l r)
|
|
(schedule-event events (list 'time-response l r)
|
|
(+ *recv-delay* (random *recv-jitter*))))
|
|
|
|
(define (network-time remote-time local-time events m b x y t)
|
|
(let ((r (stream-car remote-time))
|
|
(l (stream-car local-time))
|
|
(event (stream-car events))
|
|
(events (stream-cdr events)))
|
|
|
|
(define (next events m b x y t)
|
|
(stream-cons
|
|
(+ (* m l) b)
|
|
(network-time
|
|
(stream-cdr remote-time) (stream-cdr local-time) events m b x y t)))
|
|
|
|
(case (and=> event car)
|
|
((send-time-query)
|
|
(cond
|
|
((< (random 1.0) *packet-loss*)
|
|
(debug "; dropped time query: ~a\n" l)
|
|
(print-event 'packet-lost l (+ (* m l) b))
|
|
(next events m b x y (time->samples *timeout*)))
|
|
(else
|
|
(debug "; sending time query: ~a\n" l)
|
|
(print-event 'packet-sent l (+ (* m l) b))
|
|
(next (schedule-time-query events l) m b x y (time->samples *timeout*)))))
|
|
|
|
((time-query)
|
|
(debug "; time query received, replying with ~a\n" r)
|
|
(next (schedule-time-response events (cadr event) r) m b x y (and t (1- t))))
|
|
|
|
((time-response)
|
|
(let ((x (q-push x (avg (cadr event) l)))
|
|
(y (q-push y (caddr event))))
|
|
(call-with-values
|
|
(lambda () (least-squares (q-head x) (q-head y)))
|
|
(lambda (m b r-squared)
|
|
(define (next-time)
|
|
(max
|
|
(if (< (length (q-head x)) *window-size*)
|
|
0
|
|
(/ 1 (- 1 (min r-squared 0.99999)) 1000))
|
|
0.10))
|
|
(debug "; new slope and offset: ~a ~a (~a)\n" m b r-squared)
|
|
(print-event 'packet-observed (avg (cadr event) l) (caddr event))
|
|
(print-event 'packet-received l (+ (* m l) b))
|
|
(next (schedule-send-time-query events (next-time)) m b x y #f)))))
|
|
|
|
(else
|
|
(cond
|
|
((not t)
|
|
;; not waiting for a response
|
|
(next events m b x y t))
|
|
((<= t 0)
|
|
;; we timed out
|
|
(next (schedule-send-time-query events 0.0) m b x y 0))
|
|
(else
|
|
(next events m b x y (1- t))))))))
|
|
|
|
(define (run-simulation remote-speed local-speed)
|
|
(let ((absolute-time (arithmetic-series 0.0 (/ 1.0 *sample-frequency*)))
|
|
(event-stream (stream-of #f)))
|
|
(let ((remote-time (scale-stream absolute-time remote-speed))
|
|
(local-time (scale-stream absolute-time local-speed)))
|
|
(values
|
|
absolute-time
|
|
remote-time
|
|
local-time
|
|
(network-time
|
|
remote-time
|
|
local-time
|
|
(schedule-send-time-query event-stream 0.0)
|
|
1.0
|
|
(stream-car local-time)
|
|
(make-q (list (stream-car local-time)))
|
|
(make-q (list (stream-car remote-time)))
|
|
#f)))))
|
|
|
|
(define (print-simulation)
|
|
(display "Absolute time; Remote time; Local time; Network time\n")
|
|
(call-with-values
|
|
(lambda () (run-simulation *remote-rate* *local-rate*))
|
|
(lambda streams
|
|
(apply
|
|
stream-while
|
|
(lambda (a r l n) (<= a *total-time*))
|
|
(lambda (a r l n) (format #t "~a ~a ~a ~a\n" a r l n))
|
|
streams))))
|
|
|
|
(define (plot-simulation)
|
|
(let ((port (open-output-pipe "./plot-data Network Clock Simulation")))
|
|
(with-output-to-port port
|
|
print-simulation)
|
|
(close-pipe port)))
|
|
|
|
|
|
(define-parameter *sample-frequency* 40)
|
|
(define-parameter *send-delay* 0.1)
|
|
(define-parameter *recv-delay* 0.1)
|
|
(define-parameter *packet-loss* 0.01)
|
|
(define-parameter *send-jitter* 0.1)
|
|
(define-parameter *recv-jitter* 0.1)
|
|
(define-parameter *window-size* 32)
|
|
(define-parameter *local-rate* 1.0)
|
|
(define-parameter *remote-rate* 1.1)
|
|
(define-parameter *total-time* 5.0)
|
|
(define-parameter *timeout* 1.0)
|
|
(define-parameter *debug* #f)
|
|
(define-parameter *with-graph* #t)
|
|
|
|
|
|
(define (main args)
|
|
(parse-parameter-arguments (cdr args))
|
|
(if *with-graph*
|
|
(plot-simulation)
|
|
(print-simulation))
|
|
(quit))
|