mirror of
https://gitlab.freedesktop.org/gstreamer/gstreamer.git
synced 2024-07-02 04:35:55 +00:00
c1d34b8acf
Original commit message from CVS: 2005-07-01 Andy Wingo <wingo@pobox.com> * tests/network-clock.scm: Commentary update. * gst/elements/gstidentity.c (PROP_DUPLICATE): Gone daddy gone. Didn't really make sense, not implementable with basetransform, etc. (gst_identity_transform): Unref inbuf via make_writable. Feeble attempt at implementing the sync property, needs an unlock method. * gst/base/gstbasetransform.c (gst_base_transform_transform_caps): New func, by default returns the same caps (the identity transformation). (gst_base_transform_getcaps): Uses transform_caps to return something sensible. (gst_base_transform_setcaps): Complicated logic to get caps on both pads, even if they are different, and to call set_caps once for every time both pads get their caps set. (gst_base_transform_handle_buffer): Give the ref to the transform function. Allows in-place modification of the buffer. * gst/base/gstbasetransform.h (transform_caps): New class method. Given caps on one side, what can I do on the other. (set_caps): Take two caps, one for each side of the element. * gst/gstpad.h: * gst/gstpad.c (gst_pad_fixate_caps): Change prototype to modify caps in place. This is safe because we can check the mutability of the caps, and a good idea because fixate functions are just called as a matter of last resort. (Not actually implemented.) (gst_pad_set_caps): If the caps we're setting is actually the same as the existing pad caps, just update the pointer without calling setcaps. Assert that caps is either NULL or fixed, as per the docs. * gst/gstghostpad.c: Update for fixate changes.
206 lines
7.3 KiB
Scheme
Executable file
206 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)) *queue-length*)
|
|
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 *queue-length* 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))
|