Tcl/Tk Benchmark Suite And Tools
Artifact Content
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2018 Conference, Houston/TX, US, Oct 15-19
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Aug 20.

Artifact 6871fe4decc3cfca5e471d253a47460cd2a50ba2:



proc var-incr-local {n} {
    set VAR(foo) 0
    for {set i 0} {$i < $n} {incr i} {
	incr VAR(foo)
    }
}
proc var-incr-global {n} {
    global VAR
    set VAR(foo) 0
    for {set i 0} {$i < $n} {incr i} {
	incr VAR(foo)
    }
}
proc var-incr-upvar {n} {
    upvar \#0 VAR v
    set v(foo) 0
    for {set i 0} {$i < $n} {incr i} {
	incr v(foo)
    }
}

# Local set variable access
proc var-local-set {a} {
    set z 1
    set b $z
    set c $z
    set d $z
}

# Local input variable access
proc var-local-input {a} {
    set z 1
    set b $a
    set c $a
    set d $a
}

# Local input variable access
proc var-mset {l} {
    set a [lindex $l 0]
    set b [lindex $l 1]
    set c [lindex $l 2]
    set d [lindex $l 3]
    set e [lindex $l 4]
    set f [lindex $l 5]
    set g [lindex $l 6]
    set h [lindex $l 7]
}

proc var-foreach {l} {
    foreach {a b c d e f g h} $l { break }
}

# Global variable access
# This takes a bogus input var to avoid proc compilation slowdown
# (8.[12]) from skewing point of this test
proc var-global {bogus} {
    global a
    set z 1
    set b $a
    set c $a
    set d $a
}

if {[info tclversion] >= 8.0} {
    namespace eval ::foo::var::ref { variable x }
    proc ::foo::var::ref {val} {
	variable x 0
	while {$x < $val} { incr x }
    }
    proc ::foo::var::gref {val} {
	set ::foo::var::x 0
	while {$::foo::var::x < $val} { incr ::foo::var::x }
    }
    proc ::foo::var::lref {val} {
	set x 0
	while {$x < $val} { incr x }
    }
} else {
    proc ::foo::var::ref {val} {
	return -code 666 "8.0+"
    }
    proc ::foo::var::gref {val} {
	return -code 666 "8.0+"
    }
    proc ::foo::var::lref {val} {
	return -code 666 "8.0+"
    }
}

# Upvar variable access
proc var-upvar {varname} {
    upvar 1 $varname a
    set z 1
    set b $a
    set c $a
    set d $a
}

# Setting a value in an array vs. setting a scalar
#
proc var-scalar {a} {
    set bar $a
}
proc var-array {a} {
    global foo
    set foo(1) $a
}

proc var-set-many {a} {
    global foo
    set foo(0) $a;    set foo(1) $a;    set foo(2) $a;    set foo(3) $a;
    set foo(4) $a;    set foo(5) $a;    set foo(6) $a;    set foo(7) $a;
    set foo(8) $a;    set foo(9) $a;    set foo(10) $a;    set foo(11) $a;
    set foo(12) $a;    set foo(13) $a;    set foo(14) $a;    set foo(15) $a;
    set foo(16) $a;    set foo(17) $a;    set foo(18) $a;    set foo(19) $a;
    set foo(20) $a;    set foo(21) $a;    set foo(22) $a;    set foo(23) $a;
    set foo(24) $a;    set foo(25) $a;    set foo(26) $a;    set foo(27) $a;
    set foo(28) $a;    set foo(29) $a;    set foo(30) $a;    set foo(31) $a;
    set foo(32) $a;    set foo(33) $a;    set foo(34) $a;    set foo(35) $a;
    set foo(36) $a;    set foo(37) $a;    set foo(38) $a;    set foo(39) $a;
    set foo(40) $a;    set foo(41) $a;    set foo(42) $a;    set foo(43) $a;
    set foo(44) $a;    set foo(45) $a;    set foo(46) $a;    set foo(47) $a;
    set foo(48) $a;    set foo(49) $a;    set foo(50) $a;    set foo(51) $a;
    set foo(52) $a;    set foo(53) $a;    set foo(54) $a;    set foo(55) $a;
    set foo(56) $a;    set foo(57) $a;    set foo(58) $a;    set foo(59) $a;
    set foo(60) $a;    set foo(61) $a;    set foo(62) $a;    set foo(63) $a;
    set foo(64) $a;    set foo(65) $a;    set foo(66) $a;    set foo(67) $a;
    set foo(68) $a;    set foo(69) $a;    set foo(70) $a;    set foo(71) $a;
    set foo(72) $a;    set foo(73) $a;    set foo(74) $a;    set foo(75) $a;
    set foo(76) $a;    set foo(77) $a;    set foo(78) $a;    set foo(79) $a;
    set foo(80) $a;    set foo(81) $a;    set foo(82) $a;    set foo(83) $a;
    set foo(84) $a;    set foo(85) $a;    set foo(86) $a;    set foo(87) $a;
    set foo(88) $a;    set foo(89) $a;    set foo(90) $a;    set foo(91) $a;
    set foo(92) $a;    set foo(93) $a;    set foo(94) $a;    set foo(95) $a;
    set foo(96) $a;    set foo(97) $a;    set foo(98) $a;    set foo(99) $a;
}

