latency-histogram
1 #!/usr/bin/tclsh 2 # 3 4 # for Usage: 5 # latency-histogram --help | -? 6 7 #----------------------------------------------------------------------- 8 # Copyright: 2012-2016 9 # Author: Dewey Garrett <dgarrett@panix.com> 10 # 11 # This program is free software; you can redistribute it and/or modify 12 # it under the terms of the GNU General Public License as published by 13 # the Free Software Foundation; either version 2 of the License, or 14 # (at your option) any later version. 15 # 16 # This program is distributed in the hope that it will be useful, 17 # but WITHOUT ANY WARRANTY; without even the implied warranty of 18 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 # GNU General Public License for more details. 20 # 21 # You should have received a copy of the GNU General Public License 22 # along with this program; if not, write to the Free Software 23 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 24 #----------------------------------------------------------------------- 25 26 27 proc set_defaults {} { 28 set ::LH(start) [clock seconds] 29 # don't include glxgears, error suffices 30 program_check {halrun halcmd lsmod pgrep pkill hostname} 31 if {[string first rtai [string tolower $::tcl_platform(osVersion)]] >=0} { 32 set ::LH(rtai) rtai 33 set ::LH(realtime) [exec linuxcnc_var REALTIME] 34 program_check $::LH(realtime) 35 } 36 37 set ::LH(use_x) 1 38 set ::LH(verbose) 0 39 set ::LH(opt,show) 0 40 41 set name [file tail [file rootname $::argv0]] 42 set ::LH(compname) latencybins 43 set ::LH(dir,screenshot) /tmp/$name 44 if [catch {file mkdir $::LH(dir,screenshot)} msg] { 45 set ::LH(dir,screenshot) ~ 46 } 47 48 set ::LH(note,txt) "" 49 set ::LH(date) [clock format [clock seconds] -format "%d%b%Y"] 50 51 set ::LH(y,logscale) 1 52 53 set ::LH(threads) {base servo} 54 55 set ::LH(base,name) base 56 set ::LH(servo,name) servo 57 58 set ::LH(base,color) seagreen 59 set ::LH(servo,color) blue 60 61 set ::LH(base,period,ns) 25000 62 set ::LH(servo,period,ns) 1000000 63 64 set ::LH(base,period,ns,min) 5000 65 set ::LH(servo,period,ns,min) 25000 66 67 set ::LH(base,binsize,ns) 100 68 set ::LH(servo,binsize,ns) 100 69 70 # must be integer for window naming and .comp file usage: 71 set ::LH(base,maxbins) 200 72 set ::LH(servo,maxbins) 200 73 74 set ::LH(base,p,more) 0 75 set ::LH(base,n,more) 0 76 set ::LH(servo,p,more) 0 77 set ::LH(serve,n,more) 0 78 79 set ::LH(after,repeat) '' 80 } ;# set_defaults 81 82 proc program_check {plist} { 83 foreach prog $plist { 84 if [catch { 85 set ::LH(prog,$prog) [exec which $prog] 86 } msg] { 87 set msg "Cannot find required program named: <$prog>" 88 set msg "$msg\n\nIf Run-in-Place, source rip-environment first" 89 popup $msg 90 exit 1 91 } 92 } 93 } ;# program_check 94 95 proc config {} { 96 while {[llength $::argv] >0} { 97 # beware wish handling of reserved cmdline arguments 98 # lreplace shifts argv for no. of items for each iteration 99 set currentarg [lindex $::argv 0] 100 switch -- $currentarg { 101 -? - --help {usage;exit 0} 102 --logscale {set t [lindex $::argv 1] 103 set ::LH(y,logscale) $t 104 set ::argv [lreplace $::argv 0 0] 105 } 106 --base {set t [lindex $::argv 1] 107 set ::LH(base,period,ns) $t 108 set ::argv [lreplace $::argv 0 0] 109 if {$::LH(base,period,ns) 110 < $::LH(base,period,ns,min)} { 111 puts "base period too small\ 112 min=$::LH(base,period,ns,min)" 113 exit 1 114 } 115 } 116 --servo {set t [lindex $::argv 1] 117 set ::LH(servo,period,ns) $t 118 set ::argv [lreplace $::argv 0 0] 119 if {$::LH(servo,period,ns) 120 < $::LH(servo,period,ns,min)} { 121 puts "servo period too small\ 122 min=$::LH(servo,period,ns,min)" 123 exit 1 124 } 125 } 126 --bbinsize {set t [lindex $::argv 1] 127 set ::LH(base,binsize,ns) $t 128 set ::argv [lreplace $::argv 0 0] 129 } 130 --sbinsize {set t [lindex $::argv 1] 131 set ::LH(servo,binsize,ns) $t 132 set ::argv [lreplace $::argv 0 0] 133 } 134 --sbins {set t [lindex $::argv 1] 135 set ::LH(servo,maxbins) $t 136 set ::argv [lreplace $::argv 0 0] 137 } 138 --bbins {set t [lindex $::argv 1] 139 set ::LH(base,maxbins) $t 140 set ::argv [lreplace $::argv 0 0] 141 } 142 --text {set t [lindex $::argv 1] 143 set ::LH(note,txt) $t 144 set ::argv [lreplace $::argv 0 0] 145 } 146 --nobase {set ::LH(threads) {servo} 147 } 148 --show {set ::LH(opt,show) 1 149 } 150 --verbose {set ::LH(verbose) 1 151 } 152 --nox {set ::LH(use_x) 0 153 } 154 default {lappend unknownargs $currentarg} 155 } 156 set ::argv [lreplace $::argv 0 0] 157 } ;# while 158 if [info exists unknownargs] { 159 puts "\nIgnoring unknown args: <$unknownargs>" 160 } 161 if {$::LH(base,period,ns) > $::LH(servo,period,ns)} { 162 popup "base period must be less than servo period" 163 exit 1 164 } 165 166 set ::LH(title) "$::argv0" 167 168 foreach thd $::LH(threads) { 169 # initial delay for reading by index 170 set ms [expr $::LH($thd,period,ns)/1000000] 171 if {$ms > 1} { 172 set ::LH($thd,dly,ms) $ms 173 } else { 174 set ::LH($thd,dly,ms) 1 ;# minimum interval (mS) for after cmd 175 } 176 177 if {[expr $::LH($thd,binsize,ns) % 10] != 0} { 178 puts "$::argv0: \[sb\]binsize must be multiple of 10 nS" 179 exit 1 180 } 181 182 # guard for lat32 limit of 2.147 sec 183 if {[expr $::LH($thd,binsize,ns) * $::LH($thd,maxbins)] > 2000000000} { 184 puts "Measurement interval too big for $thd thread" 185 puts "Reduce bins or increase binsize" 186 exit 1 187 } 188 189 # uS display only 190 set ::LH($thd,binsize,us) [expr ($::LH($thd,binsize,ns)/1000.)] 191 } 192 set ::LH(info) [other_info] 193 set ::LH(processor) [processor_info] 194 } ;# config 195 196 proc other_info {} { 197 if [info exists ::env(DISPLAY)] { 198 set display "DISPLAY=$::env(DISPLAY)" 199 } else { 200 set display "DISPLAY=?" 201 } 202 set linuxcncversion [exec linuxcnc_var LINUXCNCVERSION] 203 return "\ 204 $::tcl_platform(machine) \ 205 $::tcl_platform(osVersion) \ 206 $linuxcncversion \ 207 $display \ 208 " 209 } ;# other_info 210 211 proc processor_info {} { 212 set cmdline [exec cat /proc/cmdline] 213 set idx [string first isolcpus $cmdline] 214 if {$idx < 0} { 215 set isolcpus no_isolcpus 216 } else { 217 set tmp [string range $cmdline $idx end] 218 set tmp "$tmp " ;# add trailing blank 219 set isolcpus [string range $tmp 0 [expr -1 + [string first " " $tmp]]] 220 } 221 set fd [open /proc/cpuinfo] 222 while {![eof $fd]} { 223 gets $fd newline 224 set s [split $newline :] 225 set key [string trim [lindex $s 0]] 226 set key [string map "\" \" _" $key] 227 set v [lindex $s 1] 228 set procinfo($key) $v 229 } 230 close $fd 231 232 set cores "1_core" 233 catch {set cores "$procinfo(cpu_cores) cores"};# item may not exist 234 catch {set cores "[exec getconf _NPROCESSORS_ONLN] cores"};# could fail? 235 236 set model "" 237 catch {set model $procinfo(model_name)} ;# item may not exist 238 set model [string trim $model] 239 240 set vendor_id "" 241 catch {set vendor_id $procinfo(vendor_id)} ;# item may not exist 242 243 # collapse multiple blanks: 244 while 1 {if ![regsub " " $model " " model] break} 245 246 return "\ 247 $cores \ 248 $isolcpus \ 249 $vendor_id \ 250 $model \ 251 " 252 } ;# processor_info 253 254 proc load_packages {} { 255 package require Tclx 256 257 if $::LH(use_x) { 258 package require Tk 259 wm title . $::LH(title) 260 wm protocol . WM_DELETE_WINDOW finish 261 wm withdraw . 262 263 if [catch {package require BLT} msg] { 264 puts $msg 265 puts "To install: sudo apt-get install blt" 266 exit 1 267 } 268 blt::bitmap define nbmap { 269 {8 8} 270 {0xc7,0x8f,0x1f,0x3e,0x7c, 0xf8,0xf1,0xe3} 271 } 272 blt::bitmap define pbmap { 273 {8 8} 274 {0xe3,0xf1,0xf8,0x7c, 0x3e,0x1f,0x8f,0xc7} 275 } 276 if [catch {package require Img} msg] { 277 puts $msg 278 puts "To install: sudo apt-get install libtk-img" 279 exit 1 280 } 281 } 282 283 if { [catch {exec pgrep linuxcnc} msg] \ 284 && [catch {exec pgrep halcmd} msg]} { 285 # puts "ok--not already running hal" 286 } else { 287 wm withdraw . 288 popup "Stop linuxcnc and hal first (try: \$ halrun -U)" 289 exit 1 290 } 291 292 if [info exists ::LH(rtai)] { 293 if [catch {exec lsmod | grep rtai} msg] { 294 # puts ok_to_start_rtai 295 } else { 296 popup "RTAI is already running, (try: \$ halrun -U)" 297 exit 1 298 } 299 exec $::LH(realtime) start & 300 progress "Delay for realtime startup" 301 after 1000 ;# wait to load Hal package 302 } 303 304 # augment ::auto_path for special case: 305 # 1) RIP build (no install) 306 # 2) linuxcnc script called from Application menu 307 if { [info exists ::env(LINUXCNC_TCL_DIR)] 308 && ([lsearch $::auto_path $::env(LINUXCNC_TCL_DIR)] < 0) 309 } { 310 # prepend 311 set ::auto_path [lreplace $::auto_path 0 -1 $::env(LINUXCNC_TCL_DIR)] 312 } 313 if [catch {package require Hal} msg] { 314 puts $msg 315 puts "For a RIP linuxcnc build, source rip-environment in this shell" 316 exit 1 317 } 318 } ;# load_packages 319 320 proc make_gui { {w .} } { 321 set f [frame ${w}fa] 322 pack $f -side top -fill x -expand 1 323 set hname [exec hostname] 324 set user $::tcl_platform(user) 325 pack [label $f.l -anchor w \ 326 -text "$::LH(date) $hname $user $::LH(note,txt)" 327 ] -fill x -expand 1 328 329 set f [frame ${w}fb] 330 pack $f -side top -fill x -expand 1 331 pack [label $f.l -anchor w -text $::LH(info)] -fill x -expand 1 332 333 set f [frame ${w}fc] 334 pack $f -side top -fill x -expand 1 335 pack [label $f.l -anchor w -text $::LH(processor)] -fill x -expand 1 336 337 set fmain [frame ${w}fmain] 338 pack $fmain -side top 339 340 foreach thd $::LH(threads) { 341 set f1 [frame $fmain.$thd -relief groove -bd 2] 342 pack $f1 -side left 343 344 set f [frame $f1.t] 345 pack $f -side top 346 347 set ::LH(w,$thd) $f.graph 348 catch {destroy $::LH(w,$thd)} 349 set per [expr $::LH($thd,period,ns)/1000.0] 350 blt::barchart $::LH(w,$thd) \ 351 -plotbackground honeydew1 \ 352 -cursor arrow \ 353 -title "Latency (uS) $thd thread ($per uSec period\ 354 , binsize=$::LH($thd,binsize,us) uS)" \ 355 -width 480 -height 384 356 pack $::LH(w,$thd) -side left 357 358 xaxis $thd 359 $::LH(w,$thd) axis configure y -logscale $::LH(y,logscale) 360 361 set f [frame $f1.extra12] 362 pack $f -side top -anchor w -fill x -expand 1 363 364 pack [label $f.min -text "min (us)"] \ 365 -side left -anchor e 366 set e [entry $f.emin -textvariable ::LH($thd,latency_min,us) \ 367 -state readonly -justify right -width 9] 368 pack $e -side left -anchor e 369 370 pack [label $f.sdev -text " sdev (us):"] \ 371 -side left 372 set e [entry $f.esdev -textvariable ::LH($thd,latency_sdev,us) \ 373 -state readonly -justify right -width 9] 374 pack $e -side left -anchor e 375 376 set e [entry $f.emax -textvariable ::LH($thd,latency_max,us) \ 377 -state readonly -justify right -width 9] 378 pack $e -side right -anchor e 379 pack [label $f.max -text "max(us)"] \ 380 -side right -anchor e 381 382 if $::LH(opt,show) { 383 set f [frame $f1.extra2] 384 pack $f -side top -anchor w -fill x -expand 1 385 set e [entry $f.emin -textvariable ::LH($thd,n,more) \ 386 -state readonly -justify right -width 9] 387 pack $e -side left -anchor e 388 pack [label $f.min -text "<--off-chart neg bin ct"] \ 389 -side left -anchor e 390 set ::LH(w,$thd,negbins) $e 391 392 set e [entry $f.emax -textvariable ::LH($thd,p,more) \ 393 -state readonly -justify right -width 9] 394 pack $e -side right -anchor e 395 pack [label $f.max -text "off-chart pos bin ct-->"] \ 396 -side right -anchor e 397 set ::LH(w,$thd,posbins) $e 398 } else { 399 set ::LH(w,$thd,negbins) placeholder 400 set ::LH(w,$thd,posbins) placeholder 401 proc placeholder {args} return 402 } 403 404 set f [frame $f1.bins] 405 pack $f -side top -anchor w -fill x -expand 1 406 pack [label $f.l -text "Display +/- bins:"] -side left 407 408 set values "" 409 foreach d {100 50 20 10 5 2 1} { 410 # avoid dividebyzero for small number of bins 411 if [catch {set v [expr $::LH($thd,maxbins)/$d]} msg] continue 412 if {$v == 0} continue 413 lappend values $v 414 } 415 416 foreach v $values { 417 pack [radiobutton $f.b$v \ 418 -text $v -value $v -variable ::LH($thd,maxbins) \ 419 -command "xaxis $thd"] -side left 420 } 421 422 } 423 424 set f [frame ${w}bot] 425 pack $f -side bottom -anchor w -fill x -expand 1 426 pack [button $f.b -padx 0 -pady 0 -text Reset -command reset_data ] \ 427 -side left -anchor w 428 pack [checkbutton $f.c -text ylogscale -variable ::LH(y,logscale)] \ 429 -side left 430 431 pack [button $f.exit -padx 0 -pady 0 -text Exit -command finish ] \ 432 -side right 433 434 pack [entry $f.e -textvariable ::LH(elapsed) \ 435 -state readonly -justify right -width 6] \ 436 -side right -anchor e 437 pack [label $f.el -text "Elapsed Time:"] -side right -anchor e 438 439 set fg [frame $f.fg] 440 pack $fg -side right -anchor center -fill none -expand 1 441 pack [label $fg.gct -textvariable ::LH(glxgears,ct)] \ 442 -side right -anchor center 443 pack [button $fg.gears -padx 0 -pady 0 -text Glxgears \ 444 -command [list exec glxgears &]] \ 445 -side right -anchor center -fill none -expand 1 446 447 pack [button $f.sshot -padx 0 -pady 0 -text Screenshot \ 448 -command [list windowToFile .]] \ 449 -side right -anchor center -fill none -expand 1 450 451 wm deiconify . 452 wm resizable . 0 0 453 454 after 0 count_glxgears 455 } ;# make_gui 456 457 proc count_glxgears {} { 458 set l {} 459 if [catch {set l [exec pgrep glxgears 2>/dev/null]} msg] { 460 # puts "l=$l,msg=$msg" 461 } 462 set ::LH(glxgears,ct) [llength $l] 463 after 1000 count_glxgears ;# reschedule 464 } ;# count_glxgears 465 466 proc xaxis {thd} { 467 set bins $::LH($thd,maxbins) 468 set binsize $::LH($thd,binsize,us) 469 foreach v {-1 -2 -5 -10 0 10 5 2 1} { 470 if {$v == 0} { 471 lappend ticklist 0 472 } else { 473 lappend ticklist [expr int(1.0*$bins/$v*$binsize)] 474 } 475 } 476 set fullscale [expr $bins * $binsize] 477 $::LH(w,$thd) axis configure x \ 478 -hide 0 \ 479 -logscale 0 \ 480 -showticks 1 \ 481 -min -$fullscale -max $fullscale \ 482 -majorticks $ticklist 483 } ;# xaxis 484 485 proc finish {} { 486 after cancel [after info] 487 foreach thd $::LH(threads) { 488 if {$::LH(elapsed) == 0} break 489 progress "$thd reread,ct/sec=[format %.3f \ 490 [expr 1.0*$::LH($thd,reread,ct)/$::LH(elapsed)]]" 491 progress "$thd bump,ct/sec=[format %.3f \ 492 [expr 1.0*$::LH($thd,bump,ct)/$::LH(elapsed)]]" 493 } 494 progress $::LH(title)\n 495 catch {exec pkill glxgears} 496 progress "Fini" 497 exec halrun -U 498 exit 0 499 } ;# finish 500 501 502 proc repeat {} { 503 after cancel $::LH(after,repeat) 504 set ::LH(elapsed) [expr [clock seconds] - $::LH(start)] 505 scan [time { foreach thd $::LH(threads) { 506 update_bin_data $thd 507 } 508 }] "%d %s" tus notused 509 510 set tms [expr $tus/1000] 511 set ::LH(after,repeat) [after [expr 2*$tms] repeat] ;# nohogging 512 } ;# repeat 513 514 proc reset_data {} { 515 progress "Reset data" 516 foreach thd $::LH(threads) { 517 hal setp $::LH($thd,name).reset 1 518 $::LH(w,$thd,posbins) conf -fg black 519 $::LH(w,$thd,negbins) conf -fg black 520 set ::LH($thd,pextra) 0 521 set ::LH($thd,nextra) 0 522 set ::LH($thd,p,more) 0 523 set ::LH($thd,n,more) 0 524 set ::LH($thd,latency_min,us) "" 525 set ::LH($thd,latency_max,us) "" 526 set ::LH($thd,latency_sdev,us) "" 527 } 528 after 100 529 foreach thd $::LH(threads) { 530 hal setp $::LH($thd,name).reset 0 531 } 532 set ::LH(start) [clock seconds] 533 set ::LH(elapsed) 0 534 if $::LH(use_x) { make_chart } 535 return 536 } ;# reset_data 537 538 proc start_collection {} { 539 set i 1; set args "" 540 foreach thd $::LH(threads) { 541 set args "$args name$i=t_$thd period$i=$::LH($thd,period,ns)" 542 incr i 543 } 544 eval hal loadrt threads "$args" 545 546 set names ""; set ct 0 547 foreach thd $::LH(threads) { 548 if $ct { 549 set names "$names,$::LH($thd,name)" 550 } else { 551 set names "$::LH($thd,name)" 552 } 553 incr ct 554 } 555 hal loadrt $::LH(compname) names=$names 556 foreach thd $::LH(threads) { 557 set ::LH($thd,reread,ct) 0 558 set ::LH($thd,bump,ct) 0 559 set availablebins [hal getp $::LH($thd,name).availablebins] 560 if {$availablebins < $::LH($thd,maxbins)} { 561 if $::LH(use_x) { wm iconify . } 562 puts "" 563 puts "The compiled-in number of available bins for $::LH(compname).comp:" 564 puts " <$availablebins>" 565 puts "is less than the requested maxbins:" 566 puts " <$::LH($thd,maxbins) for the $thd thread>" 567 puts "" 568 puts "To fix:" 569 puts " 1) Increase binsize" 570 puts "or" 571 puts " 2) Decrease thread interval" 572 puts "or" 573 puts " 3) Set bins explicitly (< $availablebins)" 574 puts "" 575 exec halrun -U 576 exit 1 577 } 578 hal addf $::LH($thd,name) t_$thd 579 hal setp $::LH($thd,name).maxbinnumber $::LH($thd,maxbins) 580 hal setp $::LH($thd,name).nsbinsize $::LH($thd,binsize,ns) 581 } 582 hal start 583 if $::LH(use_x) { make_chart } 584 after 100 585 set ::LH(elapsed) 0 586 } ;# start_collection 587 588 proc make_chart {} { 589 foreach thd $::LH(threads) { 590 set w $::LH(w,$thd) 591 $w legend configure -hide 1 ;# too many bins for legend 592 for {set bin 0} {$bin <= $::LH($thd,maxbins)} {incr bin} { 593 lappend pxd [expr $bin*$::LH($thd,binsize,us)] 594 lappend pyd 0 595 if {$bin == 0} continue 596 lappend nxd [expr -$bin*$::LH($thd,binsize,us)] 597 lappend nyd 0 598 } 599 if [$w element exists ndata] { 600 set op configure 601 } else { 602 set op create 603 } 604 $w element $op pdata -xdata $pxd \ 605 -ydata $pyd \ 606 -fg $::LH($thd,color) \ 607 -relief solid \ 608 -bd 0 -barwidth $::LH($thd,binsize,us) \ 609 -bg lightblue 610 $w element $op pmaxdata \ 611 -xdata [expr $::LH($thd,maxbins) * $::LH($thd,binsize,us)] \ 612 -ydata 0 \ 613 -fg $::LH($thd,color) \ 614 -relief solid \ 615 -bd 0 -barwidth $::LH($thd,binsize,us) \ 616 -bg lightblue 617 if {$bin == 0} continue 618 $w element $op ndata -xdata $nxd \ 619 -ydata $nyd \ 620 -fg $::LH($thd,color) \ 621 -relief solid \ 622 -bd 0 -barwidth $::LH($thd,binsize,us) \ 623 -bg lightblue 624 $w element $op nmaxdata \ 625 -xdata [expr -$::LH($thd,maxbins) * $::LH($thd,binsize,us)] \ 626 -ydata 0 \ 627 -fg $::LH($thd,color) \ 628 -relief solid \ 629 -bd 0 -barwidth $::LH($thd,binsize,us) \ 630 -bg lightblue 631 if {$bin == 0} continue 632 633 } 634 } ;# make_chart 635 636 proc update_bin_data {thd} { 637 set dly $::LH($thd,dly,ms) 638 set pmore 0 639 set nmore 0 640 for {set bin 0} {$bin <= $::LH($thd,maxbins)} {incr bin} { 641 hal setp $::LH($thd,name).index $bin 642 set ct 0 643 while 1 { 644 after $dly 645 set chk [hal getp $::LH($thd,name).check] 646 if {$bin == $chk} { 647 break 648 } else { 649 # retry (probably only needed for (irrelevant) non-realtime threads) 650 incr ct 651 incr ::LH($thd,reread,ct) 652 if {$ct > 1} { 653 incr dly 654 incr ::LH($thd,bump,ct) 655 } 656 } 657 } 658 set pbin [hal getp $::LH($thd,name).pbinvalue] 659 set nbin [hal getp $::LH($thd,name).nbinvalue] 660 661 # 1.1 value makes single unit bins show as pips when using log y scale: 662 if {$pbin == 1} {set pbin 1.1} 663 if {$nbin == 1} {set nbin 1.1} 664 665 lappend pxd [expr $bin * $::LH($thd,binsize,us)] 666 lappend pyd $pbin 667 if {($bin != 0)} { 668 lappend nxd -[expr $bin * $::LH($thd,binsize,us)] 669 lappend nyd $nbin 670 } 671 if {$bin > $::LH($thd,maxbins)} { 672 set pmore [expr $pmore + $pbin] 673 set nmore [expr $nmore + $nbin] 674 } 675 } ;# for bin 676 677 set ::LH($thd,latency_min,us) [format %.1f \ 678 [expr 1e-3 * [hal getp $::LH($thd,name).latency-min]]] 679 set ::LH($thd,latency_max,us) [format %.1f \ 680 [expr 1e-3 * [hal getp $::LH($thd,name).latency-max]]] 681 682 set variance [hal getp $::LH($thd,name).variance] 683 if [catch { 684 set ::LH($thd,latency_sdev,us) [format %.1f \ 685 [expr 1e-3 * sqrt($variance)]] 686 } msg] { 687 puts "msg=$msg (variance=$variance)" 688 } 689 690 set ::LH($thd,pextra) [hal getp $::LH($thd,name).pextra] 691 set ::LH($thd,p,more) [expr $pmore + $::LH($thd,pextra)] 692 693 set ::LH($thd,nextra) [hal getp $::LH($thd,name).nextra] 694 set ::LH($thd,n,more) [expr $nmore + $::LH($thd,nextra)] 695 if !$::LH(use_x) { 696 puts [format "%5d secs %6s min:%8.3f uS max:%8.3f uS sdev:%8.3f uS" \ 697 $::LH(elapsed) \ 698 $thd \ 699 $::LH($thd,latency_min,us) \ 700 $::LH($thd,latency_max,us) \ 701 $::LH($thd,latency_sdev,us) \ 702 ] 703 return 704 } 705 706 set pcolor $::LH($thd,color) 707 set pmaxcolor white 708 if {$::LH($thd,pextra) > 0} { 709 set pcolor red 710 set pmaxcolor $pcolor 711 $::LH(w,$thd,posbins) conf -fg $pcolor 712 } elseif {$::LH($thd,p,more) > 0} { 713 $::LH(w,$thd,posbins) conf -fg $::LH($thd,color) 714 } else { 715 $::LH(w,$thd,posbins) conf -fg black 716 } 717 718 set ncolor $::LH($thd,color) 719 set nmaxcolor white 720 if {$::LH($thd,nextra) > 0} { 721 set ncolor red 722 set nmaxcolor $ncolor 723 $::LH(w,$thd,negbins) conf -fg $ncolor 724 } elseif {$::LH($thd,n,more) > 0} { 725 $::LH(w,$thd,negbins) conf -fg $::LH($thd,color) 726 } else { 727 $::LH(w,$thd,negbins) conf -fg black 728 } 729 730 set pyd_max_pos [expr [lindex $pyd end] + $::LH($thd,p,more)] 731 set nyd_max_neg [expr [lindex $nyd end] + $::LH($thd,n,more)] 732 733 # display fmt 734 set ::LH($thd,p,more) [format %.3g $::LH($thd,p,more)] 735 set ::LH($thd,n,more) [format %.3g $::LH($thd,n,more)] 736 737 # remove end bin 738 set pyd [lrange $pyd 0 [expr -1 + $::LH($thd,maxbins)]] 739 set pxd [lrange $pxd 0 [expr -1 + $::LH($thd,maxbins)]] 740 741 set nyd [lrange $nyd 0 [expr -2 + $::LH($thd,maxbins)]] 742 set nxd [lrange $nxd 0 [expr -2 + $::LH($thd,maxbins)]] 743 744 set w $::LH(w,$thd) 745 $w element configure pdata -xdata $pxd -ydata $pyd 746 $w element configure ndata -xdata $nxd -ydata $nyd 747 748 $w element configure pmaxdata \ 749 -xdata [expr $::LH($thd,maxbins) * $::LH($thd,binsize,us)] \ 750 -ydata $pyd_max_pos \ 751 -stipple pbmap \ 752 -fg $::LH($thd,color) -bg $pmaxcolor 753 $w element configure nmaxdata \ 754 -xdata [expr -1*$::LH($thd,maxbins) * $::LH($thd,binsize,us)] \ 755 -ydata $nyd_max_neg \ 756 -stipple nbmap \ 757 -fg $::LH($thd,color) -bg $nmaxcolor 758 759 # a y axis configure is needed, updates may fail without it 760 $::LH(w,$thd) axis configure y -logscale $::LH(y,logscale) 761 update 762 } ;# update_bin_data 763 764 proc popup {msg} { \ 765 set answer [tk_messageBox \ 766 -parent . \ 767 -icon error \ 768 -type ok \ 769 -title "Message" \ 770 -message "$msg" \ 771 ] 772 puts $msg 773 } ;# popup 774 775 proc progress {txt} { 776 if !$::LH(verbose) return 777 puts stderr "$::argv0: [expr [clock seconds] - $::LH(start)]s $txt" 778 } ;# progress 779 780 proc usage {} { 781 set prog [file tail $::argv0] 782 puts "" 783 puts "Usage:" 784 puts " $prog --help | -?" 785 puts "or" 786 puts " $prog \[Options\]" 787 puts "" 788 puts "Options:" 789 puts " --base nS (base thread interval, default: $::LH(base,period,ns), min: $::LH(base,period,ns,min))" 790 puts " --servo nS (servo thread interval, default: $::LH(servo,period,ns), min: $::LH(servo,period,ns,min))" 791 792 puts " --bbinsize nS (base bin size, default: $::LH(base,binsize,ns))" 793 puts " --sbinsize nS (servo bin size, default: $::LH(servo,binsize,ns))" 794 795 puts " --bbins n (base bins, default: $::LH(base,maxbins))" 796 puts " --sbins n (servo bins, default: $::LH(servo,maxbins))" 797 798 puts " --logscale 0|1 (y axis log scale, default: $::LH(y,logscale))" 799 puts " --text note (additional note, default: \"$::LH(note,txt)\")" 800 puts " --show (show count of undisplayed bins)" 801 puts " --nobase (servo thread only)" 802 puts " --verbose (progress and debug)" 803 puts " --nox (no gui, display elapsed,min,max,sdev for each thread)" 804 805 puts "" 806 puts "Notes:" 807 puts " Linuxcnc and Hal should not be running, stop with halrun -U." 808 puts " Large number of bins and/or small binsizes will slow updates." 809 puts " For single thread, specify --nobase (and options for servo thread)." 810 puts " Measured latencies outside of the +/- bin range are reported" 811 puts " with special end bars. Use --show to show count for" 812 puts " the off-chart \[pos|neg\] bin" 813 exit 0 814 } ;# usage 815 816 #------------------------------------------------------------------ 817 proc bltCaptureWindow { win } { 818 set image [image create photo] 819 blt::winop snap $win $image 820 return $image 821 } ;# bltCaptureWindow 822 823 proc windowToFile { win } { 824 set image [bltCaptureWindow $win] 825 set types {{"Image Files" {.png}}} 826 set ifile $::tcl_platform(user)-$::LH(date)-$::LH(elapsed).png 827 set filename [tk_getSaveFile -filetypes $types \ 828 -initialfile $ifile \ 829 -initialdir $::LH(dir,screenshot) \ 830 -defaultextension .png] 831 if {[llength $filename]} { 832 set ::LH(dir,screenshot) [file dirname $filename] 833 $image write -format png $filename 834 } 835 image delete $image 836 } ;# windowToFile 837 #------------------------------------------------------------------ 838 839 # allow re-sourcing for testing with tkcon 840 if ![info exists ::LH(start)] { 841 set_defaults 842 config 843 progress "Loading packages" 844 load_packages 845 signal trap SIGINT finish 846 progress "Making gui" 847 if $::LH(use_x) make_gui 848 progress "Start_collection" 849 start_collection 850 progress "Begin repeats" 851 repeat 852 } else { 853 puts "$::argv0 already running" 854 } 855 if !$::LH(use_x) { vwait ::forever }