Version 6 of a checkpoint-based profiler

Updated 2015-03-02 02:19:55 by RLE

FF 2008-07-15 - I suspect that (another) command profiler won't help me much tomorrow, when I'll try spotting the bottleneck of xdrgen-ng, so I am thinking to an alternative to it.

a checkpoint-based profiler measures time between checkpoints, and reports (average) times. The only two checkpoints mandatory are start and stop and have a special function (try guessing it!).

Every other checkpoint name will be reported when profiler reaches end checkpoint.

Example:

 profiler start
 
 for {set i 0} {$i < 10} {incr i} {
 
        set r [expr {int(rand()*2000)}]
        for {set j 0} {$j < $r} {incr j} {
        }

        profiler cp1

        for {set j 0} {$j < 30000} {incr j} {}

        profiler cp2

        for {set j 0} {$j < 170} {incr j} {
                for {set jj 0} {$jj < 170} {incr jj} {
                }
        }

        profiler cp3
 }
 
 profiler end

Output:

 checkpoint:  avgtime:
 cp1          1078.6
 cp2          21780.1
 cp3          21628.3

 proc profiler {id} {
        global db_t
        global db_c
        array set db_t {}
        array set db_c {}
        global last
        switch -- $id {
                start {
                        set last [clock microseconds]
                }
                end {
                        set k [array names db_t]
                        puts [format {%-12s %s} {checkpoint:} {avgtime:}]
                        foreach ik $k {
                                puts [format {%-12s %.1f} $ik [expr {1.0*$db_t($ik)/$db_c($ik)}]]
                        }
                        array unset db_t
                        array unset db_c
                }
                default {
                        set delta [expr {[clock microseconds]-$last}]
                        set last [clock microseconds]
                        if {[info exists db_t($id)]} {incr db_t($id) $delta} {set db_t($id) $delta}
                        if {[info exists db_c($id)]} {incr db_c($id) 1     } {set db_c($id) 1     }
                }
        }
 }