# # RCS: @(#) $Id: binary.bench,v 1.4 2010/10/02 01:23:03 hobbs Exp $ # if {[catch {package require Tcl 8}]} { return } proc bin-scan {binStr} { binary scan $binStr c* var return [llength $var] } proc bitset-v1 {bitmask str} { set result "" foreach c [split $str ""] { binary scan $c c v append result [binary format c [expr {$v | $bitmask}]] } return $result } proc bitset-v2 {bitmask str} { set result "" binary scan $str "c*" vals foreach v $vals { append result [binary format c [expr {$v | $bitmask}]] } return $result } proc bitset-v3 {bitmask str} { set result "" binary scan $str "c*" vals foreach v $vals { lappend result [expr {$v | $bitmask}] } return [binary format c* $result] } proc bin-chars {str} { binary scan $str c* vals foreach c $vals { lappend bytes [expr {$c & 0xff}] } return [binary format c* $bytes] } proc bin-uchars {str} { binary scan $str cu* bytes return [binary format cu* $bytes] } binary scan Az cc A z proc bin-randstr [list length [list min $A] [list max $z]] { set range [expr {$max-$min}] set txt "" for {set i 0} {$i < $length} {incr i} { set ch [expr {$min+int(rand()*$range)}] append txt [binary format c $ch] } return $txt } proc bin-randstr2 [list length [list min $A] [list max $z]] { set range [expr {$max-$min}] set bytes [list] for {set i 0} {$i < $length} {incr i} { lappend bytes [expr {$min+int(rand()*$range)}] } return [binary format c* $bytes] } # String operations # proc init {} { expr {srand(12345)} for {set i 1} {$i <= 10000} {incr i} { lappend binvals [expr {int(rand()*255)}] append randStr [format %c [expr {int(rand()*255)}]] if {$i == 1000} { set ::binvar1000 [binary format c* $binvals] set ::randStr1000 $randStr } elseif {$i == 5000} { set ::binvar5000 [binary format c* $binvals] set ::randStr5000 $randStr } } set ::binvar10000 [binary format c* $binvals] set ::randStr10000 $randStr return } proc timing {} { global binvar1000 set methods {bin-scan bin-chars} if {![catch {binary scan \x00 cu x}]} { lappend methods bin-uchars } foreach iter {100 500 1000} { foreach method $methods { set time [expr {[lindex [::time {$method $binvar1000} $iter] 0]/1000}] puts [format "% 12s iter % 6d: %.5f millisecs/iteration" \ $method $iter $time] } } } if {!$tcl_interactive} { init if {[info commands bench] == ""} { puts "Tcl [info patchlevel]" timing } else { bench -desc "BIN c scan, 1000b" -iters 500 \ -body {bin-scan $binvar1000} bench -desc "BIN c scan, 5000b" -iters 300 \ -body {bin-scan $binvar5000} bench -desc "BIN c scan, 10000b" -iters 100 \ -body {bin-scan $binvar10000} bench -desc "BIN rand string 100b" \ -body {bin-randstr 100} bench -desc "BIN rand2 string 100b" \ -body {bin-randstr2 100} bench -desc "BIN rand string 5000b" -iters 1000 \ -body {bin-randstr 5000} bench -desc "BIN rand2 string 5000b" -iters 1000 \ -body {bin-randstr2 5000} bench -desc "BIN chars, 10000b" -iters 500 \ -body {bin-chars $binvar10000} if {![catch {binary scan \x00 cu x}]} { bench -desc "BIN u char, 10000b" -iters 500 \ -body {bin-uchars $binvar10000} } foreach method {bitset-v1 bitset-v2 bitset-v3} { foreach size {1000 5000 10000} iters {160 80 40} { bench -desc "BIN $method $size chars" -iters $iters \ -body "$method 85 \$randStr$size" } } } }