#!/usr/bin/tclsh
#

# for Usage:
#    latency-histogram --help | -?

#-----------------------------------------------------------------------
# Copyright: 2012-2016
# Author:    Dewey Garrett <dgarrett@panix.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, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
#-----------------------------------------------------------------------

# Mu sign is Unicode 00b5
set ::MICROSEC \u00b5s

#-----------------------------------------------------------------------
# lh_chart canvas bar-chart widget (replaces BLT, which has no Tcl/Tk 9
# port). Shared with hal-histogram via the installed hallib directory.
#-----------------------------------------------------------------------
source [file join [exec linuxcnc_var HALLIB_DIR] lh_chart.tcl]

proc set_defaults {} {
  set ::LH(start) [clock seconds]
  # don't include glxgears, error suffices
  program_check {halrun halcmd lsmod pgrep pkill hostname}
  set ::LH(realtime) [exec linuxcnc_var REALTIME]
  program_check $::LH(realtime)
  if {[string first rtai [string tolower $::tcl_platform(osVersion)]] >=0} {
    set ::LH(rtai) rtai
  }

  set ::LH(use_x)    1
  set ::LH(verbose)  0
  set ::LH(opt,show) 0

  set name [file tail [file rootname $::argv0]]
  # Default comp is latencybinstream (atomic snapshot via HAL stream).
  # --legacy switches to the original latencybins comp, which has a
  # known race: it transfers bins one cycle at a time so the snapshot
  # is smeared across hundreds of ms and stats desync from bins.
  set ::LH(legacy)   0
  set ::LH(compname) latencybinstream
  # Default screenshot dir: ~/Pictures (XDG standard) if it exists,
  # else $HOME, else /tmp/$name. Save dialog lets user pick anyway.
  set ::LH(dir,screenshot) ""
  foreach cand [list \
        [file join $::env(HOME) Pictures] \
        $::env(HOME) \
        /tmp/$name] {
    if {[file isdirectory $cand] || ![catch {file mkdir $cand}]} {
      set ::LH(dir,screenshot) $cand
      break
    }
  }
  if {$::LH(dir,screenshot) eq ""} { set ::LH(dir,screenshot) ~ }

  set ::LH(note,txt) ""
  set ::LH(date) [clock format [clock seconds] -format "%d%b%Y"]

  set ::LH(y,logscale) 1

  set ::LH(threads)  {base servo}

  set ::LH(base,name)  base
  set ::LH(servo,name) servo

  set ::LH(base,color)    seagreen
  set ::LH(servo,color)   blue

  set ::LH(base,period,ns)    25000
  set ::LH(servo,period,ns) 1000000

  set ::LH(base,period,ns,min)    5000
  set ::LH(servo,period,ns,min)  25000

  set ::LH(base,binsize,ns)   100
  set ::LH(servo,binsize,ns)  100

  # must be integer for window naming and .comp file usage:
  set ::LH(base,maxbins)  200
  set ::LH(servo,maxbins) 200

  set ::LH(base,p,more) 0
  set ::LH(base,n,more) 0
  set ::LH(servo,p,more) 0
  set ::LH(serve,n,more) 0

  set ::LH(after,repeat) ''
} ;# set_defaults


proc which_exe {name} {
  # replaces /usr/bin/which deprecated in debian/unstable
  foreach dir [split $::env(PATH) :] {
    set f [file join $dir $name]
    if [file executable $f] { return $f }
  }
  return -code error "$name: executable not found"
} ;# which_exe

proc program_check {plist} {
  foreach prog $plist {
    if [catch {
      set ::LH(prog,$prog) [which_exe $prog]
     } chkmsg] {
       set msg  "Cannot find required program named:   <$prog>"
       set msg  "$msg\n\nIf Run-in-Place, source rip-environment first"
       set msg  "$msg\n\n$chkmsg"
       popup  $msg
       exit 1
     }
  }
} ;# program_check

