1#!/bin/sh 2# the next line restarts using tclsh \ 3exec tclsh "$0" "$@" 4 5# $Id: jitter.tcl,v 1.7 2004/08/25 19:26:26 baum Exp $ 6 7# ensure that "." is the decimal point 8unset -nocomplain env(LC_ALL) 9set ::env(LC_NUMERIC) "C" 10 11set done 0 12set last0 0 13set last1 0 14set bgVal 0.1 15set exit 0 16 17proc background { } { 18 global bgVal 19 set bgVal [expr {sin( $bgVal )}] 20 after 1 background 21} 22 23proc callFunc { interval isTcl } { 24 set numCalls 10 25 26 set clock$isTcl [clock clicks -milliseconds] 27 28 global last$isTcl values$isTcl done 29 if { [set last$isTcl] != 0 } { 30 lappend values$isTcl [expr {[set clock$isTcl]-[set last$isTcl]}] 31 incr ::no$isTcl 32 } else { 33 set ::no$isTcl 0 34 set values$isTcl {} 35 } 36 37 if { [set ::no$isTcl] == $numCalls } { 38 set mean 0 39 set jitter 0 40 foreach val [set values$isTcl] { 41 incr mean $val 42 } 43 set mean [expr {$mean/double($numCalls)}] 44 set max 0 45 foreach el [set values$isTcl] { 46 set val [expr {abs($el-$mean)}] 47 if { $val > $max } { 48 set max $val 49 } 50 set jitter [expr {$jitter+$val}] 51 } 52 set jitter [expr {$jitter/double($numCalls)}] 53 54 if { $isTcl } { 55 set name Tcl 56 } else { 57 set name Gnocl 58 } 59 puts [format "%6s %3d mean: %5.1f diff: %4.1f jitter: %3.1f max: %4.1f" \ 60 $name $interval $mean [expr {$mean-$interval}] $jitter $max] 61 set last$isTcl 0 62 incr done 63 if { $isTcl == 0 } { 64 return -code break 65 } 66 } else { 67 set last$isTcl [clock clicks -milliseconds] 68 if { $isTcl } { 69 after $interval callFunc $interval 1 70 } 71 } 72} 73 74proc doIt { } { 75 # foreach el {0 1 5 9 10 11 20 25 50 100} 76 foreach el {11 21} { 77 callFunc $el 1 78 if { [catch {package present Gnocl}] == 0 } { 79 gnocl::callback create "callFunc $el 0" -interval $el 80 vwait ::done 81 } 82 vwait ::done 83 } 84 85 if { $::exit } { 86 exit 87 } 88} 89 90# background 91 92puts "pure Tcl" 93doIt 94 95puts "\npure Tcl with gnocl loaded" 96set auto_path [linsert $auto_path 0 [file join [file dirname [info script]] ../src]] 97package require Gnocl 98set id [gnocl::callback create {puts -nonewline ""} -interval idle ] 99after 100 "gnocl::callback delete $id" 100 101doIt 102 103 104#gnocl::callback create {puts -nonewline "A"; flush stdout} -interval 200 105#gnocl::callback create {puts -nonewline "B"; flush stdout} -interval 300 106 107puts "\ngnocl::mainLoop" 108after 500 doIt 109set exit 1 110gnocl::mainLoop -timeout 10 111 112 113 114