#
# 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"
            }
        }
    }
}