proc config {} {
  while {[llength $::argv] >0} {
    # beware wish handling of reserved cmdline arguments
    # lreplace shifts argv for no. of items for each iteration
    set currentarg [lindex $::argv 0]
    switch -- $currentarg {
      -? - --help {usage;exit 0}
      --logscale  {set t [lindex $::argv 1]
                   set ::LH(y,logscale) $t
                   set ::argv [lreplace $::argv 0 0]
                  }
      --base      {set t [lindex $::argv 1]
                   set ::LH(base,period,ns) $t
                   set ::argv [lreplace $::argv 0 0]
                   if {$::LH(base,period,ns)
                           < $::LH(base,period,ns,min)} {
                      puts "base period too small\
                            min=$::LH(base,period,ns,min)"
                      exit 1
                   }
                  }
      --servo     {set t [lindex $::argv 1]
                   set ::LH(servo,period,ns) $t
                   set ::argv [lreplace $::argv 0 0]
                      if {$::LH(servo,period,ns)
                              < $::LH(servo,period,ns,min)} {
                         puts "servo period too small\
                               min=$::LH(servo,period,ns,min)"
                         exit 1
                     }
                  }
      --bbinsize  {set t [lindex $::argv 1]
                   set ::LH(base,binsize,ns) $t
                   set ::argv [lreplace $::argv 0 0]
                  }
      --sbinsize  {set t [lindex $::argv 1]
                   set ::LH(servo,binsize,ns) $t
                   set ::argv [lreplace $::argv 0 0]
                  }
      --sbins    {set t [lindex $::argv 1]
                   set ::LH(servo,maxbins) $t
                   set ::argv [lreplace $::argv 0 0]
                  }
      --bbins     {set t [lindex $::argv 1]
                   set ::LH(base,maxbins) $t
                   set ::argv [lreplace $::argv 0 0]
                  }
      --text      {set t [lindex $::argv 1]
                   set ::LH(note,txt) $t
                   set ::argv [lreplace $::argv 0 0]
                  }
      --nobase    {set ::LH(threads) {servo}
                  }
      --show      {set ::LH(opt,show) 1
                  }
      --verbose   {set ::LH(verbose) 1
                  }
      --nox       {set ::LH(use_x) 0
                  }
      --legacy    {set ::LH(legacy) 1
                   set ::LH(compname) latencybins
                  }
      default {lappend unknownargs $currentarg}
    }
    set ::argv [lreplace $::argv 0 0]
  } ;# while
  if [info exists unknownargs] {
    puts "\nIgnoring unknown args: <$unknownargs>"
  }
  if {$::LH(base,period,ns) > $::LH(servo,period,ns)} {
    popup "base period must be less than servo period"
    exit 1
  }

  set ::LH(title) "$::argv0"

  foreach thd $::LH(threads) {
    # initial delay for reading by index
    set ms [expr $::LH($thd,period,ns)/1000000]
    if {$ms > 1} {
      set ::LH($thd,dly,ms) $ms
    } else {
      set ::LH($thd,dly,ms) 1 ;# minimum interval (ms) for after cmd
    }

    if {[expr $::LH($thd,binsize,ns) % 10] != 0} {
      puts "$::argv0: \[sb\]binsize must be multiple of 10 ns"
      exit 1
    }

    # guard for lat32 limit of 2.147 sec
    if {[expr $::LH($thd,binsize,ns) * $::LH($thd,maxbins)] > 2000000000} {
      puts "Measurement interval too big for $thd thread"
      puts "Reduce bins or increase binsize"
      exit 1
    }

    # uS display only
    set ::LH($thd,binsize,us)  [expr ($::LH($thd,binsize,ns)/1000.)]
  }
  set ::LH(info) [other_info]
  set ::LH(processor) [processor_info]
} ;# config

proc other_info {} {
  if [info exists ::env(DISPLAY)] {
    set display "DISPLAY=$::env(DISPLAY)"
  } else {
    set display "DISPLAY=?"
  }
  set linuxcncversion [exec linuxcnc_var LINUXCNCVERSION]
  return "\
$::tcl_platform(machine) \
$::tcl_platform(osVersion) \
$linuxcncversion \
$display \
"
} ;# other_info

proc processor_info {} {
  set cmdline [exec cat /proc/cmdline]
  set idx [string first isolcpus $cmdline]
  if {$idx < 0} {
    set isolcpus no_isolcpus
  } else {
    set tmp [string range $cmdline $idx end]
    set tmp "$tmp " ;# add trailing blank
    set isolcpus [string range $tmp 0 [expr -1 + [string first " " $tmp]]]
  }
  set fd [open /proc/cpuinfo]
  while {![eof $fd]} {
    gets $fd newline
    set s [split $newline :]
    set key [string trim [lindex $s 0]]
    set key [string map "\" \" _" $key]
    set v [lindex $s 1]
    set procinfo($key) $v
  }
  close $fd

  set cores "1_core"
  catch {set cores "$procinfo(cpu_cores) cores"};# item may not exist
  catch {set cores "[exec getconf _NPROCESSORS_ONLN] cores"};# could fail?

  set model ""
  catch {set model $procinfo(model_name)}       ;# item may not exist
  set model [string trim $model]

  set vendor_id ""
  catch {set vendor_id $procinfo(vendor_id)}    ;# item may not exist

  # collapse multiple blanks:
  while 1 {if ![regsub "  " $model " " model] break}

  return "\
$cores \
$isolcpus \
$vendor_id \
$model \
"
} ;# processor_info

