From a29beaf245c151f597293ff945b0fbc80bc0bebb Mon Sep 17 00:00:00 2001 From: Luca Toniolo <10792599+grandixximo@users.noreply.github.com> Date: Sun, 31 May 2026 16:55:09 +0800 Subject: [PATCH 1/3] hal-histogram, latency-histogram: replace BLT with Tcl/Tk canvas chart BLT has no Tcl/Tk 9 port. Extract the canvas-based lh_chart widget and window-capture helper into lib/hallib/lh_chart.tcl, shared by both tools. latency-histogram now sources it instead of carrying an inline copy; hal-histogram drops blt::barchart, blt::bitmap and blt::winop snap along with the hard BLT and Tclx requirements, so both run on Tcl/Tk 8.6 and 9 alike. Also remove the obsolete base_thread_fp advice from hal-histogram: the HAL uses_fp flag is deprecated and ignored, so all threads are FP-capable and no motmod option is needed. --- lib/hallib/lh_chart.tcl | 538 ++++++++++++++++++++++++++++++++++++++ scripts/hal-histogram | 53 ++-- scripts/latency-histogram | 518 +----------------------------------- 3 files changed, 558 insertions(+), 551 deletions(-) create mode 100644 lib/hallib/lh_chart.tcl diff --git a/lib/hallib/lh_chart.tcl b/lib/hallib/lh_chart.tcl new file mode 100644 index 00000000000..e1e2b8d049c --- /dev/null +++ b/lib/hallib/lh_chart.tcl @@ -0,0 +1,538 @@ +# lh_chart.tcl: minimal canvas-based bar chart + window capture helper. +# +#----------------------------------------------------------------------- +# Copyright: 2012-2016 (lh_chart by Dewey Garrett +# and later contributors) +# +# 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. +#----------------------------------------------------------------------- + +#----------------------------------------------------------------------- +# lh_chart: minimal canvas-based bar chart implementing the subset of +# blt::barchart used by latency-histogram and hal-histogram. Goal: +# visual + behavioral parity without depending on BLT (which has no +# Tcl/Tk 9 port). +# +# Public API (used at $w via command rename + dispatch): +# $w axis configure x|y -min -max -majorticks -logscale -hide -showticks +# $w element create|configure NAME -xdata -ydata -fg -bg -barwidth -stipple +# $w element exists NAME +# $w legend configure -hide 0|1 +# Constructor: +# lh_chart::create $w -title T -width W -height H \ +# -plotbackground COLOR -cursor C +#----------------------------------------------------------------------- +namespace eval lh_chart { + variable state + variable stipple_map + array set stipple_map {} +} + +proc lh_chart::install_stipples {} { + variable stipple_map + if {[info exists stipple_map(_installed)]} return + set dir /tmp/lh_chart_stipples_[pid] + catch {file mkdir $dir} + # Tk's XBM reader is picky: needs static char (signed, not unsigned) + # and the data block in K&R-style continuation form with a trailing + # closing-brace-semicolon on its own line. One-liners are rejected. + foreach {name bits} { + pbmap {0xe3 0xf1 0xf8 0x7c 0x3e 0x1f 0x8f 0xc7} + nbmap {0xc7 0x8f 0x1f 0x3e 0x7c 0xf8 0xf1 0xe3} + } { + set fp [open $dir/$name.xbm w] + puts $fp "#define ${name}_width 8" + puts $fp "#define ${name}_height 8" + puts $fp "static char ${name}_bits\[\] = \{" + puts $fp " [join $bits {, }]\};" + close $fp + set stipple_map($name) "@$dir/$name.xbm" + } + set stipple_map(_installed) 1 +} + +proc lh_chart::create {w args} { + variable state + install_stipples + array set opts { + -title "" + -width 480 + -height 384 + -plotbackground honeydew1 + -cursor arrow + } + array set opts $args + canvas $w \ + -width $opts(-width) \ + -height $opts(-height) \ + -bg "#d9d9d9" \ + -bd 0 -highlightthickness 0 \ + -cursor $opts(-cursor) + set state($w,title) $opts(-title) + set state($w,width) $opts(-width) + set state($w,height) $opts(-height) + set state($w,plotbg) $opts(-plotbackground) + set state($w,xmin) -1.0 + set state($w,xmax) 1.0 + set state($w,ymin) 0.0 + set state($w,ymax) 1.0 + set state($w,ylogscale) 0 + set state($w,xticks) {} + set state($w,elements) {} + set state($w,legend_hide) 1 + set state($w,dirty) 1 + set state($w,redraw_pending) 0 + bind $w [list lh_chart::on_configure $w] + rename ::$w ::lh_chart::_orig_$w + proc ::$w {args} "::lh_chart::dispatch $w {*}\$args" + lh_chart::schedule_redraw $w + return $w +} + +proc lh_chart::dispatch {w args} { + set sub [lindex $args 0] + set rest [lrange $args 1 end] + switch -- $sub { + axis { return [lh_chart::cmd_axis $w {*}$rest] } + element { return [lh_chart::cmd_element $w {*}$rest] } + legend { return [lh_chart::cmd_legend $w {*}$rest] } + default { return [::lh_chart::_orig_$w {*}$args] } + } +} + +proc lh_chart::cmd_axis {w sub which args} { + variable state + if {$sub ne "configure"} { error "lh_chart axis: unsupported subcommand $sub" } + array set opts $args + if {$which eq "x"} { + if {[info exists opts(-min)]} { set state($w,xmin) $opts(-min) } + if {[info exists opts(-max)]} { set state($w,xmax) $opts(-max) } + if {[info exists opts(-majorticks)]} { set state($w,xticks) $opts(-majorticks) } + } elseif {$which eq "y"} { + if {[info exists opts(-logscale)]} { set state($w,ylogscale) $opts(-logscale) } + if {[info exists opts(-min)]} { set state($w,ymin) $opts(-min) } + if {[info exists opts(-max)]} { set state($w,ymax) $opts(-max) } + } + schedule_redraw $w +} + +proc lh_chart::cmd_element {w op name args} { + variable state + variable stipple_map + switch -- $op { + exists { + return [expr {[lsearch -exact $state($w,elements) $name] >= 0}] + } + create { + if {[lsearch -exact $state($w,elements) $name] < 0} { + lappend state($w,elements) $name + } + set state($w,el,$name,xdata) {} + set state($w,el,$name,ydata) {} + set state($w,el,$name,fg) black + set state($w,el,$name,bg) lightblue + set state($w,el,$name,barwidth) 1.0 + set state($w,el,$name,stipple) {} + cmd_element_apply $w $name $args + } + configure { + cmd_element_apply $w $name $args + } + default { error "lh_chart element: unsupported op $op" } + } + schedule_redraw $w +} + +proc lh_chart::cmd_element_apply {w name optlist} { + variable state + variable stipple_map + array set opts $optlist + foreach {k storekey} { + -xdata xdata + -ydata ydata + -fg fg + -bg bg + -barwidth barwidth + } { + if {[info exists opts($k)]} { + set state($w,el,$name,$storekey) $opts($k) + } + } + if {[info exists opts(-stipple)]} { + set s $opts(-stipple) + if {[info exists stipple_map($s)]} { set s $stipple_map($s) } + set state($w,el,$name,stipple) $s + } +} + +proc lh_chart::cmd_legend {w sub args} { + variable state + if {$sub eq "configure"} { + array set opts $args + if {[info exists opts(-hide)]} { set state($w,legend_hide) $opts(-hide) } + } +} + +proc lh_chart::on_configure {w} { + variable state + if {![info exists state($w,width)]} return + set state($w,width) [winfo width $w] + set state($w,height) [winfo height $w] + schedule_redraw $w +} + +proc lh_chart::schedule_redraw {w} { + variable state + set state($w,dirty) 1 + if {$state($w,redraw_pending)} return + set state($w,redraw_pending) 1 + after idle [list lh_chart::redraw $w] +} + +proc lh_chart::redraw {w} { + variable state + set state($w,redraw_pending) 0 + if {![winfo exists $w]} return + if {!$state($w,dirty)} return + set state($w,dirty) 0 + set c ::lh_chart::_orig_$w + $c delete all + + set W $state($w,width) + set H $state($w,height) + if {$W <= 1} { set W $state($w,width) } + + set ml 55 ; set mr 18 ; set mt 20 ; set mb 42 + set pw [expr {$W - $ml - $mr}] + set ph [expr {$H - $mt - $mb}] + if {$pw < 50 || $ph < 50} return + # Data inset: keep off-chart end bars (red-stippled at xmin/xmax) + # visibly inward from the border, matching BLT's plot margin. + set pad 8 + set ml_d [expr {$ml + $pad}] + set mt_d [expr {$mt + $pad}] + set pw_d [expr {$pw - 2*$pad}] + set ph_d [expr {$ph - 2*$pad}] + + set xmin $state($w,xmin) + set xmax $state($w,xmax) + set xrange [expr {double($xmax - $xmin)}] + if {$xrange == 0} { set xrange 1.0 } + + # auto-scale Y from element data + set ymax_data 1.0 + foreach name $state($w,elements) { + foreach v $state($w,el,$name,ydata) { + if {$v > $ymax_data} { set ymax_data $v } + } + } + if {$state($w,ylogscale)} { + set ymin 1.0 + if {$ymax_data < 10} { + set ymax 10.0 + } else { + # Nice ceiling: 1, 2, 5 times the decade — keeps Y range + # tight so a small data growth doesn't jump a full decade. + set decade [expr {pow(10, floor(log10($ymax_data)))}] + set ratio [expr {$ymax_data / $decade}] + if {$ratio <= 1.0} { + set ymax $decade + } elseif {$ratio <= 2.0} { + set ymax [expr {2.0 * $decade}] + } elseif {$ratio <= 5.0} { + set ymax [expr {5.0 * $decade}] + } else { + set ymax [expr {10.0 * $decade}] + } + } + } else { + set ymin 0.0 + # Nice ceiling for ymax: pick 1, 2, 2.5, 5, or 10 times a decade + # so the 5 equal ticks become round numbers (e.g. 0, 600, 1200, + # 1800, 2400, 3000) instead of (0, 580, 1160, ...). + if {$ymax_data <= 0} { + set ymax 1.0 + } else { + set goal [expr {$ymax_data * 1.05}] + set decade [expr {pow(10, floor(log10($goal)))}] + set ratio [expr {$goal / $decade}] + if {$ratio <= 1.0} { + set ymax $decade + } elseif {$ratio <= 2.0} { + set ymax [expr {2.0 * $decade}] + } elseif {$ratio <= 2.5} { + set ymax [expr {2.5 * $decade}] + } elseif {$ratio <= 5.0} { + set ymax [expr {5.0 * $decade}] + } else { + set ymax [expr {10.0 * $decade}] + } + } + } + set state($w,ymin) $ymin + set state($w,ymax) $ymax + + set lxmin [expr {$state($w,ylogscale) ? log10($ymin) : 0}] + set lxmax [expr {$state($w,ylogscale) ? log10($ymax) : 0}] + set lyrange [expr {$lxmax - $lxmin}] + if {$lyrange == 0} { set lyrange 1 } + + # plot area background (no border yet, axis lines drawn last) + $c create rectangle $ml $mt [expr {$ml+$pw}] [expr {$mt+$ph}] \ + -fill $state($w,plotbg) -outline "" + + # title + if {$state($w,title) ne ""} { + $c create text [expr {$ml + $pw/2}] [expr {$mt - 9}] \ + -text $state($w,title) -anchor center -font {Helvetica -12} + } + + # Y axis: build tick lists + draw gridlines now (ticks/labels at end). + # Major ticks get a label and a long tick line; minor ticks at every + # sub-decade gridline get a short tick line only (matches BLT). + set y_ticks {} ;# list of {value label} — major + set y_minor_ticks {} ;# list of values — minor + if {$state($w,ylogscale)} { + # Minor gridlines at 2..9 within each decade + set d 1.0 + while {$d < $ymax + 0.1} { + for {set k 2} {$k <= 9} {incr k} { + set v [expr {$d * $k}] + if {$v > $ymax + 0.1} break + set y [lh_chart::ymap_log $mt_d $ph_d $ymin $ymax $v] + $c create line $ml $y [expr {$ml+$pw}] $y \ + -fill gray70 -dash {1 1} + lappend y_minor_ticks $v + } + set d [expr {$d * 10}] + } + # Major gridlines at each decade + set d 1.0 + set exp 0 + while {$d <= $ymax + 0.001} { + set y [lh_chart::ymap_log $mt_d $ph_d $ymin $ymax $d] + $c create line $ml $y [expr {$ml+$pw}] $y -fill gray70 -dash {1 1} + lappend y_ticks [list $d "1E$exp"] + set d [expr {$d * 10}] + incr exp + } + # Cap tick at ymax if it sits between decades (2x or 5x of decade) + set top_decade [expr {pow(10, floor(log10($ymax) + 1e-9))}] + set top_ratio [expr {$ymax / $top_decade}] + if {$top_ratio > 1.5} { + set top_exp [expr {int(floor(log10($ymax) + 1e-9))}] + set top_mant [expr {int(round($top_ratio))}] + lappend y_ticks [list $ymax "${top_mant}E$top_exp"] + } + } else { + set steps 5 + for {set i 0} {$i <= $steps} {incr i} { + set v [expr {$ymin + ($ymax - $ymin) * $i / double($steps)}] + set y [lh_chart::ymap_lin $mt_d $ph_d $ymin $ymax $v] + $c create line $ml $y [expr {$ml+$pw}] $y -fill gray80 -dash {2 2} + lappend y_ticks [list $v [lh_chart::fmt_num $v]] + } + } + + # baseline (y=0 in linear or y=1 in log) using inset mapping + set y0 [expr {$state($w,ylogscale) \ + ? [lh_chart::ymap_log $mt_d $ph_d $ymin $ymax 1.0] \ + : [lh_chart::ymap_lin $mt_d $ph_d $ymin $ymax 0.0]}] + + # Bars: BLT semantics — `-fg` is the fill color, `-bg` shows through + # stipple. We draw solid fg-fill with matching outline so narrow bars + # render as a single fg-colored column (1-2 px) without any sub-bar + # outline lines splitting adjacent bars. For stippled bars (off-chart + # indicators) we paint bg first, then a stippled fg layer on top. + foreach name $state($w,elements) { + set xd $state($w,el,$name,xdata) + set yd $state($w,el,$name,ydata) + set bw $state($w,el,$name,barwidth) + set fg $state($w,el,$name,fg) + set bg $state($w,el,$name,bg) + set st $state($w,el,$name,stipple) + set hbw [expr {$bw / 2.0}] + foreach x $xd y $yd { + if {$y <= 0} continue + if {$state($w,ylogscale) && $y < $ymin} continue + set xa [expr {$x - $hbw}] + set xb [expr {$x + $hbw}] + if {$xb < $xmin || $xa > $xmax} continue + if {$xa < $xmin} { set xa $xmin } + if {$xb > $xmax} { set xb $xmax } + set pxa [lh_chart::xmap $ml_d $pw_d $xmin $xrange $xa] + set pxb [lh_chart::xmap $ml_d $pw_d $xmin $xrange $xb] + # Pixel-snap so sub-pixel bars (e.g. 0.1us bins at ~1.2 px each) + # always paint at least one full pixel and adjacent bars touch. + set pxa [expr {int(floor($pxa))}] + set pxb [expr {int(ceil($pxb))}] + if {$pxb <= $pxa} { set pxb [expr {$pxa + 1}] } + # Off-chart (stippled) end-of-range bars: minimum 2 px so the + # stipple pattern is actually visible and matches BLT. + if {$st ne "" && [expr {$pxb - $pxa}] < 2} { + set pxb [expr {$pxa + 2}] + } + if {$state($w,ylogscale)} { + set py [lh_chart::ymap_log $mt_d $ph_d $ymin $ymax $y] + } else { + set py [lh_chart::ymap_lin $mt_d $ph_d $ymin $ymax $y] + } + if {$st ne ""} { + $c create rectangle $pxa $py $pxb $y0 \ + -fill $bg -outline $bg -width 0 + $c create rectangle $pxa $py $pxb $y0 \ + -fill $fg -outline $fg -width 0 -stipple $st + } else { + $c create rectangle $pxa $py $pxb $y0 \ + -fill $fg -outline $fg -width 0 + } + } + # Continuous baseline: 1 px line in the element's fg color along + # the bottom of the data area, so the bottom doesn't look broken + # where bins have zero counts. + if {[llength $xd] > 0} { + $c create line \ + [lh_chart::xmap $ml_d $pw_d $xmin $xrange $xmin] $y0 \ + [lh_chart::xmap $ml_d $pw_d $xmin $xrange $xmax] $y0 \ + -fill $fg + } + } + + # Plot frame: 3D raised look. Only TOP and LEFT have a black outline + # (the lit edges); BOTTOM and RIGHT are left without an outer black + # line. Inside, top+left have a darker shadow line and bottom+right + # a lighter highlight, giving the panel-edge relief BLT used. + set xR [expr {$ml+$pw}] + set yB [expr {$mt+$ph}] + $c create line $ml $mt $xR $mt -fill black + $c create line $ml $mt $ml $yB -fill black + $c create line [expr {$ml+1}] [expr {$mt+1}] [expr {$xR-1}] [expr {$mt+1}] \ + -fill gray45 + $c create line [expr {$ml+1}] [expr {$mt+1}] [expr {$ml+1}] [expr {$yB-1}] \ + -fill gray45 + $c create line [expr {$ml+1}] [expr {$yB-1}] [expr {$xR-1}] [expr {$yB-1}] \ + -fill white + $c create line [expr {$xR-1}] [expr {$mt+1}] [expr {$xR-1}] [expr {$yB-1}] \ + -fill white + + # Axis line: separate black line OUTSIDE the plot border, with a + # small gap between them. Spans only the data-inset range so its + # endpoints sit right at the topmost and bottommost ticks (BLT + # behavior — the axis "ends with the last tick"). + set axis_gap 4 + set tick_long 10 + set tick_short 5 + set axis_x [expr {$ml - $axis_gap}] ;# left axis (Y) + set axis_y [expr {$yB + $axis_gap}] ;# bottom axis (X) + set axis_top $mt_d ;# = $mt + pad + set axis_bottom [expr {$mt_d + $ph_d}] + set axis_left $ml_d ;# = $ml + pad + set axis_right [expr {$ml_d + $pw_d}] + $c create line $axis_x $axis_top $axis_x $axis_bottom -fill black + $c create line $axis_left $axis_y $axis_right $axis_y -fill black + + # Tick marks attach to (touch) the axis line and point OUTWARD + # toward the labels. Major ticks long, minor ticks (Y only) short. + foreach v $y_minor_ticks { + set y [lh_chart::ymap_log $mt_d $ph_d $ymin $ymax $v] + $c create line [expr {$axis_x - $tick_short}] $y $axis_x $y \ + -fill black + } + foreach pair $y_ticks { + lassign $pair v label + if {$state($w,ylogscale)} { + set y [lh_chart::ymap_log $mt_d $ph_d $ymin $ymax $v] + } else { + set y [lh_chart::ymap_lin $mt_d $ph_d $ymin $ymax $v] + } + $c create line [expr {$axis_x - $tick_long}] $y $axis_x $y \ + -fill black + $c create text [expr {$axis_x - $tick_long - 2}] $y \ + -text $label -anchor e -font {Helvetica -10} + } + set xticks $state($w,xticks) + if {[llength $xticks] == 0} { + set xticks [list $xmin [expr {($xmin+$xmax)/2.0}] $xmax] + } + foreach t $xticks { + if {$t < $xmin - 1e-9 || $t > $xmax + 1e-9} continue + set x [lh_chart::xmap $ml_d $pw_d $xmin $xrange $t] + $c create line $x $axis_y $x [expr {$axis_y + $tick_long}] \ + -fill black + $c create text $x [expr {$axis_y + $tick_long + 2}] \ + -text [format %g $t] -anchor n -font {Helvetica -10} + } +} + +proc lh_chart::fmt_num {v} { + # Format a number for axis labels. Switch to sci notation (e.g. + # 2E5, 1.5E6) once we'd otherwise need 5+ digits, so labels stay + # narrow enough to fit in the left margin. + if {$v == 0} { return "0" } + set av [expr {abs($v)}] + if {$av >= 10000 || $av < 0.01} { + set exp [expr {int(floor(log10($av) + 1e-9))}] + set mant [expr {$v / pow(10, $exp)}] + if {abs($mant - round($mant)) < 0.05} { + return [format "%dE%d" [expr {int(round($mant))}] $exp] + } else { + return [format "%.1fE%d" $mant $exp] + } + } + if {$v == int($v)} { return [format %.0f $v] } + return [format %g $v] +} + +proc lh_chart::xmap {ml pw xmin xrange v} { + return [expr {$ml + ($v - $xmin) / $xrange * $pw}] +} +proc lh_chart::ymap_lin {mt ph ymin ymax v} { + set r [expr {$ymax - $ymin}] + if {$r == 0} { set r 1 } + return [expr {$mt + $ph - ($v - $ymin) / double($r) * $ph}] +} +proc lh_chart::ymap_log {mt ph ymin ymax v} { + if {$v < $ymin} { set v $ymin } + set lmin [expr {log10($ymin)}] + set lmax [expr {log10($ymax)}] + set r [expr {$lmax - $lmin}] + if {$r == 0} { set r 1 } + set lv [expr {log10($v)}] + return [expr {$mt + $ph - ($lv - $lmin) / $r * $ph}] +} + +#------------------------------------------------------------------ +# Window capture without BLT. Strategy: +# 1. Tk 8.7+/9: image create photo -format window can grab a window. +# 2. Else: use ImageMagick `import -window ` to a temp PNG. +# Returns a tk photo image; caller is responsible for `image delete`. +proc lh_chart::capture_window {win} { + update idletasks + set img [image create photo] + if {![catch {$img read $win -format window} err]} { + return $img + } + image delete $img + set wid [winfo id $win] + set tmp /tmp/lh_snap_[pid]_[clock clicks].png + if {[catch {exec import -window $wid $tmp} err]} { + catch {file delete $tmp} + error "screenshot needs ImageMagick (apt install imagemagick): $err" + } + set img [image create photo -file $tmp] + catch {file delete $tmp} + return $img +} +#------------------------------------------------------------------ diff --git a/scripts/hal-histogram b/scripts/hal-histogram index d76d5af20ba..2cfe1a9287f 100755 --- a/scripts/hal-histogram +++ b/scripts/hal-histogram @@ -26,6 +26,9 @@ # started without using the linuxcnc script and # ::env(HALLIB_DIR) will not exist. source [file join [exec linuxcnc_var HALLIB_DIR] hal_procs_lib.tcl] +# lh_chart canvas bar-chart widget (replaces BLT, which has no Tcl/Tk 9 +# port). Shared with latency-histogram. +source [file join [exec linuxcnc_var HALLIB_DIR] lh_chart.tcl] proc threadname_for_pin {pinname} { thread_info tmp @@ -217,17 +220,13 @@ proc config {} { } ;# config proc load_packages {} { - if [catch {package require Tclx} msg] { - puts $msg - puts "To install: sudo apt-get install tclx" - exit 1 - } - signal trap SIGINT finish ;# uses Tclx - if [catch {package require BLT} msg] { - puts $msg - puts "To install: sudo apt-get install blt" - exit 1 + # Tclx is unavailable on Tcl 9; stub `signal` so the one trap call still + # works (Ctrl-C then won't run finish, but the GUI Exit button does). + if {[catch {package require Tclx}]} { + proc signal {args} {} ;# no-op stub } + signal trap SIGINT finish + # BLT no longer required: lh_chart draws the histogram on a Tk canvas. # augment ::auto_path for special case: # 1) RIP build (no install) @@ -243,14 +242,6 @@ proc load_packages {} { puts "For a RIP linuxcnc build, source rip-environment in this shell" exit 1 } - blt::bitmap define nbmap { - {8 8} - {0xc7,0x8f,0x1f,0x3e,0x7c, 0xf8,0xf1,0xe3} - } - blt::bitmap define pbmap { - {8 8} - {0xe3,0xf1,0xf8,0x7c, 0x3e,0x1f,0x8f,0xc7} - } } ;# load_packages proc make_gui { {w .} } { @@ -283,10 +274,11 @@ OS: $::tcl_platform(osVersion) [exec hostname]" \ set ::HH(widget) $f.graph catch {destroy $::HH(widget)} - blt::barchart $::HH(widget) \ + lh_chart::create $::HH(widget) \ -plotbackground honeydew1 \ -cursor arrow \ - -title "" + -title "" \ + -width 480 -height 384 pack $::HH(widget) -side left xaxis @@ -547,13 +539,6 @@ proc setup_hal {} { set ::HH(threadname) [threadname_for_pin $::HH(pinname)] - thread_info tinfo - if !$tinfo($::HH(threadname),fp) { - usage \ -"\n$::HH(pinname) must be running on a thread with floating point enabled -Use the loadrt motmod option: base_thread_fp=1" - } - if {[is_connected $::HH(pinname) signame] == "not_connected"} { set ::HH(signame) $::HH(signame,prefix,$::HH(pintype))-$idx set ::HH(signame_is_new) 1 @@ -861,9 +846,6 @@ proc usage { {errtxt ""} } { puts " 2) If no pinname is specified, default is: $::HH(pinname)" puts " 3) This app may be opened for $::HH(max_histos) pins" puts " 4) pintypes float, s32, u32, bit are supported" - puts " 5) The pin must be associated with a thread supporting floating point" - puts " For a base thread, this may require using:" - puts " loadrt motmod ... base_thread_fp=1" if {"$errtxt" != ""} { puts "" @@ -875,14 +857,11 @@ proc usage { {errtxt ""} } { } ;# usage #------------------------------------------------------------------ -proc bltCaptureWindow { win } { - set image [image create photo] - blt::winop snap $win $image - return $image -} ;# bltCaptureWindow - proc windowToFile { win } { - set image [bltCaptureWindow $win] + if {[catch {set image [lh_chart::capture_window $win]} msg]} { + popup $msg + return + } set types {{"Image Files" {.png}}} set ifile $::tcl_platform(user)-$::HH(date)-$::HH(elapsed).png set filename [tk_getSaveFile -filetypes $types \ diff --git a/scripts/latency-histogram b/scripts/latency-histogram index 99e2542df7d..014b63f582f 100755 --- a/scripts/latency-histogram +++ b/scripts/latency-histogram @@ -27,498 +27,10 @@ set ::MICROSEC \u00b5s #----------------------------------------------------------------------- -# lh_chart: minimal canvas-based bar chart implementing the subset of -# blt::barchart used by this script. Goal: visual + behavioral parity -# without depending on BLT (which has no Tcl/Tk 9 port). -# -# Public API (used at $w via command rename + dispatch): -# $w axis configure x|y -min -max -majorticks -logscale -hide -showticks -# $w element create|configure NAME -xdata -ydata -fg -bg -barwidth -stipple -# $w element exists NAME -# $w legend configure -hide 0|1 -# Constructor: -# lh_chart::create $w -title T -width W -height H \ -# -plotbackground COLOR -cursor C -#----------------------------------------------------------------------- -namespace eval lh_chart { - variable state - variable stipple_map - array set stipple_map {} -} - -proc lh_chart::install_stipples {} { - variable stipple_map - if {[info exists stipple_map(_installed)]} return - set dir /tmp/lh_chart_stipples_[pid] - catch {file mkdir $dir} - # Tk's XBM reader is picky: needs static char (signed, not unsigned) - # and the data block in K&R-style continuation form with a trailing - # closing-brace-semicolon on its own line. One-liners are rejected. - foreach {name bits} { - pbmap {0xe3 0xf1 0xf8 0x7c 0x3e 0x1f 0x8f 0xc7} - nbmap {0xc7 0x8f 0x1f 0x3e 0x7c 0xf8 0xf1 0xe3} - } { - set fp [open $dir/$name.xbm w] - puts $fp "#define ${name}_width 8" - puts $fp "#define ${name}_height 8" - puts $fp "static char ${name}_bits\[\] = \{" - puts $fp " [join $bits {, }]\};" - close $fp - set stipple_map($name) "@$dir/$name.xbm" - } - set stipple_map(_installed) 1 -} - -proc lh_chart::create {w args} { - variable state - install_stipples - array set opts { - -title "" - -width 480 - -height 384 - -plotbackground honeydew1 - -cursor arrow - } - array set opts $args - canvas $w \ - -width $opts(-width) \ - -height $opts(-height) \ - -bg "#d9d9d9" \ - -bd 0 -highlightthickness 0 \ - -cursor $opts(-cursor) - set state($w,title) $opts(-title) - set state($w,width) $opts(-width) - set state($w,height) $opts(-height) - set state($w,plotbg) $opts(-plotbackground) - set state($w,xmin) -1.0 - set state($w,xmax) 1.0 - set state($w,ymin) 0.0 - set state($w,ymax) 1.0 - set state($w,ylogscale) 0 - set state($w,xticks) {} - set state($w,elements) {} - set state($w,legend_hide) 1 - set state($w,dirty) 1 - set state($w,redraw_pending) 0 - bind $w [list lh_chart::on_configure $w] - rename ::$w ::lh_chart::_orig_$w - proc ::$w {args} "::lh_chart::dispatch $w {*}\$args" - lh_chart::schedule_redraw $w - return $w -} - -proc lh_chart::dispatch {w args} { - set sub [lindex $args 0] - set rest [lrange $args 1 end] - switch -- $sub { - axis { return [lh_chart::cmd_axis $w {*}$rest] } - element { return [lh_chart::cmd_element $w {*}$rest] } - legend { return [lh_chart::cmd_legend $w {*}$rest] } - default { return [::lh_chart::_orig_$w {*}$args] } - } -} - -proc lh_chart::cmd_axis {w sub which args} { - variable state - if {$sub ne "configure"} { error "lh_chart axis: unsupported subcommand $sub" } - array set opts $args - if {$which eq "x"} { - if {[info exists opts(-min)]} { set state($w,xmin) $opts(-min) } - if {[info exists opts(-max)]} { set state($w,xmax) $opts(-max) } - if {[info exists opts(-majorticks)]} { set state($w,xticks) $opts(-majorticks) } - } elseif {$which eq "y"} { - if {[info exists opts(-logscale)]} { set state($w,ylogscale) $opts(-logscale) } - if {[info exists opts(-min)]} { set state($w,ymin) $opts(-min) } - if {[info exists opts(-max)]} { set state($w,ymax) $opts(-max) } - } - schedule_redraw $w -} - -proc lh_chart::cmd_element {w op name args} { - variable state - variable stipple_map - switch -- $op { - exists { - return [expr {[lsearch -exact $state($w,elements) $name] >= 0}] - } - create { - if {[lsearch -exact $state($w,elements) $name] < 0} { - lappend state($w,elements) $name - } - set state($w,el,$name,xdata) {} - set state($w,el,$name,ydata) {} - set state($w,el,$name,fg) black - set state($w,el,$name,bg) lightblue - set state($w,el,$name,barwidth) 1.0 - set state($w,el,$name,stipple) {} - cmd_element_apply $w $name $args - } - configure { - cmd_element_apply $w $name $args - } - default { error "lh_chart element: unsupported op $op" } - } - schedule_redraw $w -} - -proc lh_chart::cmd_element_apply {w name optlist} { - variable state - variable stipple_map - array set opts $optlist - foreach {k storekey} { - -xdata xdata - -ydata ydata - -fg fg - -bg bg - -barwidth barwidth - } { - if {[info exists opts($k)]} { - set state($w,el,$name,$storekey) $opts($k) - } - } - if {[info exists opts(-stipple)]} { - set s $opts(-stipple) - if {[info exists stipple_map($s)]} { set s $stipple_map($s) } - set state($w,el,$name,stipple) $s - } -} - -proc lh_chart::cmd_legend {w sub args} { - variable state - if {$sub eq "configure"} { - array set opts $args - if {[info exists opts(-hide)]} { set state($w,legend_hide) $opts(-hide) } - } -} - -proc lh_chart::on_configure {w} { - variable state - if {![info exists state($w,width)]} return - set state($w,width) [winfo width $w] - set state($w,height) [winfo height $w] - schedule_redraw $w -} - -proc lh_chart::schedule_redraw {w} { - variable state - set state($w,dirty) 1 - if {$state($w,redraw_pending)} return - set state($w,redraw_pending) 1 - after idle [list lh_chart::redraw $w] -} - -proc lh_chart::redraw {w} { - variable state - set state($w,redraw_pending) 0 - if {![winfo exists $w]} return - if {!$state($w,dirty)} return - set state($w,dirty) 0 - set c ::lh_chart::_orig_$w - $c delete all - - set W $state($w,width) - set H $state($w,height) - if {$W <= 1} { set W $state($w,width) } - - set ml 55 ; set mr 18 ; set mt 20 ; set mb 42 - set pw [expr {$W - $ml - $mr}] - set ph [expr {$H - $mt - $mb}] - if {$pw < 50 || $ph < 50} return - # Data inset: keep off-chart end bars (red-stippled at xmin/xmax) - # visibly inward from the border, matching BLT's plot margin. - set pad 8 - set ml_d [expr {$ml + $pad}] - set mt_d [expr {$mt + $pad}] - set pw_d [expr {$pw - 2*$pad}] - set ph_d [expr {$ph - 2*$pad}] - - set xmin $state($w,xmin) - set xmax $state($w,xmax) - set xrange [expr {double($xmax - $xmin)}] - if {$xrange == 0} { set xrange 1.0 } - - # auto-scale Y from element data - set ymax_data 1.0 - foreach name $state($w,elements) { - foreach v $state($w,el,$name,ydata) { - if {$v > $ymax_data} { set ymax_data $v } - } - } - if {$state($w,ylogscale)} { - set ymin 1.0 - if {$ymax_data < 10} { - set ymax 10.0 - } else { - # Nice ceiling: 1, 2, 5 times the decade — keeps Y range - # tight so a small data growth doesn't jump a full decade. - set decade [expr {pow(10, floor(log10($ymax_data)))}] - set ratio [expr {$ymax_data / $decade}] - if {$ratio <= 1.0} { - set ymax $decade - } elseif {$ratio <= 2.0} { - set ymax [expr {2.0 * $decade}] - } elseif {$ratio <= 5.0} { - set ymax [expr {5.0 * $decade}] - } else { - set ymax [expr {10.0 * $decade}] - } - } - } else { - set ymin 0.0 - # Nice ceiling for ymax: pick 1, 2, 2.5, 5, or 10 times a decade - # so the 5 equal ticks become round numbers (e.g. 0, 600, 1200, - # 1800, 2400, 3000) instead of (0, 580, 1160, ...). - if {$ymax_data <= 0} { - set ymax 1.0 - } else { - set goal [expr {$ymax_data * 1.05}] - set decade [expr {pow(10, floor(log10($goal)))}] - set ratio [expr {$goal / $decade}] - if {$ratio <= 1.0} { - set ymax $decade - } elseif {$ratio <= 2.0} { - set ymax [expr {2.0 * $decade}] - } elseif {$ratio <= 2.5} { - set ymax [expr {2.5 * $decade}] - } elseif {$ratio <= 5.0} { - set ymax [expr {5.0 * $decade}] - } else { - set ymax [expr {10.0 * $decade}] - } - } - } - set state($w,ymin) $ymin - set state($w,ymax) $ymax - - set lxmin [expr {$state($w,ylogscale) ? log10($ymin) : 0}] - set lxmax [expr {$state($w,ylogscale) ? log10($ymax) : 0}] - set lyrange [expr {$lxmax - $lxmin}] - if {$lyrange == 0} { set lyrange 1 } - - # plot area background (no border yet, axis lines drawn last) - $c create rectangle $ml $mt [expr {$ml+$pw}] [expr {$mt+$ph}] \ - -fill $state($w,plotbg) -outline "" - - # title - if {$state($w,title) ne ""} { - $c create text [expr {$ml + $pw/2}] [expr {$mt - 9}] \ - -text $state($w,title) -anchor center -font {Helvetica -12} - } - - # Y axis: build tick lists + draw gridlines now (ticks/labels at end). - # Major ticks get a label and a long tick line; minor ticks at every - # sub-decade gridline get a short tick line only (matches BLT). - set y_ticks {} ;# list of {value label} — major - set y_minor_ticks {} ;# list of values — minor - if {$state($w,ylogscale)} { - # Minor gridlines at 2..9 within each decade - set d 1.0 - while {$d < $ymax + 0.1} { - for {set k 2} {$k <= 9} {incr k} { - set v [expr {$d * $k}] - if {$v > $ymax + 0.1} break - set y [lh_chart::ymap_log $mt_d $ph_d $ymin $ymax $v] - $c create line $ml $y [expr {$ml+$pw}] $y \ - -fill gray70 -dash {1 1} - lappend y_minor_ticks $v - } - set d [expr {$d * 10}] - } - # Major gridlines at each decade - set d 1.0 - set exp 0 - while {$d <= $ymax + 0.001} { - set y [lh_chart::ymap_log $mt_d $ph_d $ymin $ymax $d] - $c create line $ml $y [expr {$ml+$pw}] $y -fill gray70 -dash {1 1} - lappend y_ticks [list $d "1E$exp"] - set d [expr {$d * 10}] - incr exp - } - # Cap tick at ymax if it sits between decades (2x or 5x of decade) - set top_decade [expr {pow(10, floor(log10($ymax) + 1e-9))}] - set top_ratio [expr {$ymax / $top_decade}] - if {$top_ratio > 1.5} { - set top_exp [expr {int(floor(log10($ymax) + 1e-9))}] - set top_mant [expr {int(round($top_ratio))}] - lappend y_ticks [list $ymax "${top_mant}E$top_exp"] - } - } else { - set steps 5 - for {set i 0} {$i <= $steps} {incr i} { - set v [expr {$ymin + ($ymax - $ymin) * $i / double($steps)}] - set y [lh_chart::ymap_lin $mt_d $ph_d $ymin $ymax $v] - $c create line $ml $y [expr {$ml+$pw}] $y -fill gray80 -dash {2 2} - lappend y_ticks [list $v [lh_chart::fmt_num $v]] - } - } - - # baseline (y=0 in linear or y=1 in log) using inset mapping - set y0 [expr {$state($w,ylogscale) \ - ? [lh_chart::ymap_log $mt_d $ph_d $ymin $ymax 1.0] \ - : [lh_chart::ymap_lin $mt_d $ph_d $ymin $ymax 0.0]}] - - # Bars: BLT semantics — `-fg` is the fill color, `-bg` shows through - # stipple. We draw solid fg-fill with matching outline so narrow bars - # render as a single fg-colored column (1-2 px) without any sub-bar - # outline lines splitting adjacent bars. For stippled bars (off-chart - # indicators) we paint bg first, then a stippled fg layer on top. - foreach name $state($w,elements) { - set xd $state($w,el,$name,xdata) - set yd $state($w,el,$name,ydata) - set bw $state($w,el,$name,barwidth) - set fg $state($w,el,$name,fg) - set bg $state($w,el,$name,bg) - set st $state($w,el,$name,stipple) - set hbw [expr {$bw / 2.0}] - foreach x $xd y $yd { - if {$y <= 0} continue - if {$state($w,ylogscale) && $y < $ymin} continue - set xa [expr {$x - $hbw}] - set xb [expr {$x + $hbw}] - if {$xb < $xmin || $xa > $xmax} continue - if {$xa < $xmin} { set xa $xmin } - if {$xb > $xmax} { set xb $xmax } - set pxa [lh_chart::xmap $ml_d $pw_d $xmin $xrange $xa] - set pxb [lh_chart::xmap $ml_d $pw_d $xmin $xrange $xb] - # Pixel-snap so sub-pixel bars (e.g. 0.1us bins at ~1.2 px each) - # always paint at least one full pixel and adjacent bars touch. - set pxa [expr {int(floor($pxa))}] - set pxb [expr {int(ceil($pxb))}] - if {$pxb <= $pxa} { set pxb [expr {$pxa + 1}] } - # Off-chart (stippled) end-of-range bars: minimum 2 px so the - # stipple pattern is actually visible and matches BLT. - if {$st ne "" && [expr {$pxb - $pxa}] < 2} { - set pxb [expr {$pxa + 2}] - } - if {$state($w,ylogscale)} { - set py [lh_chart::ymap_log $mt_d $ph_d $ymin $ymax $y] - } else { - set py [lh_chart::ymap_lin $mt_d $ph_d $ymin $ymax $y] - } - if {$st ne ""} { - $c create rectangle $pxa $py $pxb $y0 \ - -fill $bg -outline $bg -width 0 - $c create rectangle $pxa $py $pxb $y0 \ - -fill $fg -outline $fg -width 0 -stipple $st - } else { - $c create rectangle $pxa $py $pxb $y0 \ - -fill $fg -outline $fg -width 0 - } - } - # Continuous baseline: 1 px line in the element's fg color along - # the bottom of the data area, so the bottom doesn't look broken - # where bins have zero counts. - if {[llength $xd] > 0} { - $c create line \ - [lh_chart::xmap $ml_d $pw_d $xmin $xrange $xmin] $y0 \ - [lh_chart::xmap $ml_d $pw_d $xmin $xrange $xmax] $y0 \ - -fill $fg - } - } - - # Plot frame: 3D raised look. Only TOP and LEFT have a black outline - # (the lit edges); BOTTOM and RIGHT are left without an outer black - # line. Inside, top+left have a darker shadow line and bottom+right - # a lighter highlight, giving the panel-edge relief BLT used. - set xR [expr {$ml+$pw}] - set yB [expr {$mt+$ph}] - $c create line $ml $mt $xR $mt -fill black - $c create line $ml $mt $ml $yB -fill black - $c create line [expr {$ml+1}] [expr {$mt+1}] [expr {$xR-1}] [expr {$mt+1}] \ - -fill gray45 - $c create line [expr {$ml+1}] [expr {$mt+1}] [expr {$ml+1}] [expr {$yB-1}] \ - -fill gray45 - $c create line [expr {$ml+1}] [expr {$yB-1}] [expr {$xR-1}] [expr {$yB-1}] \ - -fill white - $c create line [expr {$xR-1}] [expr {$mt+1}] [expr {$xR-1}] [expr {$yB-1}] \ - -fill white - - # Axis line: separate black line OUTSIDE the plot border, with a - # small gap between them. Spans only the data-inset range so its - # endpoints sit right at the topmost and bottommost ticks (BLT - # behavior — the axis "ends with the last tick"). - set axis_gap 4 - set tick_long 10 - set tick_short 5 - set axis_x [expr {$ml - $axis_gap}] ;# left axis (Y) - set axis_y [expr {$yB + $axis_gap}] ;# bottom axis (X) - set axis_top $mt_d ;# = $mt + pad - set axis_bottom [expr {$mt_d + $ph_d}] - set axis_left $ml_d ;# = $ml + pad - set axis_right [expr {$ml_d + $pw_d}] - $c create line $axis_x $axis_top $axis_x $axis_bottom -fill black - $c create line $axis_left $axis_y $axis_right $axis_y -fill black - - # Tick marks attach to (touch) the axis line and point OUTWARD - # toward the labels. Major ticks long, minor ticks (Y only) short. - foreach v $y_minor_ticks { - set y [lh_chart::ymap_log $mt_d $ph_d $ymin $ymax $v] - $c create line [expr {$axis_x - $tick_short}] $y $axis_x $y \ - -fill black - } - foreach pair $y_ticks { - lassign $pair v label - if {$state($w,ylogscale)} { - set y [lh_chart::ymap_log $mt_d $ph_d $ymin $ymax $v] - } else { - set y [lh_chart::ymap_lin $mt_d $ph_d $ymin $ymax $v] - } - $c create line [expr {$axis_x - $tick_long}] $y $axis_x $y \ - -fill black - $c create text [expr {$axis_x - $tick_long - 2}] $y \ - -text $label -anchor e -font {Helvetica -10} - } - set xticks $state($w,xticks) - if {[llength $xticks] == 0} { - set xticks [list $xmin [expr {($xmin+$xmax)/2.0}] $xmax] - } - foreach t $xticks { - if {$t < $xmin - 1e-9 || $t > $xmax + 1e-9} continue - set x [lh_chart::xmap $ml_d $pw_d $xmin $xrange $t] - $c create line $x $axis_y $x [expr {$axis_y + $tick_long}] \ - -fill black - $c create text $x [expr {$axis_y + $tick_long + 2}] \ - -text [format %g $t] -anchor n -font {Helvetica -10} - } -} - -proc lh_chart::fmt_num {v} { - # Format a number for axis labels. Switch to sci notation (e.g. - # 2E5, 1.5E6) once we'd otherwise need 5+ digits, so labels stay - # narrow enough to fit in the left margin. - if {$v == 0} { return "0" } - set av [expr {abs($v)}] - if {$av >= 10000 || $av < 0.01} { - set exp [expr {int(floor(log10($av) + 1e-9))}] - set mant [expr {$v / pow(10, $exp)}] - if {abs($mant - round($mant)) < 0.05} { - return [format "%dE%d" [expr {int(round($mant))}] $exp] - } else { - return [format "%.1fE%d" $mant $exp] - } - } - if {$v == int($v)} { return [format %.0f $v] } - return [format %g $v] -} - -proc lh_chart::xmap {ml pw xmin xrange v} { - return [expr {$ml + ($v - $xmin) / $xrange * $pw}] -} -proc lh_chart::ymap_lin {mt ph ymin ymax v} { - set r [expr {$ymax - $ymin}] - if {$r == 0} { set r 1 } - return [expr {$mt + $ph - ($v - $ymin) / double($r) * $ph}] -} -proc lh_chart::ymap_log {mt ph ymin ymax v} { - if {$v < $ymin} { set v $ymin } - set lmin [expr {log10($ymin)}] - set lmax [expr {log10($ymax)}] - set r [expr {$lmax - $lmin}] - if {$r == 0} { set r 1 } - set lv [expr {log10($v)}] - return [expr {$mt + $ph - ($lv - $lmin) / $r * $ph}] -} +# 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] @@ -1409,30 +921,8 @@ proc usage {} { } ;# usage #------------------------------------------------------------------ -# Window capture without BLT. Strategy: -# 1. Tk 8.7+/9: image create photo -format window can grab a window. -# 2. Else: use ImageMagick `import -window ` to a temp PNG. -# Returns a tk photo image; caller is responsible for `image delete`. -proc captureWindow {win} { - update idletasks - set img [image create photo] - if {![catch {$img read $win -format window} err]} { - return $img - } - image delete $img - set wid [winfo id $win] - set tmp /tmp/lh_snap_[pid]_[clock clicks].png - if {[catch {exec import -window $wid $tmp} err]} { - catch {file delete $tmp} - error "screenshot needs ImageMagick (apt install imagemagick): $err" - } - set img [image create photo -file $tmp] - catch {file delete $tmp} - return $img -} ;# captureWindow - proc windowToFile { win } { - if {[catch {set image [captureWindow $win]} msg]} { + if {[catch {set image [lh_chart::capture_window $win]} msg]} { popup $msg return } From a005ea61093d7ca6720baf2d52e08572bc421937 Mon Sep 17 00:00:00 2001 From: Luca Toniolo <10792599+grandixximo@users.noreply.github.com> Date: Sun, 31 May 2026 16:55:09 +0800 Subject: [PATCH 2/3] histobinstream: streaming comp for race-free hal-histogram snapshots histobins transfers one bin per cycle, so its snapshot is smeared across many milliseconds and the statistics can desync from the bins. Add histobinstream, the streaming counterpart modeled on latencybinstream: on the rising edge of the stream pin it pushes the whole histogram (negative tail, bins, positive tail) through a HAL stream and latches the scalar statistics, giving a consistent atomic snapshot. hal-histogram uses it by default and falls back to histobins with --legacy. The bin classification compares invalue against minvalue for the negative tail, because integer truncation of a negative quotient rounds toward zero and would otherwise land such samples in bin 0. It tests the computed bin index against nbins for the positive tail, avoiding the bin[nbins] out-of-bounds write that histobins performs when invalue == maxvalue. --- scripts/hal-histogram | 190 ++++++++++++++----- src/hal/components/histobinstream.comp | 250 +++++++++++++++++++++++++ 2 files changed, 391 insertions(+), 49 deletions(-) create mode 100644 src/hal/components/histobinstream.comp diff --git a/scripts/hal-histogram b/scripts/hal-histogram index 2cfe1a9287f..aecf183c64c 100755 --- a/scripts/hal-histogram +++ b/scripts/hal-histogram @@ -117,8 +117,18 @@ proc set_defaults {} { # 1 mS is minimum interval for after cmd # for 100bins *10mS = 1 sec update interval + # Default comp is histobinstream (atomic snapshot via HAL stream). + # --legacy switches to the original histobins comp, which transfers + # one bin per cycle so the snapshot is smeared across many ms and + # stats can desync from bins. + set ::HH(legacy) 0 + set ::HH(compname) histobinstream + # Streaming uses one shmem key per instance. histobins instances are + # loaded once and shared by every hal-histogram process, so the keys + # must be deterministic (not PID-derived): instance idx uses base+idx. + set ::HH(streamkey,base) 21000 + # housekeeping - set ::HH(compname) histobins set ::HH(instancename,prefix) histo set ::HH(nsamples) 0 set ::HH(info) "" @@ -178,6 +188,9 @@ proc config {} { } --show {set ::HH(opt,show) 1 } --verbose {set ::HH(opt,verbose) 1 } + --legacy {set ::HH(legacy) 1 + set ::HH(compname) histobins + } -* {usage "Unknown args:$::argv"} default { if {[llength $::argv] > 1} { usage "Too many pins were specified: <$::argv>" @@ -401,6 +414,10 @@ proc finish {} { after cancel [after info] progress $::HH(title)\n progress "Fini" + if {[info exists ::HH(stream,h)]} { + catch {hal_stream detach $::HH(stream,h)} + unset ::HH(stream,h) + } catch { hal delf $::HH(instance) $::HH(threadname) hal unlinkp $::HH(inputpinname) @@ -520,7 +537,17 @@ proc setup_hal {} { set names "$names,$::HH(instancename,prefix)-$i" } set names [string trimleft $names ,] - hal loadrt $::HH(compname) names=$names + if {$::HH(legacy)} { + hal loadrt $::HH(compname) names=$names + } else { + # One deterministic shmem key per instance so any hal-histogram + # process can attach to the instance it claims. + set keys "" + for {set i 0} {$i < $::HH(max_histos)} {incr i} { + lappend keys [expr {$::HH(streamkey,base) + $i}] + } + hal loadrt $::HH(compname) names=$names keys=[join $keys ,] + } set idx 0 ;# first one used } else { set ::HH(instance) \ @@ -579,6 +606,20 @@ proc setup_hal {} { exit 1 } set ::HH(info) "Pin: $::HH(pinname) Sig: $::HH(signame) ($::HH(instance))" + + if {!$::HH(legacy)} { + # Attach the Tcl hal_stream binding to this instance's FIFO. The + # handle stays open for the session and is detached in finish. + set ::HH(streamkey) [expr {$::HH(streamkey,base) + $idx}] + if {[catch {set h [hal_stream attach $::HH(streamkey) u]} err]} { + popup "hal_stream attach failed for $::HH(instance): $err" + exit 1 + } + set ::HH(stream,h) $h + # An instance may be reused after a prior process exited; drop any + # stale records so the first real snapshot reads in phase. + catch {hal_stream drain $h} + } } ;# setup_hal proc start_collection {} { @@ -646,85 +687,135 @@ proc xaxis {} { } ;# xaxis proc update_chart {} { - set w $::HH(widget) + if {$::HH(legacy)} { + set data [acquire_bins_legacy] + } else { + set data [acquire_bins_stream] + if {$data eq ""} return ;# timeout / out-of-sync: skip this cycle + } + render_chart {*}$data +} ;# update_chart + +proc acquire_bins_legacy {} { + # Per-bin polling against the histobins comp. Has a known RT/non-RT + # race: bins are read one cycle at a time so the snapshot is smeared + # and stats can desync from bins. Sets ::HH(pextra)/::HH(nextra) from + # pins; returns [list pxd pyd]. set dly $::HH(dly,ms) - set pmore 0 ;# not currently used - set nmore 0 ;# not currently used + set pxd {}; set pyd {} for {set bin 0} {$bin < $::HH(nbins)} {incr bin} { hal setp $::HH(instance).index $bin set ct 0 while 1 { after $dly set chk [hal getp $::HH(instance).check] - if {$bin == $chk} { - break - } else { - # retry (probably only needed for (irrelevant) non-realtime threads) - incr ct - set retry_ct 100 - if {$ct > $retry_ct} { - parrah ::HH - puts "$::HH(prog):update_chart: retry exceeded $retry_ct" - puts [hal show funct $::HH(instancename)] - puts "EXITHERE" - finish - } - incr ::HH(reread,ct) - if {$ct > 1} { - incr dly - incr ::HH(bump,ct) - } + if {$bin == $chk} break + # retry (probably only needed for (irrelevant) non-realtime threads) + incr ct + set retry_ct 100 + if {$ct > $retry_ct} { + puts "$::HH(prog):update_chart: retry exceeded $retry_ct" + puts [hal show funct $::HH(instancename)] + finish + } + incr ::HH(reread,ct) + if {$ct > 1} { + incr dly + incr ::HH(bump,ct) } } set pbin [hal getp $::HH(instance).binvalue] # 1.1 value makes single unit nbins show as pips when using log y scale: if {$pbin == 1} {set pbin 1.1} - - lappend pxd [expr $::HH(minvalue) +(0.5 + $bin) * $::HH(binsize)] + lappend pxd [expr {$::HH(minvalue) + (0.5 + $bin) * $::HH(binsize)}] lappend pyd $pbin - } ;# for bin - + } set ::HH(pextra) [hal getp $::HH(instance).pextra] set ::HH(nextra) [hal getp $::HH(instance).nextra] + return [list $pxd $pyd] +} ;# acquire_bins_legacy + +proc acquire_bins_stream {} { + # Atomic snapshot via the histobinstream FIFO. Rising edge on `stream` + # makes RT push nbins+2 records (ntail, bins, ptail). Wait for FIFO + # depth, drain via the Tcl hal_stream binding, lower the trigger. Sets + # ::HH(pextra)/::HH(nextra) from the stream; returns [list pxd pyd], or + # "" if the snapshot could not be read cleanly. + set N $::HH(nbins) + set need [expr {$N + 2}] + set h $::HH(stream,h) + hal setp $::HH(instance).stream 1 + # Wait until exactly `need` records are queued. 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 $::HH(instance).stream 0 + if {[hal getp $::HH(instance).stream-error]} { + puts "$::HH(prog): stream-error set (FIFO too small for $need records)" + } else { + puts "$::HH(prog): stream timeout (depth [hal_stream depth $h] < $need)" + } + return "" + } + } + set vals [hal_stream drain $h] + hal setp $::HH(instance).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 "$::HH(prog): stream out-of-sync ([llength $vals]/$need, leftover=$leftover)" + return "" + } + # Stream order: ntail, bin[0..N-1], ptail + set ::HH(nextra) [lindex $vals 0] + set ::HH(pextra) [lindex $vals end] + set pxd {}; set pyd {} + for {set bin 0} {$bin < $N} {incr bin} { + set v [lindex $vals [expr {$bin + 1}]] + if {$v == 1} {set v 1.1} + lappend pxd [expr {$::HH(minvalue) + (0.5 + $bin) * $::HH(binsize)}] + lappend pyd $v + } + return [list $pxd $pyd] +} ;# acquire_bins_stream + +proc render_chart {pxd pyd} { + set w $::HH(widget) + set pmore 0 ;# not currently used + set nmore 0 ;# not currently used set ::HH(input_min) [format %.3g [hal getp $::HH(instance).input-min]] set ::HH(input_max) [format %.3g [hal getp $::HH(instance).input-max]] - - set nsamples [format %u [hal getp $::HH(instance).nsamples]] - set ::HH(nsamples) $nsamples - - set mean [hal getp $::HH(instance).mean] + set ::HH(nsamples) [format %u [hal getp $::HH(instance).nsamples]] set variance [hal getp $::HH(instance).variance] - set sdev [expr sqrt($variance)] set mean [hal getp $::HH(instance).mean] -# puts [format "m=%10.3f %8.3f s=%8.3f %d" \ -# $mean $variance $sdev $nsamples] - set ::HH(sdev) [format %.3g $sdev] + set ::HH(sdev) [format %.3g [expr {sqrt(abs($variance))}]] set ::HH(mean) [format %.3g $mean] - set ::HH(p,more) [expr $pmore + $::HH(pextra)] - set ::HH(n,more) [expr $nmore + $::HH(nextra)] + set ::HH(p,more) [expr {$pmore + $::HH(pextra)}] + set ::HH(n,more) [expr {$nmore + $::HH(nextra)}] if {$::HH(p,more) == 1} {set ::HH(p,more) 1.1} ;# show as pip if {$::HH(n,more) == 1} {set ::HH(n,more) 1.1} ;# show as pip - set pcolor $::HH(color) set pmaxcolor white if {$::HH(pextra) > 0} { - set pcolor red - set pmaxcolor $pcolor - $::HH(widget,posbins) conf -fg $pcolor + set pmaxcolor red + $::HH(widget,posbins) conf -fg red } elseif {$::HH(p,more) > 0} { $::HH(widget,posbins) conf -fg $::HH(color) } else { $::HH(widget,posbins) conf -fg black } - set ncolor $::HH(color) set nmaxcolor white if {$::HH(nextra) > 0} { - set ncolor blue - set nmaxcolor $ncolor - $::HH(widget,negbins) conf -fg $ncolor + set nmaxcolor blue + $::HH(widget,negbins) conf -fg blue } elseif {$::HH(n,more) > 0} { $::HH(widget,negbins) conf -fg $::HH(color) } else { @@ -739,13 +830,13 @@ proc update_chart {} { set ::HH(n,more) [format %.0f $::HH(n,more)] ;# clear pip $w element configure pmindata \ - -xdata [expr -0.5*$::HH(binsize) + $::HH(minvalue)] \ + -xdata [expr {-0.5*$::HH(binsize) + $::HH(minvalue)}] \ -ydata $nyd_max_pos \ -stipple nbmap \ -fg $::HH(color) -bg $nmaxcolor $w element configure pdata -xdata $pxd -ydata $pyd $w element configure pmaxdata \ - -xdata [expr +0.5*$::HH(binsize) + $::HH(maxvalue)]\ + -xdata [expr {+0.5*$::HH(binsize) + $::HH(maxvalue)}] \ -ydata $pyd_max_pos \ -stipple pbmap \ -fg $::HH(color) -bg $pmaxcolor @@ -753,7 +844,7 @@ proc update_chart {} { # a y axis configure is needed, updates may fail without it $::HH(widget) axis configure y -logscale $::HH(y,logscale) update -} ;# update_chart +} ;# render_chart proc is_int {v} { set v [format %.30g $v] ;# first: expand if v is in exponential format @@ -839,6 +930,7 @@ proc usage { {errtxt ""} } { puts " --text note (text display, default: \"$::HH(note,txt)\" )" puts " --show (show count of undisplayed nbins, default off)" puts " --verbose (progress and debug, default off)" + puts " --legacy (use original histobins comp; has RT/non-RT data race)" puts "" puts "Notes:" diff --git a/src/hal/components/histobinstream.comp b/src/hal/components/histobinstream.comp new file mode 100644 index 00000000000..8c53beb9102 --- /dev/null +++ b/src/hal/components/histobinstream.comp @@ -0,0 +1,250 @@ +component histobinstream +"""histogram bins utility for scripts/hal-histogram"""; +description """ +Calculates a histogram of an input pin's value. The histogram data is sent +in a HAL stream for maximum transfer speed and streaming prevents any RT to +non-RT data race condition. This is the streaming counterpart to the +*histobins* component, which transfers one bin per cycle and therefore +smears its snapshot across many cycles. + +Read the *availablebins* pin for the number of bins available. Set the +*minvalue*, *binsize* and *nbins* pins and ensure *nbins* ≤ *availablebins*. + +For *nbins* = N, the bins are numbered 0 ... N-1. The value range covered is +[*minvalue* ... *minvalue* + N * *binsize*). Any input below *minvalue* is +counted in the negative overflow (*ntail*); any input at or above the upper +edge is counted in the positive overflow (*ptail*). + +The input used is selected based on pintype: +[options="header",cols="^1,1"] +|=== +^h|pintype +^h|inputpin + +|0|input +|1|input-s32 +|2|input-u32 +|3|input-bit +|=== + +Stream format and how to obtain the histogram data: + +* Set the *stream* pin to high. +* Read the fifo data when it becomes available. The data streamed has the + following sequence: +** 'ntail bin[0] ... bin[N-1] ptail' +** This gives 'nbins + 2' values streamed (all unsigned counts). +* Read the statistics pins (*input-min*, *input-max*, *mean*, *variance*, + *nsamples*) that reflect the values at the time when *stream* was asserted. +* Set the *stream* pin to low. + +The reset pin may be used to restart. Note that the reset pin is set to high +at startup. You must set it to low before data collection begins. + +The *method* input pin selects an alternate variance calculation (0: Welford +incremental, 1: sum / sum-of-squares). + +Maintainers note: hardcoded for MAXBINNUMBER==200 +"""; + +pin in u32 pintype "Select the input pin (0:input 1:input-s32 2:input-u32 3:input-bit)."; +pin in float input "Floating point input value (pintype 0)."; +pin in s32 input_s32 "Signed input value (pintype 1)."; +pin in u32 input_u32 "Unsigned input value (pintype 2)."; +pin in bit input_bit "Bit input value (pintype 3)."; + +pin in u32 nbins = 20 "Number of active bins N (0 ... N-1)."; +pin in float binsize = 1 "Width of one bin in input units."; +pin in float minvalue = 0 "Lower edge of bin 0."; + +pin in bit reset = 1 "Reset state and bins."; +pin in bit stream = 0 "Set to high to stream all bins and tails on rising edge."; +pin in bit method = 0 "Variance method (0:Welford incremental, 1:sum of squares)."; + +pin out bit stream_error "Set if the data stream did not fit and was never sent."; +pin out bit input_error "Set when input rules are violated; updates cease until reset."; + +pin out float input_min "Minimum input value seen (latched on stream rising edge)."; +pin out float input_max "Maximum input value seen (latched on stream rising edge)."; +pin out u32 nsamples "Number of samples accumulated (latched on stream rising edge)."; +pin out float variance "Variance of the input (latched on stream rising edge)."; +pin out float mean "Mean of the input (latched on stream rising edge)."; +pin out s64 stream_time "The time it took for the stream data to be pushed out in nanoseconds (ns)."; + +// user may interrogate availablebins to determine this compiled-in limit +pin out s32 availablebins = 200; //MAXBINNUMBER + +option period no; +function _ fp; +option extra_setup; +modparam dummy keys "Stream shmem unique key for each instance"; + +include ; +include ; + +variable int first = 1; +variable unsigned last_nbins = 0; +variable hal_float_t last_binsize = 0; +variable hal_float_t last_minvalue = 0; +variable hal_float_t maxvalue = 0; + +variable hal_stream_data_u bins[200]; // MAXBINNUMBER +variable hal_stream_data_u ptail; // count of inputs >= upper edge +variable hal_stream_data_u ntail; // count of inputs < minvalue + +variable rtapi_u64 run_nsamples = 0; +variable hal_float_t run_min = 1e99; +variable hal_float_t run_max = -1e99; +variable hal_float_t run_mean = 0; +variable hal_float_t run_variance = 0; +variable hal_float_t sum = 0; +variable hal_float_t sq_sum = 0; +variable hal_float_t m2 = 0; + +variable bool last_stream = 0; +variable hal_stream_t fifo; + +license "GPL"; +author "Dewey Garrett, B.Stultiens, LinuxCNC contributors"; +;; + +#define MAXBINNUMBER 200 + +#define MAX_INST 8 +static int keys[MAX_INST] = {}; +RTAPI_MP_ARRAY_INT(keys, MAX_INST, "Stream shmem keys"); + +// Note: the extra setup is run _before_ the pins are created +EXTRA_SETUP() { + (void)prefix; + + if (extra_arg < 0 || extra_arg >= MAX_INST || !keys[extra_arg]) + return -EINVAL; + int err; + // The stream buffer should be able to contain one complete set of data: + // the negative tail, every bin and the positive tail. + if (0 != (err = hal_stream_create(&fifo, comp_id, keys[extra_arg], MAXBINNUMBER + 2, "u"))) + return err; + // The other side should run hal_stream_attach(&fifo, comp_id, key, "u") + return 0; +} + +FUNCTION(_) { + rtapi_s64 now = rtapi_get_time(); + + // Select the input according to pintype. + hal_float_t invalue; + switch (pintype) { + case 0: invalue = input; break; + case 1: invalue = input_s32; break; + case 2: invalue = input_u32; break; + case 3: invalue = input_bit; break; + default: invalue = input; break; + } + + // Validate the requested bin geometry. binsize must be > 0 to avoid a + // divide by zero and to keep the bin index monotonic. + if (nbins < 1 || nbins > (unsigned)availablebins || binsize <= 0) { + input_error = 1; + last_stream = stream; // do not act on a stream edge while in error + return; + } + input_error = 0; + + if (reset) { + first = 1; + } + + if ( first + || nbins != last_nbins + || binsize != last_binsize + || minvalue != last_minvalue) { + first = 0; + maxvalue = minvalue + (hal_float_t)nbins * binsize; + for (unsigned i = 0; i < nbins; i++) + bins[i].u = 0; + ptail.u = 0; + ntail.u = 0; + run_nsamples = 0; + run_min = 1e99; + run_max = -1e99; + run_mean = 0; + run_variance = 0; + sum = 0; + sq_sum = 0; + m2 = 0; + } else { + // Compare against minvalue for the low tail: a negative quotient + // truncates toward zero and would misfile such samples in bin 0. + // Index-test the high tail to avoid the bin[nbins] overflow that + // histobins writes at invalue == maxvalue. + if (invalue < minvalue) { + ntail.u++; + } else { + int idx = (int)((invalue - minvalue) / binsize); + if (idx >= (int)nbins) { + ptail.u++; + } else { + bins[idx].u++; + } + } + + if (invalue < run_min) run_min = invalue; + if (invalue > run_max) run_max = invalue; + + ++run_nsamples; + if (run_nsamples >= 2) { + if (method == 0) { + hal_float_t delta = invalue - run_mean; + run_mean += delta / run_nsamples; + m2 += delta * (invalue - run_mean); + run_variance = m2 / (run_nsamples - 1); + } else { + sum += invalue; + sq_sum += invalue * invalue; + run_mean = sum / run_nsamples; + run_variance = (sq_sum - (sum * sum) / run_nsamples) / (run_nsamples - 1); + } + } else { + // First sample: Welford needs the mean seeded; the sum method + // needs its accumulators primed so a later switch stays correct. + run_mean = invalue; + sum = invalue; + sq_sum = invalue * invalue; + } + } + + bool b = stream; + // On the low-to-high transition latch the statistics and push the bins. + if (b && !last_stream) { + nsamples = (hal_u32_t)run_nsamples; + mean = run_mean; + variance = run_variance; + input_min = run_nsamples ? run_min : 0; + input_max = run_nsamples ? run_max : 0; + + unsigned need = nbins + 2; + int avail = hal_stream_maxdepth(&fifo) - hal_stream_depth(&fifo); + if (avail >= (int)need) { + // Negative overflow + hal_stream_write(&fifo, &ntail); + // All bins, in ascending order + for (unsigned i = 0; i < nbins; i++) + hal_stream_write(&fifo, &bins[i]); + // Positive overflow + hal_stream_write(&fifo, &ptail); + stream_error = 0; + stream_time = rtapi_get_time() - now; + } else { + // Not enough room to stream an entire set; never stream an + // incomplete data set. + stream_error = 1; + } + } + last_stream = b; + + last_nbins = nbins; + last_binsize = binsize; + last_minvalue = minvalue; +} +// vim: ts=4 sw=4 syn=c From 6880aacb89e0d036bc3cf0be1c3d3af22ba1d4e1 Mon Sep 17 00:00:00 2001 From: Luca Toniolo <10792599+grandixximo@users.noreply.github.com> Date: Sun, 31 May 2026 20:16:24 +0800 Subject: [PATCH 3/3] histobinstream: adopt review rework from B. Stultiens Replace the comp implementation with the version Bertho Stultiens posted in review of PR #4090: cache the volatile input pins once per cycle, use real_t, keep input_error sticky until reset, and update the last_* trackers right after the accumulate block. The bin classification and first-sample seeding are unchanged. Also fixes his "som" -> "some" comment typo. --- src/hal/components/histobinstream.comp | 113 +++++++++++++------------ 1 file changed, 59 insertions(+), 54 deletions(-) diff --git a/src/hal/components/histobinstream.comp b/src/hal/components/histobinstream.comp index 8c53beb9102..cf536c02426 100644 --- a/src/hal/components/histobinstream.comp +++ b/src/hal/components/histobinstream.comp @@ -1,19 +1,16 @@ -component histobinstream -"""histogram bins utility for scripts/hal-histogram"""; +component histobinstream "histogram bins utility for scripts/hal-histogram"; description """ -Calculates a histogram of an input pin's value. The histogram data is sent -in a HAL stream for maximum transfer speed and streaming prevents any RT to -non-RT data race condition. This is the streaming counterpart to the -*histobins* component, which transfers one bin per cycle and therefore -smears its snapshot across many cycles. +Calculates a histogram of an input pin's value. +The histogram data is sent in a HAL stream for maximum transfer speed and to prevent any RT to non-RT data race conditions. +This is the streaming counterpart to the *histobins* component. -Read the *availablebins* pin for the number of bins available. Set the -*minvalue*, *binsize* and *nbins* pins and ensure *nbins* ≤ *availablebins*. +Read the *availablebins* pin for the number of bins available. +Set the *minvalue*, *binsize* and *nbins* pins and ensure *nbins* ≤ *availablebins*. -For *nbins* = N, the bins are numbered 0 ... N-1. The value range covered is -[*minvalue* ... *minvalue* + N * *binsize*). Any input below *minvalue* is -counted in the negative overflow (*ntail*); any input at or above the upper -edge is counted in the positive overflow (*ptail*). +For *nbins* = N, the bins are numbered 0 ... N-1. +The value range covered is [*minvalue* ... *minvalue* + N * *binsize*). +Any input below *minvalue* is counted in the negative overflow (*ntail*). +Any input at or above the upper edge is counted in the positive overflow (*ptail*). The input used is selected based on pintype: [options="header",cols="^1,1"] @@ -38,31 +35,33 @@ Stream format and how to obtain the histogram data: *nsamples*) that reflect the values at the time when *stream* was asserted. * Set the *stream* pin to low. -The reset pin may be used to restart. Note that the reset pin is set to high -at startup. You must set it to low before data collection begins. +The reset pin may be used to restart. +Note that the reset pin is set to high at startup. +You must set it to low before data collection begins. The *method* input pin selects an alternate variance calculation (0: Welford incremental, 1: sum / sum-of-squares). Maintainers note: hardcoded for MAXBINNUMBER==200 """; +// "} make vim syntax highligting happy -pin in u32 pintype "Select the input pin (0:input 1:input-s32 2:input-u32 3:input-bit)."; -pin in float input "Floating point input value (pintype 0)."; -pin in s32 input_s32 "Signed input value (pintype 1)."; -pin in u32 input_u32 "Unsigned input value (pintype 2)."; -pin in bit input_bit "Bit input value (pintype 3)."; +pin in u32 pintype "Select the input pin (0:input 1:input-s32 2:input-u32 3:input-bit)."; +pin in float input "Floating point input value (pintype 0)."; +pin in s32 input_s32 "Signed input value (pintype 1)."; +pin in u32 input_u32 "Unsigned input value (pintype 2)."; +pin in bit input_bit "Bit input value (pintype 3)."; pin in u32 nbins = 20 "Number of active bins N (0 ... N-1)."; pin in float binsize = 1 "Width of one bin in input units."; pin in float minvalue = 0 "Lower edge of bin 0."; -pin in bit reset = 1 "Reset state and bins."; -pin in bit stream = 0 "Set to high to stream all bins and tails on rising edge."; -pin in bit method = 0 "Variance method (0:Welford incremental, 1:sum of squares)."; +pin in bit reset = 1 "Reset state and bins."; +pin in bit stream = 0 "Set to high to stream all bins and tails on rising edge."; +pin in bit method = 0 "Variance method (0:Welford incremental, 1:sum of squares)."; pin out bit stream_error "Set if the data stream did not fit and was never sent."; -pin out bit input_error "Set when input rules are violated; updates cease until reset."; +pin out bit input_error "Set when input rules are violated; updates are invalid until fixed and a reset."; pin out float input_min "Minimum input value seen (latched on stream rising edge)."; pin out float input_max "Maximum input value seen (latched on stream rising edge)."; @@ -75,7 +74,7 @@ pin out s64 stream_time "The time it took for the stream data to be pushed ou pin out s32 availablebins = 200; //MAXBINNUMBER option period no; -function _ fp; +function _; option extra_setup; modparam dummy keys "Stream shmem unique key for each instance"; @@ -84,22 +83,22 @@ include ; variable int first = 1; variable unsigned last_nbins = 0; -variable hal_float_t last_binsize = 0; -variable hal_float_t last_minvalue = 0; -variable hal_float_t maxvalue = 0; +variable real_t last_binsize = 0; +variable real_t last_minvalue = 0; +variable real_t maxvalue = 0; variable hal_stream_data_u bins[200]; // MAXBINNUMBER variable hal_stream_data_u ptail; // count of inputs >= upper edge variable hal_stream_data_u ntail; // count of inputs < minvalue variable rtapi_u64 run_nsamples = 0; -variable hal_float_t run_min = 1e99; -variable hal_float_t run_max = -1e99; -variable hal_float_t run_mean = 0; -variable hal_float_t run_variance = 0; -variable hal_float_t sum = 0; -variable hal_float_t sq_sum = 0; -variable hal_float_t m2 = 0; +variable real_t run_min = 1e99; +variable real_t run_max = -1e99; +variable real_t run_mean = 0; +variable real_t run_variance = 0; +variable real_t sum = 0; +variable real_t sq_sum = 0; +variable real_t m2 = 0; variable bool last_stream = 0; variable hal_stream_t fifo; @@ -120,6 +119,7 @@ EXTRA_SETUP() { if (extra_arg < 0 || extra_arg >= MAX_INST || !keys[extra_arg]) return -EINVAL; + int err; // The stream buffer should be able to contain one complete set of data: // the negative tail, every bin and the positive tail. @@ -132,8 +132,13 @@ EXTRA_SETUP() { FUNCTION(_) { rtapi_s64 now = rtapi_get_time(); + // Cache some pins + rtapi_u32 c_nbins= nbins; + real_t c_binsize = binsize; + real_t c_minvalue = minvalue; + // Select the input according to pintype. - hal_float_t invalue; + real_t invalue; switch (pintype) { case 0: invalue = input; break; case 1: invalue = input_s32; break; @@ -144,24 +149,24 @@ FUNCTION(_) { // Validate the requested bin geometry. binsize must be > 0 to avoid a // divide by zero and to keep the bin index monotonic. - if (nbins < 1 || nbins > (unsigned)availablebins || binsize <= 0) { + if (c_nbins < 1 || c_nbins > (unsigned)availablebins || c_binsize <= 0.0) { input_error = 1; last_stream = stream; // do not act on a stream edge while in error return; } - input_error = 0; if (reset) { first = 1; + input_error = 0; } if ( first - || nbins != last_nbins - || binsize != last_binsize - || minvalue != last_minvalue) { + || c_nbins != last_nbins + || c_binsize != last_binsize + || c_minvalue != last_minvalue) { first = 0; - maxvalue = minvalue + (hal_float_t)nbins * binsize; - for (unsigned i = 0; i < nbins; i++) + maxvalue = c_minvalue + (real_t)c_nbins * c_binsize; + for (unsigned i = 0; i < c_nbins; i++) bins[i].u = 0; ptail.u = 0; ntail.u = 0; @@ -178,11 +183,11 @@ FUNCTION(_) { // truncates toward zero and would misfile such samples in bin 0. // Index-test the high tail to avoid the bin[nbins] overflow that // histobins writes at invalue == maxvalue. - if (invalue < minvalue) { + if (invalue < c_minvalue) { ntail.u++; } else { - int idx = (int)((invalue - minvalue) / binsize); - if (idx >= (int)nbins) { + int idx = (int)((invalue - c_minvalue) / c_binsize); + if (idx >= (int)c_nbins) { ptail.u++; } else { bins[idx].u++; @@ -195,7 +200,7 @@ FUNCTION(_) { ++run_nsamples; if (run_nsamples >= 2) { if (method == 0) { - hal_float_t delta = invalue - run_mean; + real_t delta = invalue - run_mean; run_mean += delta / run_nsamples; m2 += delta * (invalue - run_mean); run_variance = m2 / (run_nsamples - 1); @@ -214,6 +219,10 @@ FUNCTION(_) { } } + last_nbins = c_nbins; + last_binsize = c_binsize; + last_minvalue = c_minvalue; + bool b = stream; // On the low-to-high transition latch the statistics and push the bins. if (b && !last_stream) { @@ -223,13 +232,13 @@ FUNCTION(_) { input_min = run_nsamples ? run_min : 0; input_max = run_nsamples ? run_max : 0; - unsigned need = nbins + 2; + unsigned need = c_nbins + 2; int avail = hal_stream_maxdepth(&fifo) - hal_stream_depth(&fifo); if (avail >= (int)need) { // Negative overflow hal_stream_write(&fifo, &ntail); // All bins, in ascending order - for (unsigned i = 0; i < nbins; i++) + for (unsigned i = 0; i < c_nbins; i++) hal_stream_write(&fifo, &bins[i]); // Positive overflow hal_stream_write(&fifo, &ptail); @@ -242,9 +251,5 @@ FUNCTION(_) { } } last_stream = b; - - last_nbins = nbins; - last_binsize = binsize; - last_minvalue = minvalue; } -// vim: ts=4 sw=4 syn=c +// vim: ts=4 sw=4 et