Performance test scripts for list commands

2 files changed, 1596 insertions, 0 deletions

diff --git a/tests-perf/comparePerf.tcl b/tests-perf/comparePerf.tcl
new file mode 100644
index 0000000..f35da21
--- /dev/null
+++ b/tests-perf/comparePerf.tcl
@@ -0,0 +1,371 @@
+#!/usr/bin/tclsh
+# ------------------------------------------------------------------------
+#
+# comparePerf.tcl --
+#
+#  Script to compare performance data from multiple runs.
+#
+# ------------------------------------------------------------------------
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file.
+#
+# Usage:
+#   tclsh comparePerf.tcl [--regexp RE] [--ratio time|rate] [--combine] [--base BASELABEL] PERFFILE ...
+#
+# The test data from each input file is tabulated so as to compare the results
+# of test runs. If a PERFFILE does not exist, it is retried by adding the
+# .perf extension. If the --regexp is specified, only test results whose
+# id matches RE are examined.
+#
+# If the --combine option is specified, results of test sets with the same
+# label are combined and averaged in the output.
+#
+# If the --base option is specified, the BASELABEL is used as the label to use
+# the base timing. Otherwise, the label of the first data file is used.
+#
+# If --ratio option is "time" the ratio of test timing vs base test timing
+# is shown. If "rate" (default) the inverse is shown.
+#
+# If --no-header is specified, the header describing test configuration is
+# not output.
+#
+# The format of input files is as follows:
+#
+# Each line must begin with one of the characters below followed by a space
+# followed by a string whose semantics depend on the initial character.
+# E - Full path to the Tcl executable that was used to generate the file
+# V - The Tcl patchlevel of the implementation
+# D - A description for the test run for human consumption
+# L - A label used to identify run environment. The --combine option will
+#     average all measuremets that have the same label. An input file without
+#     a label is treated as having a unique label and not combined with any other.
+# P - A test measurement (see below)
+# R - The number of runs made for the each test
+# # - A comment, may be an arbitrary string. Usually included in performance
+#     data to describe the test. This is silently ignored
+#
+# Any lines not matching one of the above are ignored with a warning to stderr.
+#
+# A line beginning with the "P" marker is a test measurement. The first word
+# following is a floating point number representing the test runtime.
+# The remaining line (after trimming of whitespace) is the id of the test.
+# Test generators are encouraged to make the id a well-defined machine-parseable
+# as well human readable description of the test. The id must not appear more
+# than once. An example test measurement line:
+# P    2.32280 linsert in unshared L[10000] 1 elems 10000 times at 0 (var)
+# Note here the iteration count is not present.
+#
+
+namespace eval perf::compare {
+    # List of dictionaries, one per input file
+    variable PerfData
+}
+
+proc perf::compare::warn {message} {
+    puts stderr "Warning: $message"
+}
+proc perf::compare::print {text} {
+    puts stdout $text
+}
+proc perf::compare::slurp {testrun_path} {
+    variable PerfData
+
+    set runtimes [dict create]
+
+    set path [file normalize $testrun_path]
+    set fd [open $path]
+    array set header {}
+    while {[gets $fd line] >= 0} {
+        set line [regsub -all {\s+} [string trim $line] " "]
+        switch -glob -- $line {
+            "#*" {
+                # Skip comments
+            }
+            "R *" -
+            "L *" -
+            "D *" -
+            "V *" -
+            "T *" -
+            "E *" {
+                set marker [lindex $line 0]
+                if {[info exists header($marker)]} {
+                    warn "Ignoring $marker record (duplicate): \"$line\""
+                }
+                set header($marker) [string range $line 2 end]
+            }
+            "P *" {
+                if {[scan $line "P %f %n" runtime id_start] == 2} {
+                    set id [string range $line $id_start end]
+                    if {[dict exists $runtimes $id]} {
+                        warn "Ignoring duplicate test id \"$id\""
+                    } else {
+                        dict set runtimes $id $runtime
+                    }
+                } else {
+                    warn "Invalid test result line format: \"$line\""
+                }
+            }
+            default {
+                puts stderr "Warning: ignoring unrecognized line \"$line\""
+            }
+        }
+    }
+    close $fd
+
+    set result [dict create Input $path Runtimes $runtimes]
+    foreach {c k} {
+        L Label
+        V Version
+        E Executable
+        D Description
+    } {
+        if {[info exists header($c)]} {
+            dict set result $k $header($c)
+        }
+    }
+
+    return $result
+}
+
+proc perf::compare::burp {test_sets} {
+    variable Options
+
+    # Print the key for each test run
+    set header "           "
+    set separator "           "
+    foreach test_set $test_sets {
+        set test_set_key "\[[incr test_set_num]\]"
+        if {! $Options(--no-header)} {
+            print "$test_set_key"
+            foreach k {Label Executable Version Input Description} {
+                if {[dict exists $test_set $k]} {
+                    print "$k: [dict get $test_set $k]"
+                }
+            }
+        }
+        append header $test_set_key $separator
+        set separator "                 "; # Expand because later columns have ratio
+    }
+    set header [string trimright $header]
+
+    if {! $Options(--no-header)} {
+        print ""
+        if {$Options(--ratio) eq "rate"} {
+            set ratio_description "ratio of baseline to the measurement (higher is faster)."
+        } else {
+            set ratio_description "ratio of measurement to the baseline (lower is faster)."
+        }
+        print "The first column \[1\] is the baseline measurement."
+        print "Subsequent columns are pairs of the additional measurement and "
+        print $ratio_description
+        print ""
+    }
+
+    # Print the actual test run data
+
+    print $header
+    set test_sets [lassign $test_sets base_set]
+    set fmt {%#10.5f}
+    set fmt_ratio {%-6.2f}
+    foreach {id base_runtime} [dict get $base_set Runtimes] {
+        if {[info exists Options(--regexp)]} {
+            if {![regexp $Options(--regexp) $id]} {
+                continue
+            }
+        }
+        if {$Options(--print-test-number)} {
+            set line "[format %-4s [incr counter].]"
+        } else {
+            set line ""
+        }
+        append line [format $fmt $base_runtime]
+        foreach test_set $test_sets {
+            if {[dict exists $test_set Runtimes $id]} {
+                set runtime [dict get $test_set Runtimes $id]
+                if {$Options(--ratio) eq "time"} {
+                    if {$base_runtime != 0} {
+                        set ratio [format $fmt_ratio [expr {$runtime/$base_runtime}]]
+                    } else {
+                        if {$runtime == 0} {
+                            set ratio "NaN   "
+                        } else {
+                            set ratio "Inf   "
+                        }
+                    }
+                } else {
+                    if {$runtime != 0} {
+                        set ratio [format $fmt_ratio [expr {$base_runtime/$runtime}]]
+                    } else {
+                        if {$base_runtime == 0} {
+                            set ratio "NaN   "
+                        } else {
+                            set ratio "Inf   "
+                        }
+                    }
+                }
+                append line "|" [format $fmt $runtime] "|" $ratio
+            } else {
+                append line [string repeat { } 11]
+            }
+        }
+        append line "|" $id
+        print $line
+    }
+}
+
+proc perf::compare::chew {test_sets} {
+    variable Options
+
+    # Combine test sets that have the same label, averaging the values
+    set unlabeled_sets {}
+    array set labeled_sets {}
+
+    foreach test_set $test_sets {
+        # If there is no label, treat as independent set
+        if {![dict exists $test_set Label]} {
+            lappend unlabeled_sets $test_set
+        } else {
+            lappend labeled_sets([dict get $test_set Label]) $test_set
+        }
+    }
+
+    foreach label [array names labeled_sets] {
+        set combined_set [lindex $labeled_sets($label) 0]
+        set runtimes [dict get $combined_set Runtimes]
+        foreach test_set [lrange $labeled_sets($label) 1 end] {
+            dict for {id timing} [dict get $test_set Runtimes] {
+                dict lappend runtimes $id $timing
+            }
+        }
+        dict for {id timings} $runtimes {
+            set total [tcl::mathop::+ {*}$timings]
+            dict set runtimes $id [expr {$total/[llength $timings]}]
+        }
+        dict set combined_set Runtimes $runtimes
+        set labeled_sets($label) $combined_set
+    }
+
+    # Choose the "base" test set
+    if {![info exists Options(--base)]} {
+        set first_set [lindex $test_sets 0]
+        if {[dict exists $first_set Label]} {
+            # Use label of first as the base
+            set Options(--base) [dict get $first_set Label]
+        }
+    }
+
+    if {[info exists Options(--base)] && $Options(--base) ne ""} {
+        lappend combined_sets $labeled_sets($Options(--base));# Will error if no such
+        unset labeled_sets($Options(--base))
+    } else {
+        lappend combined_sets [lindex $unlabeled_sets 0]
+        set unlabeled_sets [lrange $unlabeled_sets 1 end]
+    }
+    foreach label [array names labeled_sets] {
+        lappend combined_sets $labeled_sets($label)
+    }
+    lappend combined_sets {*}$unlabeled_sets
+
+    return $combined_sets
+}
+
+proc perf::compare::setup {argv} {
+    variable Options
+
+    array set Options {
+        --ratio rate
+        --combine 0
+        --print-test-number 0
+        --no-header 0
+    }
+    while {[llength $argv]} {
+        set argv [lassign $argv arg]
+        switch -glob -- $arg {
+            -r -
+            --regexp {
+                if {[llength $argv] == 0} {
+                    error "Missing value for option $arg"
+                }
+                set argv [lassign $argv val]
+                set Options(--regexp) $val
+            }
+            --ratio {
+                if {[llength $argv] == 0} {
+                    error "Missing value for option $arg"
+                }
+                set argv [lassign $argv val]
+                if {$val ni {time rate}} {
+                    error "Value for option $arg must be either \"time\" or \"rate\""
+                }
+                set Options(--ratio) $val
+            }
+            --print-test-number -
+            --combine -
+            --no-header {
+                set Options($arg) 1
+            }
+            --base {
+                if {[llength $argv] == 0} {
+                    error "Missing value for option $arg"
+                }
+                set argv [lassign $argv val]
+                set Options($arg) $val
+            }
+            -- {
+                # Remaining will be passed back to the caller
+                break
+            }
+            --* {
+                error "Unknown option $arg"
+            }
+            -* {
+                error "Unknown option -[lindex $arg 0]"
+            }
+            default {
+                # Remaining will be passed back to the caller
+                set argv [linsert $argv 0 $arg]
+                break;
+            }
+        }
+    }
+
+    set paths {}
+    foreach path $argv {
+        set path [file join $path]; # Convert from native else glob fails
+        if {[file isfile $path]} {
+            lappend paths $path
+            continue
+        }
+        if {[file isfile $path.perf]} {
+            lappend paths $path.perf
+            continue
+        }
+        lappend paths {*}[glob -nocomplain $path]
+    }
+    return $paths
+}
+proc perf::compare::main {} {
+    variable Options
+
+    set paths [setup $::argv]
+    if {[llength $paths] == 0} {
+        error "No test data files specified."
+    }
+    set test_data [list ]
+    set seen [dict create]
+    foreach path $paths {
+        if {![dict exists $seen $path]} {
+            lappend test_data [slurp $path]
+            dict set seen $path ""
+        }
+    }
+
+    if {$Options(--combine)} {
+        set test_data [chew $test_data]
+    }
+
+    burp $test_data
+}
+
+perf::compare::main
diff --git a/tests-perf/listPerf.tcl b/tests-perf/listPerf.tcl
new file mode 100644
index 0000000..1252870
--- /dev/null
+++ b/tests-perf/listPerf.tcl
@@ -0,0 +1,1225 @@
+#!/usr/bin/tclsh
+# ------------------------------------------------------------------------
+#
+# listPerf.tcl --
+#
+#  This file provides performance tests for list operations.
+#
+# ------------------------------------------------------------------------
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file.
+#
+# Note: this file does not use the test-performance.tcl framework as we want
+# more direct control over timerate options.
+
+catch {package require twapi}
+
+namespace eval perf::list {
+    variable perfScript [file normalize [info script]]
+
+    # Test for each of these lengths
+    variable Lengths {10 100 1000 10000}
+
+    variable RunTimes
+    set RunTimes(command) 0.0
+    set RunTimes(total) 0.0
+
+    variable Options
+    array set Options {
+        --print-comments   0
+        --print-iterations 0
+    }
+
+    # Procs used for calibrating overhead
+    proc proc2args {a b} {}
+    proc proc3args {a b c} {}
+
+    proc print {s} {
+        puts $s
+    }
+    proc print_usage {} {
+        puts stderr "Usage: [file tail [info nameofexecutable]] $::argv0 \[options\] \[command ...\]"
+        puts stderr "\t--description DESC\tHuman readable description of test run"
+        puts stderr "\t--label LABEL\tA label used to identify test environment"
+        puts stderr "\t--print-comments\tPrint comment for each test"
+        puts stderr "\t--print-iterations\tPrint number of iterations run for each test"
+    }
+
+    proc setup {argv} {
+        variable Options
+        variable Lengths
+
+        while {[llength $argv]} {
+            set argv [lassign $argv arg]
+            switch -glob -- $arg {
+                --print-comments -
+                --print-iterations {
+                    set Options($arg) 1
+                }
+                --label -
+                --description {
+                    if {[llength $argv] == 0} {
+                        error "Missing value for option $arg"
+                    }
+                    set argv [lassign $argv val]
+                    set Options($arg) $val
+                }
+                --lengths {
+                    if {[llength $argv] == 0} {
+                        error "Missing value for option $arg"
+                    }
+                    set argv [lassign $argv val]
+                    set Lengths $val
+                    
+                }
+                -- {
+                    # Remaining will be passed back to the caller
+                    break
+                }
+                --* {
+                    error "Unknown option $arg"
+                }
+                default {
+                    # Remaining will be passed back to the caller
+                    set argv [linsert $argv 0 $arg]
+                    break;
+                }
+            }
+        }
+
+        return $argv
+    }
+    proc format_timings {us iters} {
+        variable Options
+        if {!$Options(--print-iterations)} {
+            return "[format {%#10.4f} $us]"
+        }
+        return "[format {%#10.4f} $us] [format {%8d} $iters]"
+    }
+    proc measure {id script args} {
+        variable NullOverhead
+        variable RunTimes
+        variable Options
+
+        set opts(-overhead) ""
+        set opts(-runs) 5
+        while {[llength $args]} {
+            set args [lassign $args opt]
+            if {[llength $args] == 0} {
+                error "No argument supplied for $opt option. Test: $id"
+            }
+            set args [lassign $args val]
+            switch $opt {
+                -setup -
+                -cleanup -
+                -overhead -
+                -time -
+                -runs -
+                -reps {
+                    set opts($opt) $val
+                }
+                default {
+                    error "Unknown option $opt. Test: $id"
+                }
+            }
+        }
+
+        set timerate_args {}
+        if {[info exists opts(-time)]} {
+            lappend timerate_args $opts(-time)
+        }
+        if {[info exists opts(-reps)]} {
+            if {[info exists opts(-time)]} {
+                set timerate_args [list $opts(-time) $opts(-reps)]
+            } else {
+                # Force the default for first time option
+                set timerate_args [list 1000 $opts(-reps)]
+            }
+        } elseif {[info exists opts(-time)]} {
+            set timerate_args [list $opts(-time)]
+        }
+        if {[info exists opts(-setup)]} {
+            uplevel 1 $opts(-setup)
+        }
+        # Cache the empty overhead to prevent unnecessary delays. Note if you modify
+        # to cache other scripts, the cache key must be AFTER substituting the
+        # overhead script in the caller's context.
+        if {$opts(-overhead) eq ""} {
+            if {![info exists NullOverhead]} {
+                set NullOverhead [lindex [timerate {}] 0]
+            }
+            set overhead_us $NullOverhead
+        } else {
+            # The overhead measurements might use setup so we need to setup
+            # first and then cleanup in preparation for setting up again for
+            # the script to be measured
+            if {[info exists opts(-setup)]} {
+                uplevel 1 $opts(-setup)
+            }
+            set overhead_us [lindex [uplevel 1 [list timerate $opts(-overhead)]] 0]
+            if {[info exists opts(-cleanup)]} {
+                uplevel 1 $opts(-cleanup)
+            }
+        }
+        set timings {}
+        for {set i 0} {$i < $opts(-runs)} {incr i} {
+            if {[info exists opts(-setup)]} {
+                uplevel 1 $opts(-setup)
+            }
+            lappend timings [uplevel 1 [list timerate -overhead $overhead_us $script {*}$timerate_args]]
+            if {[info exists opts(-cleanup)]} {
+                uplevel 1 $opts(-cleanup)
+            }
+        }
+        set timings [lsort -real -index 0 $timings]
+        if {$opts(-runs) > 15} {
+            set ignore [expr {$opts(-runs)/8}]
+        } elseif {$opts(-runs) >= 5} {
+            set ignore 2
+        } else {
+            set ignore 0
+        }
+        # Ignore highest and lowest
+        set timings [lrange $timings 0 end-$ignore]
+        # Average it out
+        set us 0
+        set iters 0
+        foreach timing $timings {
+            set us [expr {$us + [lindex $timing 0]}]
+            set iters [expr {$iters + [lindex $timing 2]}]
+        }
+        set us [expr {$us/[llength $timings]}]
+        set iters [expr {$iters/[llength $timings]}]
+
+        set RunTimes(command) [expr {$RunTimes(command) + $us}]
+        print "P [format_timings $us $iters] $id"
+    }
+    proc comment {args} {
+        variable Options
+        if {$Options(--print-comments)} {
+            print "# [join $args { }]"
+        }
+    }
+    proc spanned_list {len} {
+        # Note - for small len, this will not create a spanned list
+        set delta [expr {$len/8}]
+        return [lrange [lrepeat [expr {$len+(2*$delta)}] a] $delta [expr {$delta+$len-1}]]
+    }
+    proc print_separator {command} {
+        comment [string repeat = 80]
+        comment Command: $command
+    }
+
+    oo::class create ListPerf {
+        constructor {args} {
+            my variable Opts
+            # Note default Opts can be overridden in construct as well as in measure
+            set Opts [dict merge {
+                -setup {
+                    set L [lrepeat $len a]
+                    set Lspan [perf::list::spanned_list $len]
+                } -cleanup {
+                    unset -nocomplain L
+                    unset -nocomplain Lspan
+                    unset -nocomplain L2
+                }
+            } $args]
+        }
+        method measure {comment script locals args} {
+            my variable Opts
+            dict with locals {}
+            ::perf::list::measure $comment $script {*}[dict merge $Opts $args]
+        }
+        method option {opt val} {
+            my variable Opts
+            dict set Opts $opt $val
+        }
+        method option_unset {opt} {
+            my variable Opts
+            unset -nocomplain Opts($opt)
+        }
+    }
+
+    proc linsert_describe {share_mode len at num iters} {
+        return "linsert L\[$len\] $share_mode $num elems $iters times at $at"
+    }
+    proc linsert_perf {} {
+        variable Lengths
+
+        print_separator linsert
+
+        comment == Insert into empty lists
+        comment Insert one element into empty list
+        measure [linsert_describe empty 0 "0 (const)" 1 1] {linsert {} 0 ""}
+
+        ListPerf create perf -overhead {set L {}} -time 1000
+
+        # Note: Const indices take different path through bytecode than variable
+        # indices hence separate cases below
+        foreach len $Lengths {
+            if {$len >= 10000} {
+                set reps 100
+            } else {
+                set reps [expr {100000/$len}]
+            }
+            perf option -reps $reps
+            foreach idx [list 0 1 [expr {$len/2}] end-1 end] {
+
+                # Const index
+                comment Insert once to shared list with const index
+                perf measure [linsert_describe shared $len "$idx (const)" 1 1] \
+                    "linsert \$L $idx x" [list len $len] -overhead {}
+
+                comment Insert multiple times to shared list with const index
+                perf measure [linsert_describe shared $len "$idx (const)" 1 $reps] \
+                    "set L \[linsert \$L $idx X\]" [list len $len]
+
+                # Variable index
+                comment Insert once to shared list with variable index
+                perf measure [linsert_describe shared $len "$idx (var)" 1 1] \
+                    {linsert $L $idx x} [list len $len idx $idx] -overhead {}
+
+                comment Insert multiple times to shared list with variable index
+                perf measure [linsert_describe shared $len "$idx (var)" 1 $reps] {
+                    set L [linsert $L $idx X]
+                } [list len $len idx $idx]
+            }
+
+            # Multiple items at a time
+            # Not in loop above because of desired output ordering
+            foreach idx [list 0 1 [expr {$len/2}] end-1 end] {
+                comment Insert multiple items multiple times to shared list with const index
+                perf measure [linsert_describe shared $len "$idx (const)" 5 $reps] \
+                    "set L \[linsert \$L $idx X X X X X\]" [list len $len]
+
+                comment Insert multiple items multiple times to shared list with variable index
+                perf measure [linsert_describe shared $len "$idx (var)" 5 $reps] {
+                    set L [linsert $L $idx X X X X X]
+                } [list len $len idx $idx]
+            }
+
+        }
+
+        # Not in loop above because of how we want order in output
+
+        foreach len $Lengths {
+            if {$len > 100000} {
+                set reps 10
+            } else {
+                set reps [expr {100000/$len}]
+            }
+            perf option -reps $reps
+            foreach idx [list 0 1 [expr {$len/2}] end-1 end] {
+                # NOTE : the Insert once case is left out for unshared lists
+                # because it requires re-init on every iteration resulting
+                # in a lot of measurement noise
+
+                # Const index
+                comment Insert multiple times to unshared list with const index
+                perf measure [linsert_describe unshared $len "$idx (const)" 1 $reps] \
+                    "set L \[linsert \$L\[set L {}\] $idx X]" [list len $len]
+
+                comment Insert multiple items multiple times to unshared list with const index
+                perf measure [linsert_describe unshared $len "$idx (const)" 5 $reps] \
+                    "set L \[linsert \$L\[set L {}\] $idx X X X X X]" [list len $len]
+
+                # Variable index
+
+                comment Insert multiple times to unshared list with variable index
+                perf measure [linsert_describe unshared $len "$idx (var)" 1 $reps] {
+                    set L [linsert $L[set L {}] $idx X]
+                } [list len $len idx $idx]
+
+                comment Insert multiple items multiple times to unshared list with variable index
+                perf measure [linsert_describe unshared $len "$idx (var)" 5 $reps] {
+                    set L [linsert $L[set L {}] $idx X X X X X]
+                } [list len $len idx $idx]
+
+            }
+        }
+
+        # Note: no span tests because the inserts above will themselves create
+        # spanned lists
+
+        perf destroy
+    }
+
+    proc lappend_describe {share_mode len num iters} {
+        return "lappend L\[$len\] $share_mode $num elems $iters times"
+    }
+    proc lappend_perf {} {
+        variable Lengths
+        
+        print_separator lappend
+
+        ListPerf create perf -setup {set L [lrepeat [expr {$len/4}] x]}
+
+        # Shared
+        foreach len $Lengths {
+            comment Append to a shared list variable multiple times
+            perf measure [lappend_describe shared [expr {$len/2}] 1 $len] {
+                set L2 $L; # Make shared
+                lappend L x
+            } [list len $len] -reps $len -overhead {set L2 $L}
+        }
+
+        # Unshared
+        foreach len $Lengths {
+            comment Append to a unshared list variable multiple times
+            perf measure [lappend_describe unshared [expr {$len/2}] 1 $len] {
+                lappend L x
+            } [list len $len] -reps $len
+        }
+
+        # Span
+        foreach len $Lengths {
+            comment Append to a unshared-span list variable multiple times
+            perf measure [lappend_describe unshared-span [expr {$len/2}] 1 $len] {
+                lappend Lspan x
+            } [list len $len] -reps $len
+        }
+
+        perf destroy
+    }
+
+    proc lpop_describe {share_mode len at reps} {
+        return "lpop L\[$len\] $share_mode at $at $reps times"
+    }
+    proc lpop_perf {} {
+        variable Lengths
+
+        print_separator lpop
+
+        ListPerf create perf
+
+        # Shared
+        perf option -overhead {set L2 $L}
+        foreach len $Lengths {
+            set reps [expr {($len >= 1000 ? ($len/2) : $len) - 2}]
+            foreach idx {0 1 end-1 end}  {
+                comment Pop element at position $idx from a shared list variable
+                perf measure [lpop_describe shared $len $idx $reps] {
+                    set L2 $L
+                    lpop L $idx
+                } [list len $len idx $idx] -reps $reps
+            }
+        }
+
+        # Unshared
+        perf option -overhead {}
+        foreach len $Lengths {
+            set reps [expr {($len >= 1000 ? ($len/2) : $len) - 2}]
+            foreach idx {0 1 end-1 end}  {
+                comment Pop element at position $idx from an unshared list variable
+                perf measure [lpop_describe unshared $len $idx $reps] {
+                    lpop L $idx
+                } [list len $len idx $idx] -reps $reps
+            }
+        }
+
+        perf destroy
+
+        # Nested
+        ListPerf create perf -setup {
+            set L [lrepeat $len [list a b]]
+        }
+
+        # Shared, nested index
+        perf option -overhead {set L2 $L; set L L2}
+        foreach len $Lengths {
+            set reps [expr {($len >= 1000 ? ($len/2) : $len) - 2}]
+            foreach idx {0 1 end-1 end}  {
+                perf measure [lpop_describe shared $len "{$idx 0}" $reps] {
+                    set L2 $L
+                    lpop L $idx 0
+                    set L $L2
+                } [list len $len idx $idx] -reps $reps
+            }
+        }
+
+        # TODO - Nested Unshared
+        # Not sure how to measure performance. When unshared there is no copy
+        # so deleting a nested index repeatedly is not feasible
+
+        perf destroy
+    }
+
+    proc lassign_describe {share_mode len num reps} {
+        return "lassign L\[$len\] $share_mode $num elems $reps times"
+    }
+    proc lassign_perf {} {
+        variable Lengths
+
+        print_separator lassign
+
+        ListPerf create perf
+
+        foreach len $Lengths {
+            set reps 1000
+            comment Reflexive lassign - shared
+            perf measure [lassign_describe shared $len 1 $reps] {
+                set L2 $L
+                set L2 [lassign $L2 v]
+            } [list len $len] -overhead {set L2 $L} -reps $reps
+
+            set reps [expr {($len >= 1000 ? ($len/2) : $len) - 2}]
+            comment Reflexive lassign - unshared
+            perf measure [lassign_describe unshared $len 1 $reps] {
+                set L [lassign $L v]
+            } [list len $len] -reps $reps
+
+            set reps 1000
+            comment Reflexive lassign - shared, multiple
+            perf measure [lassign_describe shared $len 5 $reps] {
+                set L2 $L
+                set L2 [lassign $L2 a b c d e]
+            } [list len $len] -overhead {set L2 $L} -reps $reps
+        }
+        perf destroy
+    }
+
+    proc lrepeat_describe {len num} {
+        return "lrepeat L\[$len\] $num elems at a time"
+    }
+    proc lrepeat_perf {} {
+        variable Lengths
+
+        print_separator lrepeat
+
+        ListPerf create perf -reps 100000
+        foreach len $Lengths {
+            comment Generate a list from a single repeated element
+            perf measure [lrepeat_describe $len 1] {
+                lrepeat $len a
+            } [list len $len]
+
+            comment Generate a list from multiple repeated elements
+            perf measure [lrepeat_describe $len 5] {
+                lrepeat $len a b c d e
+            } [list len $len]
+        }
+
+        perf destroy
+    }
+
+    proc lreverse_describe {share_mode len} {
+        return "lreverse L\[$len\] $share_mode"
+    }
+    proc lreverse_perf {} {
+        variable Lengths
+
+        print_separator lreverse
+
+        ListPerf create perf -reps 10000
+
+        foreach len $Lengths {
+            comment Reverse a shared list
+            perf measure [lreverse_describe shared $len] {
+                lreverse $L
+            } [list len $len]
+
+            comment Reverse a unshared list
+            perf measure [lreverse_describe unshared $len] {
+                set L [lreverse $L[set L {}]]
+            } [list len $len] -overhead {set L $L; set L {}}
+
+            if {$len >= 100} {
+                comment Reverse a shared-span list
+                perf measure [lreverse_describe shared-span $len] {
+                    lreverse $Lspan
+                } [list len $len]
+
+                comment Reverse a unshared-span list
+                perf measure [lreverse_describe unshared-span $len] {
+                    set Lspan [lreverse $Lspan[set Lspan {}]]
+                } [list len $len] -overhead {set Lspan $Lspan; set Lspan {}}
+            }
+        }
+
+        perf destroy
+    }
+
+    proc llength_describe {share_mode len} {
+        return "llength L\[$len\] $share_mode"
+    }
+    proc llength_perf {} {
+        variable Lengths
+
+        print_separator llength
+
+        ListPerf create perf -reps 100000
+
+        foreach len $Lengths {
+            comment Length of a list
+            perf measure [llength_describe shared $len] {
+                llength $L
+            } [list len $len]
+
+            if {$len >= 100} {
+                comment Length of a span list
+                perf measure [llength_describe shared-span $len] {
+                    llength $Lspan
+                } [list len $len]
+            }
+        }
+
+        perf destroy
+    }
+
+    proc lindex_describe {share_mode len at} {
+        return "lindex L\[$len\] $share_mode at $at"
+    }
+    proc lindex_perf {} {
+        variable Lengths
+
+        print_separator lindex
+
+        ListPerf create perf -reps 100000
+
+        foreach len $Lengths {
+            comment Index into a list
+            set idx [expr {$len/2}]
+            perf measure [lindex_describe shared $len $idx] {
+                lindex $L $idx
+            } [list len $len idx $idx]
+
+            if {$len >= 100} {
+                comment Index into a span list
+                perf measure [lindex_describe shared-span $len $idx] {
+                    lindex $Lspan $idx
+                } [list len $len idx $idx]
+            }
+        }
+
+        perf destroy
+    }
+
+    proc lrange_describe {share_mode len range} {
+        return "lrange L\[$len\] $share_mode range $range"
+    }
+
+    proc lrange_perf {} {
+        variable Lengths
+
+        print_separator lrange
+
+        ListPerf create perf -time 1000 -reps 100000
+
+        foreach share_mode {shared unshared} {
+            foreach len $Lengths {
+                set eighth [expr {$len/8}]
+                set ranges [list \
+                                [list 0 0]  [list 0 end-1] \
+                                [list $eighth [expr {3*$eighth}]] \
+                                [list $eighth [expr {7*$eighth}]] \
+                                [list 1 end] [list end-1 end] \
+                               ]
+                foreach range $ranges {
+                    comment Range $range in $share_mode list of length $len
+                    if {$share_mode eq "shared"} {
+                        perf measure [lrange_describe shared $len $range] \
+                            "lrange \$L $range" [list len $len range $range]
+                    } else {
+                        perf measure [lrange_describe unshared $len $range] \
+                            "lrange \[lrepeat \$len\ a] $range" \
+                            [list len $len range $range] -overhead {lrepeat $len a}
+                    }
+                }
+
+                if {$len >= 100} {
+                    foreach range $ranges {
+                        comment Range $range in ${share_mode}-span list of length $len
+                        if {$share_mode eq "shared"} {
+                            perf measure [lrange_describe shared-span $len $range] \
+                                "lrange \$Lspan {*}$range" [list len $len range $range]
+                        } else {
+                            perf measure [lrange_describe unshared-span $len $range] \
+                                "lrange \[perf::list::spanned_list \$len\] $range" \
+                                [list len $len range $range] -overhead {perf::list::spanned_list $len}
+                        }
+                    }
+                }
+            }
+        }
+
+        perf destroy
+    }
+
+    proc lset_describe {share_mode len at} {
+        return "lset L\[$len\] $share_mode at $at"
+    }
+    proc lset_perf {} {
+        variable Lengths
+
+        print_separator lset
+
+        ListPerf create perf -reps 10000
+
+        # Shared
+        foreach share_mode {shared unshared} {
+            foreach len $Lengths {
+                foreach idx {0 1 end-1 end end+1}  {
+                    comment lset at position $idx in a $share_mode list variable
+                    if {$share_mode eq "shared"} {
+                        perf measure [lset_describe shared $len $idx] {
+                            set L2 $L
+                            lset L $idx X
+                        } [list len $len idx $idx] -overhead {set L2 $L}
+                    } else {
+                        perf measure [lset_describe unshared $len $idx] {
+                            lset L $idx X
+                        } [list len $len idx $idx]
+                    }
+                }
+            }
+        }
+
+        perf destroy
+
+        # Nested
+        ListPerf create perf -setup {
+            set L [lrepeat $len [list a b]]
+        }
+
+        foreach share_mode {shared unshared} {
+            foreach len $Lengths {
+                foreach idx {0 1 end-1 end}  {
+                    comment lset at position $idx in a $share_mode list variable
+                    if {$share_mode eq "shared"} {
+                        perf measure [lset_describe shared $len "{$idx 0}"] {
+                            set L2 $L
+                            lset L $idx 0 X
+                        } [list len $len idx $idx] -overhead {set L2 $L}
+                    } else {
+                        perf measure [lset_describe unshared $len "{$idx 0}"] {
+                            lset L $idx 0 {X Y}
+                        } [list len $len idx $idx]
+                    }
+                }
+            }
+        }
+
+        perf destroy
+    }
+
+    proc lremove_describe {share_mode len at nremoved} {
+        return "lremove L\[$len\] $share_mode $nremoved elements at $at"
+    }
+    proc lremove_perf {} {
+        variable Lengths
+
+        print_separator lremove
+
+        ListPerf create perf -reps 10000
+
+        foreach share_mode {shared unshared} {
+            foreach len $Lengths {
+                foreach idx [list 0 1 [expr {$len/2}] end-1 end] {
+                    if {$share_mode eq "shared"} {
+                        comment Remove one element from shared list
+                        perf measure [lremove_describe shared $len $idx 1] \
+                            {lremove $L $idx} [list len $len idx $idx]
+
+                    } else {
+                        comment Remove one element from unshared list
+                        set reps [expr {$len >= 1000 ? ($len/8) : ($len-2)}]
+                        perf measure [lremove_describe unshared $len $idx 1] \
+                            {set L [lremove $L[set L {}] $idx]} [list len $len idx $idx] \
+                            -overhead {set L $L; set L {}} -reps $reps
+                    }
+                }
+                if {$share_mode eq "shared"} {
+                    comment Remove multiple elements from shared list
+                    perf measure [lremove_describe shared $len [list 0 1 [expr {$len/2}] end-1 end] 5] {
+                        lremove $L 0 1 [expr {$len/2}] end-1 end
+                    } [list len $len]
+                }
+            }
+            # Span
+            foreach len $Lengths {
+                foreach idx [list 0 1 [expr {$len/2}] end-1 end] {
+                    if {$share_mode eq "shared"} {
+                        comment Remove one element from shared-span list
+                        perf measure [lremove_describe shared-span $len $idx 1] \
+                            {lremove $Lspan $idx} [list len $len idx $idx]
+                    } else {
+                        comment Remove one element from unshared-span list
+                        set reps [expr {$len >= 1000 ? ($len/8) : ($len-2)}]
+                        perf measure [lremove_describe unshared-span $len $idx 1] \
+                            {set Lspan [lremove $Lspan[set Lspan {}] $idx]} [list len $len idx $idx] \
+                            -overhead {set Lspan $Lspan; set Lspan {}} -reps $reps
+                    }
+                }
+                if {$share_mode eq "shared"} {
+                    comment Remove multiple elements from shared-span list
+                    perf measure [lremove_describe shared-span $len [list 0 1 [expr {$len/2}] end-1 end] 5] {
+                        lremove $Lspan 0 1 [expr {$len/2}] end-1 end
+                    } [list len $len]
+                }
+            }
+        }
+
+        perf destroy
+    }
+
+    proc lreplace_describe {share_mode len first last ninsert {times 1}} {
+        if {$last < $first} {
+            return "lreplace L\[$len\] $share_mode 0 ($first:$last) elems at $first with $ninsert elems $times times."
+        }
+        return "lreplace L\[$len\] $share_mode $first:$last with $ninsert elems $times times."
+    }
+    proc lreplace_perf {} {
+        variable Lengths
+
+        print_separator lreplace
+
+        set default_reps 10000
+        ListPerf create perf -reps $default_reps
+
+        foreach share_mode {shared unshared} {
+            # Insert only
+            foreach len $Lengths {
+                set reps [expr {$len <= 100 ? ($len-2) : ($len/8)}]
+                foreach first [list 0 1 [expr {$len/2}] end-1 end] {
+                    if {$share_mode eq "shared"} {
+                        comment Insert one to shared list
+                        perf measure [lreplace_describe shared $len $first -1 1] {
+                            lreplace $L $first -1 x
+                        } [list len $len first $first]
+
+                        comment Insert multiple to shared list
+                        perf measure [lreplace_describe shared $len $first -1 10] {
+                            lreplace $L $first -1 X X X X X X X X X X
+                        } [list len $len first $first]
+
+                        comment Insert one to shared list repeatedly
+                        perf measure [lreplace_describe shared $len $first -1 1 $reps] {
+                            set L [lreplace $L $first -1 x]
+                        } [list len $len first $first] -reps $reps
+
+                        comment Insert multiple to shared list repeatedly
+                        perf measure [lreplace_describe shared $len $first -1 10 $reps] {
+                            set L [lreplace $L $first -1 X X X X X X X X X X]
+                        } [list len $len first $first] -reps $reps
+
+                    } else {
+                        comment Insert one to unshared list
+                        perf measure [lreplace_describe unshared $len $first -1 1] {
+                            set L [lreplace $L[set L {}] $first -1 x]
+                        } [list len $len first $first] -overhead {
+                            set L $L; set L {}
+                        } -reps $reps
+
+                        comment Insert multiple to unshared list
+                        perf measure [lreplace_describe unshared $len $first -1 10] {
+                            set L [lreplace $L[set L {}] $first -1 X X X X X X X X X X]
+                        } [list len $len first $first] -overhead {
+                            set L $L; set L {}
+                        } -reps $reps
+                    }
+                }
+            }
+
+            # Delete only
+            foreach len $Lengths {
+                set reps [expr {$len <= 100 ? ($len-2) : ($len/8)}]
+                foreach first [list 0 1 [expr {$len/2}] end-1 end] {
+                    if {$share_mode eq "shared"} {
+                        comment Delete one from shared list
+                        perf measure [lreplace_describe shared $len $first $first 0] {
+                            lreplace $L $first $first
+                        } [list len $len first $first]
+                    } else {
+                        comment Delete one from unshared list
+                        perf measure [lreplace_describe unshared $len $first $first 0] {
+                            set L [lreplace $L[set L {}] $first $first x]
+                        } [list len $len first $first] -overhead {
+                            set L $L; set L {}
+                        } -reps $reps
+                    }
+                }
+            }
+
+            # Insert + delete
+            foreach len $Lengths {
+                set reps [expr {$len <= 100 ? ($len-2) : ($len/8)}]
+                foreach range [list {0 1} {1 2} {end-2 end-1} {end-1 end}] {
+                    lassign $range first last
+                    if {$share_mode eq "shared"} {
+                        comment Insertions more than deletions from shared list
+                        perf measure [lreplace_describe shared $len $first $last 3] {
+                            lreplace $L $first $last X Y Z
+                        } [list len $len first $first last $last]
+
+                        comment Insertions same as deletions from shared list
+                        perf measure [lreplace_describe shared $len $first $last 2] {
+                            lreplace $L $first $last X Y 
+                        } [list len $len first $first last $last]
+
+                        comment Insertions fewer than deletions from shared list
+                        perf measure [lreplace_describe shared $len $first $last 1] {
+                            lreplace $L $first $last X
+                        } [list len $len first $first last $last]
+                    } else {
+                        comment Insertions more than deletions from unshared list
+                        perf measure [lreplace_describe unshared $len $first $last 3] {
+                            set L [lreplace $L[set L {}] $first $last X Y Z]
+                        } [list len $len first $first last $last] -overhead {
+                            set L $L; set L {}
+                        } -reps $reps
+
+                        comment Insertions same as deletions from unshared list
+                        perf measure [lreplace_describe unshared $len $first $last 2] {
+                            set L [lreplace $L[set L {}] $first $last X Y ]
+                        } [list len $len first $first last $last] -overhead {
+                            set L $L; set L {}
+                        } -reps $reps
+
+                        comment Insertions fewer than deletions from unshared list
+                        perf measure [lreplace_describe unshared $len $first $last 1] {
+                            set L [lreplace $L[set L {}] $first $last X]
+                        } [list len $len first $first last $last] -overhead {
+                            set L $L; set L {}
+                        } -reps $reps
+                    }
+                }
+            }
+            # Spanned Insert + delete
+            foreach len $Lengths {
+                set reps [expr {$len <= 100 ? ($len-2) : ($len/8)}]
+                foreach range [list {0 1} {1 2} {end-2 end-1} {end-1 end}] {
+                    lassign $range first last
+                    if {$share_mode eq "shared"} {
+                        comment Insertions more than deletions from shared-span list
+                        perf measure [lreplace_describe shared-span $len $first $last 3] {
+                            lreplace $Lspan $first $last X Y Z
+                        } [list len $len first $first last $last]
+
+                        comment Insertions same as deletions from shared-span list
+                        perf measure [lreplace_describe shared-span $len $first $last 2] {
+                            lreplace $Lspan $first $last X Y 
+                        } [list len $len first $first last $last]
+
+                        comment Insertions fewer than deletions from shared-span list
+                        perf measure [lreplace_describe shared-span $len $first $last 1] {
+                            lreplace $Lspan $first $last X
+                        } [list len $len first $first last $last]
+                    } else {
+                        comment Insertions more than deletions from unshared-span list
+                        perf measure [lreplace_describe unshared-span $len $first $last 3] {
+                            set Lspan [lreplace $Lspan[set Lspan {}] $first $last X Y Z]
+                        } [list len $len first $first last $last] -overhead {
+                            set Lspan $Lspan; set Lspan {}
+                        } -reps $reps
+
+                        comment Insertions same as deletions from unshared-span list
+                        perf measure [lreplace_describe unshared-span $len $first $last 2] {
+                            set Lspan [lreplace $Lspan[set Lspan {}] $first $last X Y ]
+                        } [list len $len first $first last $last] -overhead {
+                            set Lspan $Lspan; set Lspan {}
+                        } -reps $reps
+
+                        comment Insertions fewer than deletions from unshared-span list
+                        perf measure [lreplace_describe unshared-span $len $first $last 1] {
+                            set Lspan [lreplace $Lspan[set Lspan {}] $first $last X]
+                        } [list len $len first $first last $last] -overhead {
+                            set Lspan $Lspan; set Lspan {}
+                        } -reps $reps
+                    }
+                }
+            }
+        }
+
+        perf destroy
+    }
+
+    proc join_describe {share_mode len} {
+        return "join L\[$len\] $share_mode"
+    }
+    proc join_perf {} {
+        variable Lengths
+
+        print_separator join
+
+        ListPerf create perf -reps 10000
+        foreach len $Lengths {
+            comment Join a list
+            perf measure [join_describe shared $len] {
+                join $L
+            } [list len $len]
+        }
+        foreach len $Lengths {
+            comment Join a spanned list
+            perf measure [join_describe shared-span $len] {
+                join $Lspan
+            } [list len $len]
+        }
+        perf destroy
+    }
+
+    proc lsearch_describe {share_mode len} {
+        return "lsearch L\[$len\] $share_mode"
+    }
+    proc lsearch_perf {} {
+        variable Lengths
+
+        print_separator lsearch
+
+        ListPerf create perf -reps 100000
+        foreach len $Lengths {
+            comment Search a list
+            perf measure [lsearch_describe shared $len] {
+                lsearch $L needle
+            } [list len $len]
+        }
+        foreach len $Lengths {
+            comment Search a spanned list
+            perf measure [lsearch_describe shared-span $len] {
+                lsearch $Lspan needle
+            } [list len $len]
+        }
+        perf destroy
+    }
+
+    proc foreach_describe {share_mode len} {
+        return "foreach L\[$len\] $share_mode"
+    }
+    proc foreach_perf {} {
+        variable Lengths
+
+        print_separator foreach
+
+        ListPerf create perf -reps 10000
+        foreach len $Lengths {
+            comment Iterate through a list
+            perf measure [foreach_describe shared $len] {
+                foreach e $L {}
+            } [list len $len]
+        }
+        foreach len $Lengths {
+            comment Iterate a spanned list
+            perf measure [foreach_describe shared-span $len] {
+                foreach e $Lspan {}
+            } [list len $len]
+        }
+        perf destroy
+    }
+
+    proc lmap_describe {share_mode len} {
+        return "lmap L\[$len\] $share_mode"
+    }
+    proc lmap_perf {} {
+        variable Lengths
+
+        print_separator lmap
+
+        ListPerf create perf -reps 10000
+        foreach len $Lengths {
+            comment Iterate through a list
+            perf measure [lmap_describe shared $len] {
+                lmap e $L {}
+            } [list len $len]
+        }
+        foreach len $Lengths {
+            comment Iterate a spanned list
+            perf measure [lmap_describe shared-span $len] {
+                lmap e $Lspan {}
+            } [list len $len]
+        }
+        perf destroy
+    }
+
+    proc get_sort_sample {{spanned 0}} {
+        variable perfScript
+        variable sortSampleText
+
+        if {![info exists sortSampleText]} {
+            set fd [open $perfScript]
+            set sortSampleText [split [read $fd] ""]
+            close $fd
+        }
+        set sortSampleText [string range $sortSampleText 0 9999]
+
+        # NOTE: do NOT cache list result in a variable as we need it unshared
+        if {$spanned} {
+            return [lrange [split $sortSampleText ""] 1 end-1]
+        } else {
+            return [split $sortSampleText ""]
+        }
+    }
+    proc lsort_describe {share_mode len} {
+        return "lsort L\[$len] $share_mode"
+    }
+    proc lsort_perf {} {
+        print_separator lsort
+
+        ListPerf create perf -setup {}
+
+        comment Sort a shared list
+        perf measure [lsort_describe shared [llength [perf::list::get_sort_sample]]] {
+            lsort $L
+        } {} -setup {set L [perf::list::get_sort_sample]}
+
+        comment Sort an unshared list
+        perf measure [lsort_describe unshared [llength [perf::list::get_sort_sample]]] {
+            lsort [perf::list::get_sort_sample]
+        } {} -overhead {perf::list::get_sort_sample}
+
+        comment Sort a shared-span list
+        perf measure [lsort_describe shared-span [llength [perf::list::get_sort_sample 1]]] {
+            lsort $L
+        } {} -setup {set L [perf::list::get_sort_sample 1]}
+
+        comment Sort an unshared-span list
+        perf measure [lsort_describe unshared-span [llength [perf::list::get_sort_sample 1]]] {
+            lsort [perf::list::get_sort_sample 1]
+        } {} -overhead {perf::list::get_sort_sample 1}
+
+        perf destroy
+    }
+
+    proc concat_describe {canonicality len elemlen} {
+        return "concat L\[$len\] $canonicality with elements of length $elemlen"
+    }
+    proc concat_perf {} {
+        variable Lengths
+
+        print_separator concat
+
+        ListPerf create perf -reps 100000
+
+        foreach len $Lengths {
+            foreach elemlen {1 100} {
+                comment Pure lists (no string representation)
+                perf measure [concat_describe "pure lists" $len $elemlen] {
+                    concat $L $L
+                } [list len $len elemlen $elemlen] -setup {
+                    set L [lrepeat $len [string repeat a $elemlen]]
+                }
+
+                comment Canonical lists (with string representation)
+                perf measure [concat_describe "canonical lists" $len $elemlen] {
+                    concat $L $L
+                } [list len $len elemlen $elemlen] -setup {
+                    set L [lrepeat $len [string repeat a $elemlen]]
+                    append x x $L; # Generate string while keeping internal rep list
+                    unset x
+                }
+
+                comment Non-canonical lists
+                perf measure [concat_describe "non-canonical lists" $len $elemlen] {
+                    concat $L $L
+                } [list len $len elemlen $elemlen] -setup {
+                    set L [string repeat "[string repeat a $elemlen] " $len]
+                    llength $L
+                }
+            }
+        }
+
+        # Span version
+        foreach len $Lengths {
+            foreach elemlen {1 100} {
+                comment Pure span lists (no string representation)
+                perf measure [concat_describe "pure spanned lists" $len $elemlen] {
+                    concat $L $L
+                } [list len $len elemlen $elemlen] -setup {
+                    set L [lrange [lrepeat [expr {$len+2}] [string repeat a $elemlen]] 1 end-1]
+                }
+
+                comment Canonical span lists (with string representation)
+                perf measure [concat_describe "canonical spanned lists" $len $elemlen] {
+                    concat $L $L
+                } [list len $len elemlen $elemlen] -setup {
+                    set L [lrange [lrepeat [expr {$len+2}] [string repeat a $elemlen]] 1 end-1]
+                    append x x $L; # Generate string while keeping internal rep list
+                    unset x
+                }
+            }
+        }
+
+        perf destroy
+    }
+
+    proc test {} {
+        variable RunTimes
+        variable Options
+
+        set selections [perf::list::setup $::argv]
+        if {[llength $selections] == 0} {
+            set commands [info commands ::perf::list::*_perf]
+        } else {
+            set commands [lmap sel $selections {
+                if {$sel eq "help"} {
+                    print_usage
+                    continue
+                }
+                set cmd ::perf::list::${sel}_perf
+                if {$cmd ni [info commands ::perf::list::*_perf]} {
+                    puts stderr "Error: command $sel is not known or supported. Skipping."
+                    continue
+                }
+                set cmd
+            }]
+        }
+        comment Setting up
+        timerate -calibrate {}
+        if {[info exists Options(--label)]} {
+            print "L $Options(--label)"
+        }
+        print "V [info patchlevel]"
+        print "E [info nameofexecutable]"
+        if {[info exists Options(--description)]} {
+            print "D $Options(--description)"
+        }
+        set twapi_keys {-privatebytes -workingset -workingsetpeak}
+        if {[info commands ::twapi::get_process_memory_info] ne ""} {
+            set twapi_vm_pre [::twapi::get_process_memory_info]
+        }
+        foreach cmd [lsort -dictionary $commands] {
+            set RunTimes(command) 0.0
+            $cmd
+            set RunTimes(total) [expr {$RunTimes(total)+$RunTimes(command)}]
+            print "P [format_timings $RunTimes(command) 1] [string range $cmd 14 end-5] total run time"
+        }
+        # Print total runtime in same format as timerate output
+        print "P [format_timings $RunTimes(total) 1] Total run time"
+
+        if {[info exists twapi_vm_pre]} {
+            set twapi_vm_post [::twapi::get_process_memory_info]
+            set MB 1048576.0
+            foreach key $twapi_keys {
+                set pre [expr {[dict get $twapi_vm_pre $key]/$MB}]
+                set post [expr {[dict get $twapi_vm_post $key]/$MB}]
+                print "P [format_timings $pre 1] Memory (MB) $key pre-test"
+                print "P [format_timings $post 1] Memory (MB) $key post-test"
+                print "P [format_timings [expr {$post-$pre}] 1] Memory (MB) delta $key"
+            }
+        }
+        if {[info commands memory] ne ""} {
+            foreach line [split [memory info] \n] {
+                if {$line eq ""} continue
+                set line [split $line]
+                set val [expr {[lindex $line end]/1000.0}]
+                set line [string trim [join [lrange $line 0 end-1]]]
+                print "P [format_timings $val 1] memdbg $line (in thousands)"
+            }
+            print "# Allocations not freed on exit written to the lost-memory.tmp file."
+            print "# These will have to be manually compared."
+            # env TCL_FINALIZE_ON_EXIT must be set to 1 for this.
+            # DO NOT SET HERE - set ::env(TCL_FINALIZE_ON_EXIT) 1
+            # Must be set in environment before starting tclsh else bogus results
+            if {[info exists Options(--label)]} {
+                set dump_file list-memory-$Options(--label).memdmp
+            } else {
+                set dump_file list-memory-[pid].memdmp
+            }
+            memory onexit $dump_file
+        }
+    }
+}
+
+
+if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} {
+    ::perf::list::test
+}