proc load_packages {} {
  # Tclx is unavailable on Tcl 9 (Fedora 42+). Stub `signal` if missing
  # so the rest of the script (one signal trap call) keeps working.
  if {[catch {package require Tclx}]} {
    proc signal {args} {} ;# no-op stub: Ctrl-C in terminal will not run finish
  }

  if $::LH(use_x) {
    package require Tk
    wm title    . $::LH(title)
    wm protocol . WM_DELETE_WINDOW finish
    wm withdraw .
    # BLT no longer required: lh_chart provides the histogram widget on
    # Tk canvas, so we work on Tcl/Tk 8.6 and 9 alike. Stipple bitmaps
    # for off-chart bars are created on demand by lh_chart::install_stipples.
  }

  if {   [catch {exec pgrep linuxcnc} msg] \
      && [catch {exec pgrep halcmd} msg]} {
    # puts "ok--not already running hal"
  } else {
    wm withdraw .
    popup "Stop linuxcnc and hal first (try: \$ halrun -U)"
    exit 1
  }

  exec $::LH(realtime) start >@stdout  2>@stderr

  # augment ::auto_path for special case:
  # 1) RIP build (no install)
  # 2) linuxcnc script called from Application menu
  if {   [info exists ::env(LINUXCNC_TCL_DIR)]
      && ([lsearch $::auto_path $::env(LINUXCNC_TCL_DIR)] < 0)
     } {
     # prepend
     set ::auto_path [lreplace $::auto_path 0 -1 $::env(LINUXCNC_TCL_DIR)]
  }
  if [catch {package require Hal} msg] {
    puts $msg
    puts "For a RIP linuxcnc build, source rip-environment in this shell"
    exit 1
  }
} ;# load_packages

proc rt_status_items {} {
  # Returns {text color} pairs; color is "" except where it needs attention.
  set red "#cc4444"
  set items {}

  # realtime: type from 'realtime verify' stdout, yes/no from its exit status.
  set rt_text "no realtime"
  set rt_ok 0
  if {![catch {open [list | $::LH(realtime) verify 2> /dev/null] r} chan]} {
    set out [string trim [read $chan]]
    set rt_ok [expr {![catch {close $chan}]}]
    if {$out ne ""} {set rt_text $out}
  }
  lappend items [list $rt_text [expr {$rt_ok ? "" : $red}]]

  # cpu governor: red when not 'performance'
  set gov ""
  catch {set gov [string trim [exec cat /sys/devices/system/cpu/cpu0/cpufreq/scaling_governor]]}
  if {$gov eq ""} {set gov "gov?"}
  if {$gov eq "performance"} {
    lappend items [list $gov ""]
  } else {
    lappend items [list $gov $red]
  }

  # isolcpus
  set cmdline ""
  catch {set cmdline [exec cat /proc/cmdline]}
  if {[regexp {isolcpus=(\S+)} $cmdline -> iso]} {
    lappend items [list "isolcpus=$iso" ""]
  } else {
    lappend items [list "no_isolcpus" ""]
  }
  return $items
} ;# rt_status_items

