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 99c6f0ef9354fced332b979ea07ad34755eaf1e6:


proc expr-unbraced {a} {
    set b 23
    set c 4
    set d 6
    set e 7
    expr $a*$b+log($c)-pow($d,$e)
    expr $a*$b+log($c)-pow($d,$e)
}
proc expr-braced {a} {
    set b 23
    set c 4
    set d 6
    set e 7
    expr {$a*$b+log($c)-pow($d,$e)}
    expr {$a*$b+log($c)-pow($d,$e)}
}
proc expr-unbraced-long {a op} {
    expr $a $op $a $op $a $op $a $op $a $op $a $op $a $op $a $op $a $op $a \
	$op $a $op $a $op $a $op $a $op $a $op $a $op $a $op $a $op $a \
	$op $a $op $a * 2 $op $a $op $a $op $a $op $a $op $a $op $a $op $a \
	$op $a $op $a * 2 $op $a $op $a $op $a $op $a $op $a $op $a $op $a \
	$op $a $op $a * 2 $op $a $op $a $op $a $op $a $op $a $op $a $op $a \
	$op $a $op $a * 2 $op $a $op $a $op $a $op $a $op $a $op $a $op $a \
	$op $a $op $a * 2 $op $a $op $a $op $a $op $a $op $a $op $a $op $a \
	$op $a $op $a $op $a $op $a $op $a $op $a $op  $a $op $a $op 1
}

proc expr-3.1 {a} {
    expr {$a}
}
proc expr-3.2 {a} {
    expr {$a + $a + $a + $a + $a + $a + $a + $a + $a + $a}
}
proc expr-3.3 {a} {
    expr {$a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a + $a +  $a + $a + $a + $a}
}

proc expr-incr-incr {value} {
    incr value
}
proc expr-incr-expr {value} {
    expr {$value + 1}
}
proc expr-streq {a b} {
    expr {$a == $b}; expr {$a == $b}; expr {$a == $b}; expr {$a == $b}
}
proc expr-strneq {a b} {
    expr {$a != $b}; expr {$a != $b}; expr {$a != $b}; expr {$a != $b}
}
proc expr-int {val} {
    expr {int($val)}
    expr {int($val)}
}
proc expr-dbl {val} {
    expr {double($val)}
    expr {double($val)}
}
proc expr-rand-fun {rng} {
    expr {int([rand]*$rng)}
    expr {int([rand]*$rng)}
}
proc rand {} { return 0.5 }
proc expr-rand {rng} {
    expr {int(rand()*$rng)}
    expr {int(rand()*$rng)}
}
proc expr-builtin {} {
    expr {sin(0.50)}
    expr {sin(0.50)}
}
proc expr-builtin-dyn {fun val} {
    expr ${fun}($val)
    expr ${fun}($val)
}
proc expr-UpdateStringOfDouble {} {
    # 8.5 slowdown caused by UpdateStringOfDouble: http://tip.tcl.tk/132
    # 8.6 performance patched 2010-11-28, 8.5 2010-11-30
    set moo [expr {double(1.234)}]
    set cow "moo $moo"
}
proc expr-USoD2 {} {
    # 8.5 slowdown caused by UpdateStringOfDouble: http://tip.tcl.tk/132
    # 8.6 performance patched 2010-11-28, 8.5 2010-11-30
    set moo [expr {double(1e27)}]
    set cow "moo $moo"
}
proc expr-USoD3 {} {
    # 8.5 slowdown caused by UpdateStringOfDouble: http://tip.tcl.tk/132
    # 8.6 performance patched 2010-11-28, 8.5 2010-11-30
    set moo [expr {double(0.000123)}]
    set cow "moo $moo"
}
proc expr-abs-expr {a b} {
    if {$a > $b} {
	return [expr {$a - $b}]
    } else {
	return [expr {$b - $a}]
    }
}
proc expr-abs-func {a b} {
    return [expr {abs($a - $b)}]
}


if { [catch {string repeat "abc" 10}] } {
    proc str-repeat {str num} {
	set val {}
	for {set i 0} {$i < $num} {incr i} { append val $str }
	return $val
    }
} else {
    proc str-repeat {str num} { string repeat $str $num }
}
set base [str-repeat a 100]
set str1 "$base abc"
set str2 "$base cde"
set str3 "$base f"

bench -desc "EXPR \$a == \$b str (== len)" -body {expr-streq $str1 $str2}
bench -desc "EXPR \$a != \$b str (== len)" -body {expr-strneq $str1 $str2}
bench -desc "EXPR \$a == \$b str (!= len)" -body {expr-streq $str1 $str3}
bench -desc "EXPR \$a != \$b str (!= len)" -body {expr-strneq $str1 $str3}
bench -desc "EXPR \$a == \$b int" -body {expr-streq 100 200}
bench -desc "EXPR \$a != \$b int" -body {expr-strneq 100 200}
bench -desc "EXPR \$a == \$b dbl" -body {expr-streq 100.0 200.0}
bench -desc "EXPR \$a != \$b dbl" -body {expr-strneq 100.0 200.0}

bench -desc "EXPR unbraced" -body {expr-unbraced 12}
bench -desc "EXPR unbraced long" -body {expr-unbraced-long 13 +}
bench -desc "EXPR braced" -body {expr-braced 12}
bench -desc "EXPR inline" -body {
    set a 12
    set b 23
    set c 4
    set d 6
    set e 7
    expr {$a*$b+log($c)-pow($d,$e)}
}
bench -body {expr-3.1 1} -desc "EXPR one operand"
bench -body {expr-3.2 1} -desc "EXPR ten operands"
bench -body {expr-3.3 1} -desc "EXPR fifty operands"
bench -body {expr-incr-incr 1} -desc "EXPR incr with incr"
bench -body {expr-incr-expr 1} -desc "EXPR incr with expr"

bench -body {expr-int 100.0} -desc "EXPR cast int"
bench -body {expr-dbl 100} -desc "EXPR cast double"
if {$tcl_version >= 8.0} {
    bench -body {expr-rand 100} -desc "EXPR rand range"
}
bench -body {expr-rand-fun 100} -desc "EXPR rand range func"
bench -body {expr-builtin} -desc "EXPR builtin sin"
bench -body {expr-builtin-dyn cos 0.5} -desc "EXPR builtin dyn"

bench -body {expr-abs-expr 0.2 1.5} -desc "EXPR abs as expr"
bench -body {expr-abs-func 0.2 1.5} -desc "EXPR abs builtin"

foreach val {0 12 17} {
    if {![catch {set tcl_precision $val}]} {
	bench -body { expr-UpdateStringOfDouble } \
	    -desc "EXPR UpdStrOfDbl+1.23 prec$tcl_precision"
	bench -body { expr-USoD2 } \
	    -desc "EXPR UpdStrOfDbl+1e27 prec$tcl_precision"
	bench -body { expr-USoD3 } \
	    -desc "EXPR UpdStrOfDbl+1e-4 prec$tcl_precision"
	unset tcl_precision
    }
}