[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     }
                }
        }
 }
======

------

[aplsimple] 2022-12-24:

I've modified a bit the profiler by Federico, the modifications are mostly about

   * wrapping with two commands (''::PR start'' and ''::PR end'')
   * allowing ''::PR start'' to take a checkpoint
   * sorting output lines
   * removing globals

The modified profiler is used by [alited, a lite editor%|%alited], its last version is available in [https://chiselapp.com/user/aplsimple/repository/alited/download%|%Chiselapp].

======

#######################################################################
# Name:    cp_profiler.tcl
# Author:  Federico Ferri (+ Alex Plotnikov as a wrapper)
# Date:    12/22/2022
# Brief:   Wraps the Tcl profiler originally made by Federico Ferri.
# License: MIT.
#######################################################################

# ________________________ PR _________________________ #

namespace eval ::PR {
  namespace export start end
  namespace ensemble create
  variable db_t; array set db_t {}   ;# times array
  variable db_c; array set db_c {}   ;# counts array
  variable last [clock microseconds] ;# 'last' initialized (for time delta)
}

## ________________________ profiler by FF _________________________ ##

proc ::PR::profiler {id} {
  # A bit modified profiler originally made by Federico Ferri.
  #   id - checkpoint's ID or "start" or "end"
  # If $id eq "start", it starts the profiling.
  # If $id eq "end", it ends the profiling.
  # All other $id mean checkpoints to be profiled.

  variable db_t
  variable db_c
  variable last
  switch -- $id {
    start {
      set last [clock microseconds]
    }
    end {
      set lres [list]
      foreach ik [array names db_t] {
        lappend lres [list [expr {1.0*$db_t($ik)/$db_c($ik)}] $ik $db_t($ik) $db_c($ik)]
      }
      set lres [lsort -decreasing -command ::PR::compare $lres]
      puts \n[format {%16s %16s %16s %16s} checkpoint: time: count: avgtime:]
      foreach res $lres {
        lassign $res val ik t c
        puts [format {%16s %16s %16s %16.1f} $ik $t $c $val]
      }
      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     }
    }
  }
}

## ________________________ additions by AP _________________________ ##

proc ::PR::start {args} {
  # Runs the profiler.
  #   args - if "", starts the profiler, else sets "$args" checkpoint.
  # The checkpoint can be any string, excluding "start" and "end".

  if {$args in {start end}} {
    error "::PR start - checkpoint can't be \"start\" nor \"end\"\n"
  } elseif {[llength $args]} {
    profiler $args
  } else {
    profiler start
  }
}
#_______________________

proc ::PR::end {} {
  # Ends the profiler and outputs its results.
  # After "end", the profiler can be "start"ed again.

  profiler end
}
#_______________________

proc ::PR::compare {a b} {
  # Compares numbers of two items containing "number name ...".
  #   a - 1st item
  #   b - 2nd item

  set a0 [lindex $a 0]
  set b0 [lindex $b 0]
  if {$a0 < $b0} {
    return -1
  } elseif {$a0 > $b0} {
    return 1
  }
  return [string compare [lindex $a 1] [lindex $b 1]]
}

# ________________________ EOF _________________________ #

======

----
'''[aplsimple] - 2022-12-24 06:40:07'''

Not updated.

<<categories>> Performance