proc make_gui { {w .} } {
  set f [frame ${w}fa]
  pack $f -side top -fill x -expand 1
  set hname [exec hostname]
  set user $::tcl_platform(user)
  pack [label $f.l -anchor w \
       -text "$::LH(date) $hname $user $::LH(note,txt)"
       ] -fill x -expand 1

  set f [frame ${w}fb]
  pack $f -side top -fill x -expand 1
  pack [label $f.l -anchor w -text $::LH(info)] -fill x -expand 1

  set f [frame ${w}fc]
  pack $f -side top -fill x -expand 1
  pack [label $f.l -anchor w -text $::LH(processor)] -fill x -expand 1

  set fmain [frame ${w}fmain]
  pack $fmain -side top

  foreach thd $::LH(threads) {
    set f1 [frame $fmain.$thd -relief groove -bd 2]
    pack $f1 -side left

    set f [frame $f1.t]
    pack $f -side top

    set ::LH(w,$thd) $f.graph
    catch {destroy $::LH(w,$thd)}
    set per [expr $::LH($thd,period,ns)/1000.0]
    lh_chart::create $::LH(w,$thd) \
        -plotbackground honeydew1 \
        -cursor arrow \
        -title "Latency ($::MICROSEC) $thd thread ($per $::MICROSEC period, binsize=$::LH($thd,binsize,us) $::MICROSEC)" \
        -width 480 -height 384
    pack $::LH(w,$thd) -side left

    xaxis $thd
    $::LH(w,$thd) axis configure y -logscale $::LH(y,logscale)

    set f [frame $f1.extra12]
    pack $f -side top -anchor w -fill x -expand 1

    pack [label $f.min -text "min ($::MICROSEC)"] \
         -side left -anchor e
    set e [entry $f.emin -textvariable ::LH($thd,latency_min,us) \
         -state readonly -justify right -width 9]
    pack $e -side left -anchor e

    pack [label $f.sdev -text "   sdev ($::MICROSEC)"] \
         -side left
    set e [entry $f.esdev  -textvariable ::LH($thd,latency_sdev,us) \
         -state readonly -justify right -width 9]
    pack $e -side left -anchor e

    set e [entry $f.emax  -textvariable ::LH($thd,latency_max,us) \
         -state readonly -justify right -width 9]
    pack $e -side right -anchor e
    pack [label $f.max -text "   max ($::MICROSEC)"] \
         -side right -anchor e

    if $::LH(opt,show) {
      set f [frame $f1.extra2]
      pack $f -side top -anchor w -fill x -expand 1
      set e [entry $f.emin -textvariable ::LH($thd,n,more) \
           -state readonly -justify right -width 9]
      pack $e -side left -anchor e
      pack [label $f.min -text "<--off-chart neg bin ct"] \
           -side left -anchor e
      set ::LH(w,$thd,negbins) $e

      set e [entry $f.emax  -textvariable ::LH($thd,p,more) \
           -state readonly -justify right -width 9]
      pack $e -side right -anchor e
      pack [label $f.max -text "off-chart pos bin ct-->"] \
           -side right -anchor e
      set ::LH(w,$thd,posbins) $e
    } else {
      set ::LH(w,$thd,negbins) placeholder
      set ::LH(w,$thd,posbins) placeholder
      proc placeholder {args} return
    }

    set f [frame $f1.bins]
    pack $f -side top -anchor w -fill x -expand 1
    pack [label $f.l -text "Display +/- bins:"] -side left

    set values ""
    foreach d {100 50 20 10 5 2 1} {
      # avoid dividebyzero for small number of bins
      if [catch {set v [expr $::LH($thd,maxbins)/$d]} msg] continue
      if {$v == 0} continue
      lappend values $v
    }

    foreach v $values {
      pack [radiobutton $f.b$v \
           -text $v -value $v -variable ::LH($thd,maxbins) \
           -command "xaxis $thd"] -side left
    }

  }

  # --- realtime status bar (true footer): one line of axis-style sunken
  # cells split into equal thirds, left/centre/right aligned ---
  set sb [frame ${w}statusbar]
  pack $sb -side bottom -fill x
  set sbitems [rt_status_items]
  # Fixed-width sides (chars), elastic middle gets the rest.
  # Left fits the longest RT label (RT-Xenomai-EVL); right fits isolcpus up to ~4 cpus.
  set sbwidth  {14 0 18}
  set sbweight {0  1 0}
  set sbanch   {w center e}
  set i 0
  foreach item $sbitems {
    lassign $item text color
    label $sb.s$i -text $text -relief sunken -bd 1 -anchor [lindex $sbanch $i] -padx 6
    set wdt [lindex $sbwidth $i]
    if {$wdt > 0} {$sb.s$i configure -width $wdt}
    if {$color ne ""} {$sb.s$i configure -fg $color}
    grid $sb.s$i -row 0 -column $i -sticky we
    grid columnconfigure $sb $i -weight [lindex $sbweight $i]
    incr i
  }

  set f [frame ${w}bot]
  pack $f -side bottom -anchor w -fill x -expand 1
  pack [button $f.b -padx 0 -pady 0  -text Reset -command reset_data ] \
       -side left -anchor w
  pack [checkbutton $f.c -text ylogscale -variable ::LH(y,logscale)] \
       -side left

  pack [button $f.exit  -padx 0 -pady 0 -text Exit -command finish ] \
       -side right

  pack [entry $f.e -textvariable ::LH(elapsed) \
       -state readonly -justify right -width 6] \
       -side right -anchor e
  pack [label $f.el -text "Elapsed Time:"] -side right -anchor e

  set fg [frame $f.fg]
  pack $fg  -side right -anchor center -fill none -expand 1
  pack [label $fg.gct -textvariable ::LH(glxgears,ct)] \
       -side right -anchor center
  pack [button $fg.gears -padx 0 -pady 0 -text Glxgears \
       -command [list exec glxgears &]] \
       -side right -anchor center -fill none -expand 1

  pack [button $f.sshot -padx 0 -pady 0 -text Screenshot \
       -command [list windowToFile .]] \
       -side right -anchor center -fill none -expand 1

  wm deiconify .
  wm resizable . 0 0

  after 0 count_glxgears
} ;# make_gui

proc count_glxgears {} {
  set l  {}
  if [catch {set l [exec pgrep glxgears 2>/dev/null]} msg] {
    # puts "l=$l,msg=$msg"
  }
  set ::LH(glxgears,ct) [llength $l]
  after 1000 count_glxgears ;# reschedule
} ;# count_glxgears

proc xaxis {thd} {
  set bins $::LH($thd,maxbins)
  set binsize $::LH($thd,binsize,us)
  foreach v {-1 -2 -5 -10 0 10 5 2 1} {
    if {$v == 0} {
      lappend ticklist 0
    } else {
      lappend ticklist [expr int(1.0*$bins/$v*$binsize)]
    }
  }
  set fullscale [expr $bins * $binsize]
  $::LH(w,$thd) axis configure x \
                -hide 0 \
                -logscale  0 \
                -showticks 1 \
                -min -$fullscale -max $fullscale \
                -majorticks $ticklist
} ;# xaxis

