Tcl Source Code

Artifact f7129bd4deabcf28384a030284fbe6b577591c2e:

package provide cps 0.1
# ----------------------------------------------------------------------
# cps --
#       A wrapper round [time] to make it better for performance analysis of
#       very fast code. It works by tuning the number of iterations used until
#       the run-time of the code is around a second.
#
proc cps {script} {
    # Eat the script compilation costs
    uplevel 1 [list time $script]

    # Have a guess at how many iterations to run for around a second
    set s [uplevel 1 [list time $script 5]]
    set iters [expr {round(1.1/([lindex $s 0]/1e6))}]
    if {$iters < 50} {
        puts "WARNING: number of iterations low"
    }

    # The main timing run
    while 1 {
        set s [uplevel 1 [list time $script $iters]]
        # Only use the run if it was for at least a second, otherwise increase
        # the number of iterations and try again.
        if {[lindex $s 0]*$iters >= 1e6} {
            break
        }
        incr iters $iters
    }

    # Produce the results
    set cps [expr {round(1/([lindex $s 0]/1e6))}]
    puts "$cps calls per second of: [string trim $script]"
}