proc var-array-set {a} {
    global foo
    array set foo [list 0 $a 1 $a 2 $a 3 $a 4 $a 5 $a 6 $a 7 $a 8 $a 9 $a \
	    10 $a 11 $a 12 $a 13 $a 14 $a 15 $a 16 $a 17 $a 18 $a 19 $a \
	    20 $a 21 $a 22 $a 23 $a 24 $a 25 $a 26 $a 27 $a 28 $a 29 $a \
	    30 $a 31 $a 32 $a 33 $a 34 $a 35 $a 36 $a 37 $a 38 $a 39 $a \
	    40 $a 41 $a 42 $a 43 $a 44 $a 45 $a 46 $a 47 $a 48 $a 49 $a \
	    50 $a 51 $a 52 $a 53 $a 54 $a 55 $a 56 $a 57 $a 58 $a 59 $a \
	    60 $a 61 $a 62 $a 63 $a 64 $a 65 $a 66 $a 67 $a 68 $a 69 $a \
	    70 $a 71 $a 72 $a 73 $a 74 $a 75 $a 76 $a 77 $a 78 $a 79 $a \
	    80 $a 81 $a 82 $a 83 $a 84 $a 85 $a 86 $a 87 $a 88 $a 89 $a \
	    90 $a 91 $a 92 $a 93 $a 94 $a 95 $a 96 $a 97 $a 98 $a 99 $a]
}

bench -iter 10000 -desc "VAR access locally set" \
	-body {var-local-set abc}
bench -iter 10000 -desc "VAR access local proc arg" \
	-body {var-local-input abc}
set a 1
bench -iter 10000 -desc "VAR access global" \
	-body {var-global abc}
unset a
set a 1
bench -iter 10000 -desc "VAR access upvar" \
	-body {var-upvar a}

set i 1000
catch {unset VAR}
bench -desc "VAR incr local var ${i}x" \
	-body {var-incr-local $i}
bench -desc "VAR incr global var ${i}x" \
	-body {var-incr-global $i}
bench -desc "VAR incr upvar var ${i}x" \
	-body {var-incr-upvar $i}
catch {unset VAR}

# Create and populate a small array, so that we can avoid the cost of
# creating the array itself in the benchmarks below
set foo(0) 0

bench -desc "VAR set scalar" \
	-body {var-scalar 1}
bench -desc "VAR set array element" \
	-body {var-array 1}

bench -desc "VAR 100 'set's in array" \
	-body {var-set-many 1}
bench -desc "VAR 'array set' of 100 elems" \
	-body {var-array-set 1}

bench -desc "VAR ref variable" \
	-body {::foo::var::ref 50}
bench -desc "VAR ref absolute" \
	-body {::foo::var::gref 50}
bench -desc "VAR ref local" \
	-body {::foo::var::lref 50}

bench -desc "VAR mset" \
	-body [list var-mset [list a b c d e f g h]]
bench -desc "VAR mset (foreach)" \
	-body [list var-foreach [list a b c d e f g h]]