proc finish {} {
  after cancel [after info]
  foreach thd $::LH(threads) {
    if {[info exists ::LH($thd,stream,h)]} {
      catch {hal_stream detach $::LH($thd,stream,h)}
      unset ::LH($thd,stream,h)
    }
    if {$::LH(elapsed) == 0} break
    progress "$thd reread,ct/sec=[format %.3f \
             [expr 1.0*$::LH($thd,reread,ct)/$::LH(elapsed)]]"
    progress "$thd   bump,ct/sec=[format %.3f \
             [expr 1.0*$::LH($thd,bump,ct)/$::LH(elapsed)]]"
  }
  progress $::LH(title)\n
  catch {exec pkill glxgears}
  progress "Fini"
  exec halrun -U
  exit 0
} ;# finish


proc repeat {} {
  after cancel $::LH(after,repeat)
  set ::LH(elapsed) [expr [clock seconds] - $::LH(start)]
  scan [time {  foreach thd $::LH(threads) {
                  update_bin_data $thd
                }
             }] "%d %s" tus notused

  set tms [expr $tus/1000]
  set ::LH(after,repeat) [after [expr 2*$tms] repeat] ;# nohogging
} ;# repeat

proc reset_data {} {
  progress "Reset data"
  foreach thd $::LH(threads) {
    hal setp $::LH($thd,name).reset 1
    $::LH(w,$thd,posbins) conf -fg black
    $::LH(w,$thd,negbins) conf -fg black
    set ::LH($thd,pextra) 0
    set ::LH($thd,nextra) 0
    set ::LH($thd,p,more) 0
    set ::LH($thd,n,more) 0
    set ::LH($thd,latency_min,us)  ""
    set ::LH($thd,latency_max,us)  ""
    set ::LH($thd,latency_sdev,us) ""
  }
  after 100
  foreach thd $::LH(threads) {
    hal setp $::LH($thd,name).reset 0
  }
  set ::LH(start) [clock seconds]
  set ::LH(elapsed) 0
  if $::LH(use_x) { make_chart }
  return
} ;# reset_data

proc start_collection {} {
  set i 1; set args ""
  foreach thd $::LH(threads) {
    set args "$args name$i=t_$thd period$i=$::LH($thd,period,ns)"
    incr i
  }
  eval hal loadrt threads "$args"

  set names ""; set ct 0
  foreach thd $::LH(threads) {
    if $ct {
      set names "$names,$::LH($thd,name)"
    } else {
      set names "$::LH($thd,name)"
    }
    incr ct
  }
  if {$::LH(legacy)} {
    hal loadrt $::LH(compname) names=$names
  } else {
    # latencybinstream needs a unique shmem key per instance via the
    # `keys=` modparam. Derive deterministic keys from this PID so two
    # latency-histogram processes can coexist.
    set keys ""
    set kct 0
    set basekey [expr {[pid] & 0x7fff}]
    foreach thd $::LH(threads) {
      set k [expr {$basekey + $kct}]
      set ::LH($thd,streamkey) $k
      if {$kct == 0} { set keys $k } else { set keys "$keys,$k" }
      incr kct
    }
    hal loadrt $::LH(compname) names=$names keys=$keys
  }
  foreach thd $::LH(threads) {
    set ::LH($thd,reread,ct) 0
    set ::LH($thd,bump,ct) 0
    set ::LH($thd,timeout,ct) 0
    set ::LH($thd,timeout,warned) 0
    set availablebins [hal getp $::LH($thd,name).availablebins]
    if {$availablebins < $::LH($thd,maxbins)} {
       if $::LH(use_x) { wm iconify . }
       puts ""
       puts "The compiled-in number of available bins for $::LH(compname).comp:"
       puts "   <$availablebins>"
       puts "is less than the requested maxbins:"
       puts "   <$::LH($thd,maxbins) for the $thd thread>"
       puts ""
       puts "To fix:"
       puts "   1) Increase binsize"
       puts "or"
       puts "   2) Decrease thread interval"
       puts "or"
       puts "   3) Set bins explicitly (< $availablebins)"
       puts ""
       exec halrun -U
       exit 1
    }
    hal addf $::LH($thd,name) t_$thd
    hal setp $::LH($thd,name).maxbinnumber $::LH($thd,maxbins)
    hal setp $::LH($thd,name).nsbinsize    $::LH($thd,binsize,ns)
    # Acquisition bin count stays at this startup value: the "Display
    # +/- bins" radio only zooms the chart, the streamed snapshot size
    # must not follow it.
    set ::LH($thd,acqbins) $::LH($thd,maxbins)
    if {!$::LH(legacy)} {
      # Comp boots with reset=1 so bins start clean. Drop reset and let
      # samples flow.
      hal setp $::LH($thd,name).reset 0
    }
  }
  hal start
  if {!$::LH(legacy)} {
    # Attach the Tcl hal_stream binding (added in halsh.c) to each
    # thread's latencybinstream FIFO. The handle stays open for the
    # session and is detached in finish.
    foreach thd $::LH(threads) {
      if {[catch {set h [hal_stream attach $::LH($thd,streamkey) u]} err]} {
        popup "hal_stream attach for $thd failed: $err"
        exec halrun -U
        exit 1
      }
      set ::LH($thd,stream,h) $h
    }
  }
  if $::LH(use_x) { make_chart }
  after 100
  set ::LH(elapsed) 0
} ;# start_collection

