The benchmarks provided by the tclbench package are very interesting and useful, but sometimes hard to read. For examples, see Tcl Benchmarks and Tcl Normalized Benchmarks. What we really need is a good way to plot relative benchmark performance, so that you can easily see how different versions of Tcl differ from each other.
I wrote this little script, using BLT for graphing, and a little bit of GUI cruft around a simple parser for the Tcl Benchmarks output. Apologies for the obvious use of Tcl/Tk Template Applications, but you're free to improve on this. :-)
#!/bin/sh
# If running in a UNIX shell, restart wish on the next line \
exec wish "$0" ${1+"$@"}
#--------------------------------------------------
#
# plotTclBench.tcl
#
# Plot tclBench comparison in BLT widget
#
#--------------------------------------------------
#--------------------------------------------------
#
# myAppMain
#
# Performs basic initialization of myApp.
#
#--------------------------------------------------
proc myAppMain { argc argv } {
#--------------------------------------------------
# Construct the UI
#--------------------------------------------------
myAppInitGui .
#--------------------------------------------------
# If we have an argument, then open the file
#--------------------------------------------------
if { [llength $argv] > 0 } {
myAppFileOpen [lindex $argv 0]
}
}
#--------------------------------------------------
#
# myAppInitGui
#
# Construct and initialize UI
#
#--------------------------------------------------
proc myAppInitGui { root } {
#--------------------------------------------------
# treat root window "." as a special case
#--------------------------------------------------
if {$root == "."} {
set base ""
} else {
set base $root
}
#--------------------------------------------------
# Define the menu bar
#--------------------------------------------------
package require Tk
menu $base.menu
$root config -menu $base.menu
foreach m {File Help} {
# Use [string tolower] to ensure magic menu names are right - DKF
set $m [menu $base.menu.[string tolower $m] -tearoff 0]
$base.menu add cascade -label $m -underline 0 -menu [set $m]
}
$File add command -underline 0 -label "Open..." -command myAppFileOpen
$File add separator
$File add command -underline 1 -label "Exit" -command myAppExit
$Help add command -label About -command myAppHelpAbout
#--------------------------------------------------
# Set window manager properties for myApp
#--------------------------------------------------
wm protocol $root WM_DELETE_WINDOW { myAppExit }
wm title $root "Tcl Bench Comparison"
# Add a BLT Graph widget
package require BLT
blt::graph .g
Blt_ZoomStack .g
bind Graph <Any-Motion> {displayClosest %x %y}
grid .g
grid columnconfigure . 0 -weight 1
grid rowconfigure . 0 -weight 1
# Add some instructions and closes display
grid [label .label -text "Click to zoom. Click B3 to unzoom"] -sticky w
grid [label .nearest -text ""] -sticky w
# Add a normalization selector
grid [frame .f -relief raised]
grid [label .f.label -text "Normalize graph to:"] -sticky w
update
}
proc displayClosest {x y} {
global valArray
global testNames
catch {
.g element closest $x $y valArray
set index $valArray(index)
.nearest configure -text "Test [lindex $testNames $index]"
}
}
#--------------------------------------------------
#
# File Procedures
#
# Note that opening, saving, and closing files
# are all intertwined. This code assumes that
# new/open/close/exit may lose some data.
#
#--------------------------------------------------
set myAppFileName ""
set myAppChangedFlag 0
set myAppFileTypes {
{{All Files} * }
}
proc myAppFileOpen { {filename ""} } {
global myAppFileName
global myAppChangedFlag
global myAppFileTypes
global benchData
global data
global interpNames
global testNames
if {$filename == ""} {
set filename [tk_getOpenFile -filetypes $myAppFileTypes]
}
if {$filename != ""} {
if { [catch {open $filename r} fp] } {
error "Cannot Open File $filename for Reading"
}
#--------------------------------------------------
# insert code for "open" operation
#--------------------------------------------------
# read tclbench data into list of lines
set benchData [split [read $fp [file size $filename]] "\n"]
close $fp
set myAppFileName $filename
set myAppChangedFlag 0
# process header - look for interpreter names (versions)
set interpNames [list]
for {set i 0} {$i < [llength $benchData]} {incr i} {
set line [lindex $benchData $i]
if {[string match "000*" $line] } {
break
}
if {[string match "Benchmark*" $line]} {
scan $line "Benchmark %d:%s " junk shortName
lappend interpNames $shortName
}
}
# now that we've got the "000 VERSIONS" line,
# figure out how wide to make that left side
# label field
set shortName [lindex [lindex $interpNames 0] 0]
set labelEnd [expr {[string first $shortName $line]-4}]
# parse the columns into data lists, starting from
# the right hand side. It is hard to tell how wide
# to make the label field on the left, so we just
# start on the right, and put everything else in
# the X axis values
for {incr i} {$i<[llength $benchData]-2} {incr i} {
set line [lindex $benchData $i]
set line [lindex $benchData $i]
# parse values
set valueList [string range $line $labelEnd end]
for {set j 0} {$j<[llength $interpNames]} {incr j} {
set name [lindex $interpNames end-$j]
set dataItem [lindex $valueList end-$j]
if { ! [string is double $dataItem] } {
set dataItem 1
}
lappend data($name) $dataItem
}
# get label string
set labelString [string range $line 0 $labelEnd]
lappend testNames $labelString
scan $line "%d" testNum
lappend x $testNum
}
# Create a BLT graph data vector for every interpName
set symbols [list circle square diamond plus cross splus scross triangle arrow]
set colors [list black blue red green cyan magenta yellow orange brown]
set i 0
foreach name $interpNames {
catch {rename y_$name ""}
blt::vector create y_$name
y_$name set $data($name)
.g element create $name -xdata $x -ydata y_$name \
-symbol [lindex $symbols $i] -fill [lindex $colors $i]
incr i
}
# Add names to normalization menu
catch {destroy [winfo children .f]}
grid [label .f.label -text "Normalize graph to:"] -row 0
set i 1
foreach name $interpNames {
set bname [string map {. _} $name]
set b [button .f.b_$bname -text $name -command "normalize $name"]
grid $b -row 0 -column $i
incr i
}
}
}
proc normalize {name} {
global interpNames
y_$name dup temp
foreach name $interpNames {
set vec y_$name
$vec expr {$vec / temp}
}
blt::vector destroy temp
}
proc myAppExit { } {
exit
}
#--------------------------------------------------
# Cut/Copy/Paste
#
# These procedures generate events
# for all Tk Widgets in the GUI
#--------------------------------------------------
proc myAppEditCut { } {
event generate [focus] <<Cut>>
}
proc myAppEditCopy { } {
event generate [focus] <<Copy>>
}
proc myAppEditPaste { } {
event generate [focus] <<Paste>>
}
proc myAppSearchBindingsAndEval {event bindtags script} {
foreach tag $bindtags {
foreach sequence [bind $tag] {
if {[string first $event $sequence] == 0} {
return [uplevel $script]
}
}
}
}
proc myAppConfigEditMenu {menu bindtags} {
foreach {event index} {
<<Cut>> 0
<<Copy>> 1
<<Paste>> 2
} {
$menu entryconfigure $index -state disabled
myAppSearchBindingsAndEval $event $bindtags {
$menu entryconfigure $index -state normal
}
}
}
#--------------------------------------------------
# Help Operations
#--------------------------------------------------
proc myAppHelpAbout { } {
tk_messageBox -message "tclbench data plotter"
}
#--------------------------------------------------
# Execute the main procedure
#--------------------------------------------------
myAppMain $argc $argv