Tk Library Source Code

Artifact [8ede3b1390]
Login

Artifact 8ede3b1390ef40f806fd2cecb1acae7926df7311:

Attachment "patch0.patch" to ticket [1747945fff] added by dzach 2007-07-05 00:41:14.
diff --git a/profiler.tcl b/profiler.tcl
index 5ddb9e2..c875bd9 100644
--- a/profiler.tcl
+++ b/profiler.tcl
@@ -75,37 +75,27 @@ proc ::profiler::tMark { { tag "" } } {
 #	the mean, the standard deviation, and the covariance.
 #
 # Arguments:
-#	args	Values for which to compute information.
+#	name		name of the function to profile
+#	mean		the mean time
+#	timeSumSq	the sum of squares of function execution time
 #
 # Results:
 #	A list with three elements:  the mean, the standard deviation, and the
 #	covariance.
 
-proc ::profiler::stats {args} {
-    set sum      0
-    set mean     0
-    set sigma_sq 0
-    set sigma    0
-    set cov      0
-    set N [ llength $args ]
-    if { $N > 1 } { 
-        foreach val $args {
-            incr sum $val
-        }
-        if {$sum > 0} {
-            set mean [ expr { $sum/$N } ]
-            foreach val $args {
-                set sigma_sq [ expr { $sigma_sq+pow(($val-$mean),2) } ]
-            }
-            set sigma_sq [ expr { $sigma_sq/($N-1) } ] 
-            set sigma [ expr { round(sqrt($sigma_sq)) } ]
-	    if { $mean != 0 } {
+proc ::profiler::stats {name mean timeSumSq} {
+	variable callCount
+    set cov 0
+	if {$callCount($name) > 1} {
+		set sigma [expr {sqrt(($timeSumSq - $::profiler::callCount($name)* $mean*$mean)/ double($::profiler::callCount($name)-1))}]
+	} {
+		set sigma 0
+	}
+	if { $mean != 0 } {
 		set cov [ expr { (($sigma*1.0)/$mean)*100 } ]
 		set cov [ expr { round($cov*10)/10.0 } ]
-	    }
-        }
-    }
-    return [ list $mean $sigma $cov ]
+	}
+ 	list $mean $sigma $cov
 }
 
 # ::profiler::Handler --
@@ -235,11 +225,13 @@ proc ::profiler::leaveHandler {name caller} {
     }
 
     set t [::profiler::tMark $name.$caller]
-    lappend ::profiler::statTime($name) $t
 
     if { [incr ::profiler::callCount($name)] == 1 } {
         set ::profiler::compileTime($name) $t
-    }
+   } 
+    set ::profiler::timeMean($name) [expr {($::profiler::timeMean($name)*($::profiler::callCount($name)-1)+ $t)/double($::profiler::callCount($name))}]
+    set ::profiler::timeSumSq($name) [expr {$::profiler::timeSumSq($name) + $t*$t}]
+
     incr ::profiler::totalRuntime($name) $t
     if { [catch {incr ::profiler::descendantTime($caller) $t}] } {
         set ::profiler::descendantTime($caller) $t
@@ -267,7 +259,8 @@ proc ::profiler::profProc {name arglist body} {
     variable compileTime
     variable totalRuntime
     variable descendantTime
-    variable statTime
+    variable timeMean
+    variable timeSumSq
     variable enabled
     variable paused
     
@@ -290,7 +283,8 @@ proc ::profiler::profProc {name arglist body} {
     set compileTime($name) 0
     set totalRuntime($name) 0
     set descendantTime($name) 0
-    set statTime($name) {}
+    set timeMean($name) 0
+    set timeSumSq($name) 0
     set enabled($name) [expr {!$paused}]
 
     if {[package vsatisfies [package provide Tcl] 8.4]} {
@@ -341,7 +335,8 @@ proc ::profiler::print {{pattern *}} {
     variable totalRuntime
     variable descendantTime
     variable descendants
-    variable statTime
+    variable timeMean
+    variable timeSumSq
     variable callers
     
     set result ""
@@ -351,7 +346,7 @@ proc ::profiler::print {{pattern *}} {
 	set covRuntime 0
 	set avgDesTime 0
 	if { $callCount($name) > 0 } {
-	    foreach {m s c} [eval ::profiler::stats $statTime($name)] { break }
+	    foreach {m s c} [eval ::profiler::stats $name $timeMean($name) $timeSumSq($name)] { break }
 	    set avgRuntime   $m
 	    set sigmaRuntime $s
 	    set covRuntime   $c
@@ -373,8 +368,8 @@ proc ::profiler::print {{pattern *}} {
 	}
 	append result "           Compile time:  $compileTime($name)\n"
 	append result "          Total runtime:  $totalRuntime($name)\n"
-	append result "        Average runtime:  $avgRuntime\n"
-	append result "          Runtime StDev:  $sigmaRuntime\n"
+	append result "        Average runtime:  [expr {round($avgRuntime)}]\n"
+	append result "          Runtime StDev:  [expr {round($sigmaRuntime)}]\n"
 	append result "         Runtime cov(%):  $covRuntime\n"
 	append result "  Total descendant time:  $descendantTime($name)\n"
 	append result "Average descendant time:  $avgDesTime\n"
@@ -408,7 +403,8 @@ proc ::profiler::dump {{pattern *}} {
     variable callers
     variable descendantTime
     variable descendants
-    variable statTime
+    variable timeMean
+    variable timeSumSq
 
     set result ""
     foreach name [lsort [array names callCount $pattern]] {
@@ -422,7 +418,7 @@ proc ::profiler::dump {{pattern *}} {
 	set covRuntime 0
 	set avgDesTime 0
 	if { $callCount($name) > 0 } {
-	    foreach {m s c} [eval ::profiler::stats $statTime($name)] { break }
+	    foreach {m s c} [eval ::profiler::stats $name $timeMean($name) $timeSumSq($name)] { break }
 	    set avgRuntime   $m
 	    set sigmaRuntime $s
 	    set covRuntime   $c
@@ -438,7 +434,7 @@ proc ::profiler::dump {{pattern *}} {
 		compileTime $compileTime($name) \
 		totalRuntime $totalRuntime($name) \
 		averageRuntime $avgRuntime \
-		stddevRuntime  $sigmaRuntime \
+		stddevRuntime $sigmaRuntime \
 		covpercentRuntime $covRuntime \
 		descendantTime $descendantTime($name) \
 		averageDescendantTime $avgDesTime \
@@ -536,20 +532,22 @@ proc ::profiler::reset {{pattern *}} {
     variable compileTime
     variable totalRuntime
     variable callers
-    variable statTime
+    variable timeMean
+    variable timeSumSq
 
     foreach name [array names callCount $pattern] {
 	set callCount($name) 0
 	set compileTime($name) 0
 	set totalRuntime($name) 0
-	set statTime($name) {}
+	set timeMean($name) 0
+	set timeSumSq($name) 0
 	foreach caller [array names callers $name,*] {
 	    unset callers($caller)
 	}
     }
     return
 }
-
+ 
 # ::profiler::suspend --
 #
 #	Suspend the profiler.