proc make_chart {} {
  foreach thd $::LH(threads) {
    set w $::LH(w,$thd)
    $w legend configure -hide 1 ;# too many bins for legend
    for {set bin 0} {$bin <= $::LH($thd,maxbins)} {incr bin} {
      lappend pxd [expr $bin*$::LH($thd,binsize,us)]
      lappend pyd 0
      if {$bin == 0} continue
      lappend nxd [expr -$bin*$::LH($thd,binsize,us)]
      lappend nyd 0
    }
    if [$w element exists ndata] {
      set op configure
    } else {
      set op create
    }
    $w element $op pdata -xdata $pxd \
                         -ydata $pyd \
                         -fg $::LH($thd,color) \
                         -relief solid \
                         -bd 0 -barwidth $::LH($thd,binsize,us) \
                         -bg lightblue
    $w element $op pmaxdata \
       -xdata [expr $::LH($thd,maxbins) * $::LH($thd,binsize,us)] \
       -ydata 0 \
       -fg $::LH($thd,color) \
       -relief solid \
       -bd 0 -barwidth $::LH($thd,binsize,us) \
       -bg lightblue
    if {$bin == 0} continue
    $w element $op ndata -xdata $nxd \
                         -ydata $nyd \
                         -fg $::LH($thd,color) \
                         -relief solid \
                         -bd 0 -barwidth $::LH($thd,binsize,us) \
                         -bg lightblue
    $w element $op nmaxdata \
       -xdata [expr -$::LH($thd,maxbins) * $::LH($thd,binsize,us)] \
       -ydata 0 \
       -fg $::LH($thd,color) \
       -relief solid \
       -bd 0 -barwidth $::LH($thd,binsize,us) \
       -bg lightblue
    if {$bin == 0} continue

  }
} ;# make_chart

proc update_bin_data {thd} {
  set N  $::LH($thd,maxbins)
  set bs $::LH($thd,binsize,us)
  set pxd {}; set pyd {}; set nxd {}; set nyd {}
  set pmore 0; set nmore 0

  if {$::LH(legacy)} {
    # Per-bin polling against the legacy latencybins comp. Has known
    # RT/non-RT race: bins read one cycle at a time so the snapshot
    # is smeared and stats desync from bins.
    set dly $::LH($thd,dly,ms)
    for {set bin 0} {$bin <= $N} {incr bin} {
      hal setp $::LH($thd,name).index $bin
      set ct 0
      while 1 {
        after $dly
        set chk [hal getp $::LH($thd,name).check]
        if {$bin == $chk} break
        incr ct
        incr ::LH($thd,reread,ct)
        if {$ct > 1} {
          incr dly
          incr ::LH($thd,bump,ct)
        }
      }
      set pbin [hal getp $::LH($thd,name).pbinvalue]
      set nbin [hal getp $::LH($thd,name).nbinvalue]
      if {$pbin == 1} {set pbin 1.1}
      if {$nbin == 1} {set nbin 1.1}
      lappend pxd [expr $bin * $bs]
      lappend pyd $pbin
      if {$bin != 0} {
        lappend nxd -[expr $bin * $bs]
        lappend nyd $nbin
      }
      if {$bin > $N} {
        set pmore [expr $pmore + $pbin]
        set nmore [expr $nmore + $nbin]
      }
    }
    set ::LH($thd,pextra) [hal getp $::LH($thd,name).pextra]
    set ::LH($thd,nextra) [hal getp $::LH($thd,name).nextra]
  } else {
    # Atomic snapshot via latencybinstream FIFO. Rising edge on
    # `stream` makes RT push 2A+3 records, where A is the startup
    # acquisition bin count (comp maxbinnumber). The display bin count
    # N may be smaller after a "Display +/- bins" change; only the
    # first N bins of the snapshot are shown. Wait for FIFO depth,
    # drain via the Tcl hal_stream binding, lower trigger.
    set A $::LH($thd,acqbins)
    if {$N > $A} { set N $A }
    set need [expr {2*$A + 3}]
    set h $::LH($thd,stream,h)
    hal setp $::LH($thd,name).stream 1
    # Wait until exactly `need` records are queued. Reading early can
    # produce a partial set; the FIFO is sized so a full set always
    # fits, so reaching depth==need means RT pushed a clean snapshot.
    set tries 0
    while {[hal_stream depth $h] < $need} {
      after 1
      incr tries
      if {$tries > 250} {
        hal setp $::LH($thd,name).stream 0
        if {[hal getp $::LH($thd,name).stream-error]} {
          # Hard error: the RT side reports the FIFO cannot hold a full
          # set, so it never streams. This cannot recover, so report it
          # visibly and quit rather than leaving a dead window spinning.
          fatal "$thd: stream-error set (FIFO too small for $need records).\n\nThe latencybinstream FIFO cannot hold a complete data set.\nThis is a build/configuration error and will not recover."
        }
        # A plain timeout may be transient. Surface it visibly once it
        # persists rather than only spamming the console each cycle.
        puts "$thd: stream timeout (depth [hal_stream depth $h] < $need)"
        incr ::LH($thd,timeout,ct)
        if {$::LH($thd,timeout,ct) >= 5 && !$::LH($thd,timeout,warned)} {
          set ::LH($thd,timeout,warned) 1
          popup "$thd: repeated stream timeouts (depth < $need).\n\nThe histogram is not updating for this thread."
        }
        return
      }
    }
    set ::LH($thd,timeout,ct) 0
    set vals [hal_stream drain $h]
    hal setp $::LH($thd,name).stream 0
    # After drain the FIFO must be empty; non-zero means we read out of
    # phase and the snapshot is suspect.
    set leftover [hal_stream depth $h]
    if {[llength $vals] != $need || $leftover != 0} {
      puts "$thd: stream out-of-sync ([llength $vals]/$need, leftover=$leftover)"
      return
    }
    set ntail [lindex $vals 0]
    set ptail [lindex $vals end]
    # Stream order: ntail, nbin[A..1], pbin[0..A], ptail. Display uses
    # only bins 0..N (N <= A).
    for {set k 0} {$k <= $N} {incr k} {
      lappend pxd [expr $k * $bs]
      set v [lindex $vals [expr {$A + 1 + $k}]]
      if {$v == 1} { set v 1.1 }
      lappend pyd $v
    }
    for {set k 1} {$k <= $N} {incr k} {
      lappend nxd [expr -$k * $bs]
      set v [lindex $vals [expr {$A - $k + 1}]]
      if {$v == 1} { set v 1.1 }
      lappend nyd $v
    }
    set ::LH($thd,pextra) $ptail
    set ::LH($thd,nextra) $ntail
  }

  set ::LH($thd,latency_min,us) [format %.1f \
               [expr 1e-3 * [hal getp $::LH($thd,name).latency-min]]]
  set ::LH($thd,latency_max,us) [format %.1f \
               [expr 1e-3 * [hal getp $::LH($thd,name).latency-max]]]

  set variance [hal getp $::LH($thd,name).variance]
  if [catch {
    set ::LH($thd,latency_sdev,us) [format %.1f \
               [expr 1e-3 * sqrt(abs($variance))]]
    } msg] {
    puts "msg=$msg (variance=$variance)"
  }

  set ::LH($thd,p,more) [expr $pmore + $::LH($thd,pextra)]
  set ::LH($thd,n,more) [expr $nmore + $::LH($thd,nextra)]
  if !$::LH(use_x) {
    puts [format "%5d s %6s min:%8.3f us max:%8.3f us sdev:%8.3f us" \
         $::LH(elapsed) \
         $thd \
         $::LH($thd,latency_min,us) \
         $::LH($thd,latency_max,us) \
         $::LH($thd,latency_sdev,us) \
         ]
    return
  }

  set pcolor $::LH($thd,color)
  set pmaxcolor white
  if {$::LH($thd,pextra) > 0} {
    set pcolor red
    set pmaxcolor $pcolor
    $::LH(w,$thd,posbins) conf -fg $pcolor
  } elseif {$::LH($thd,p,more) > 0} {
    $::LH(w,$thd,posbins) conf -fg $::LH($thd,color)
  } else {
    $::LH(w,$thd,posbins) conf -fg black
  }

  set ncolor $::LH($thd,color)
  set nmaxcolor white
  if {$::LH($thd,nextra) > 0} {
    set ncolor red
    set nmaxcolor $ncolor
    $::LH(w,$thd,negbins) conf -fg $ncolor
  } elseif {$::LH($thd,n,more) > 0} {
    $::LH(w,$thd,negbins) conf -fg $::LH($thd,color)
  } else {
    $::LH(w,$thd,negbins) conf -fg black
  }

  set pyd_max_pos [expr [lindex $pyd end] + $::LH($thd,p,more)]
  set nyd_max_neg [expr [lindex $nyd end] + $::LH($thd,n,more)]

  # display fmt
  set ::LH($thd,p,more) [format %.3g $::LH($thd,p,more)]
  set ::LH($thd,n,more) [format %.3g $::LH($thd,n,more)]

  # remove end bin
  set pyd [lrange $pyd 0 [expr -1 + $::LH($thd,maxbins)]]
  set pxd [lrange $pxd 0 [expr -1 + $::LH($thd,maxbins)]]

  set nyd [lrange $nyd 0 [expr -2 + $::LH($thd,maxbins)]]
  set nxd [lrange $nxd 0 [expr -2 + $::LH($thd,maxbins)]]

  set w $::LH(w,$thd)
  $w element configure pdata -xdata $pxd -ydata $pyd
  $w element configure ndata -xdata $nxd -ydata $nyd

  $w element configure pmaxdata \
     -xdata [expr $::LH($thd,maxbins) * $::LH($thd,binsize,us)] \
     -ydata $pyd_max_pos \
     -stipple pbmap \
     -fg $::LH($thd,color) -bg $pmaxcolor
  $w element configure nmaxdata \
     -xdata [expr -1*$::LH($thd,maxbins) * $::LH($thd,binsize,us)] \
     -ydata $nyd_max_neg \
     -stipple nbmap \
     -fg $::LH($thd,color) -bg $nmaxcolor

  # a y axis configure is needed, updates may fail without it
  $::LH(w,$thd) axis configure y -logscale $::LH(y,logscale)
  update
} ;# update_bin_data

proc popup {msg} { \
  package require Tk
  set answer [tk_messageBox \
     -parent . \
     -icon error \
     -type ok \
     -title "Message" \
     -message  "$msg" \
     ]
   puts $msg
} ;# popup

# Report an unrecoverable error visibly, then tear down and quit so the
# tool never lingers in a broken, non-updating state.
proc fatal {msg} {
  catch {after cancel $::LH(after,repeat)}
  popup $msg
  foreach thd $::LH(threads) {
    if {[info exists ::LH($thd,stream,h)]} {
      catch {hal_stream detach $::LH($thd,stream,h)}
      unset ::LH($thd,stream,h)
    }
  }
  catch {exec pkill glxgears}
  catch {exec halrun -U}
  exit 1
} ;# fatal

proc progress {txt} {
  if !$::LH(verbose) return
  puts stderr "$::argv0: [expr [clock seconds] - $::LH(start)]s $txt"
} ;# progress

proc usage {} {
  set prog [file tail $::argv0]
  puts ""
  puts "Usage:"
  puts "   $prog --help | -?"
  puts "or"
  puts "   $prog \[Options\]"
  puts ""
  puts "Options:"
  puts "  --base      ns   (base  thread interval, default:   $::LH(base,period,ns), min:  $::LH(base,period,ns,min))"
  puts "  --servo     ns   (servo thread interval, default: $::LH(servo,period,ns), min: $::LH(servo,period,ns,min))"

  puts "  --bbinsize  ns   (base  bin size,  default: $::LH(base,binsize,ns))"
  puts "  --sbinsize  ns   (servo bin size, default: $::LH(servo,binsize,ns))"

  puts "  --bbins     n    (base  bins, default: $::LH(base,maxbins))"
  puts "  --sbins     n    (servo bins, default: $::LH(servo,maxbins))"

  puts "  --logscale  0|1  (y axis log scale, default: $::LH(y,logscale))"
  puts "  --text      note (additional note, default: \"$::LH(note,txt)\")"
  puts "  --show           (show count of undisplayed bins)"
  puts "  --nobase         (servo thread only)"
  puts "  --verbose        (progress and debug)"
  puts "  --nox            (no gui, display elapsed,min,max,sdev for each thread)"
  puts "  --legacy         (use original latencybins comp; has RT/non-RT data race)"

  puts ""
  puts "Notes:"
  puts "  Linuxcnc and Hal should not be running, stop with halrun -U."
  puts "  Large number of bins and/or small binsizes will slow updates."
  puts "  For single thread, specify --nobase (and options for servo thread)."
  puts "  Measured latencies outside of the +/- bin range are reported"
  puts "  with special end bars.  Use --show to show count for"
  puts "  the off-chart \[pos|neg\] bin"
  exit 0
} ;# usage

#------------------------------------------------------------------
proc windowToFile { win } {
  if {[catch {set image [lh_chart::capture_window $win]} msg]} {
    popup $msg
    return
  }
  set types {{"Image Files" {.png}}}
  set ifile $::tcl_platform(user)-$::LH(date)-$::LH(elapsed).png
  set filename [tk_getSaveFile -filetypes $types \
      -initialfile  $ifile \
      -initialdir $::LH(dir,screenshot) \
      -defaultextension .png]
  if {[llength $filename]} {
    set ::LH(dir,screenshot) [file dirname $filename]
    $image write -format png $filename
  }
  image delete $image
} ;# windowToFile
#------------------------------------------------------------------

# allow re-sourcing for testing with tkcon
if ![info exists ::LH(start)] {
  set_defaults
  config
  progress "Loading packages"
  load_packages
  signal trap SIGINT finish
  progress "Making gui"
  if $::LH(use_x) make_gui
  progress "Start_collection"
  start_collection
  progress "Begin repeats"
  repeat
} else {
  puts "$::argv0 already running"
}
if !$::LH(use_x) { vwait ::forever }