Description: Implement corrected cumulative execution time in statprof
Author: Tommi Höynälänmaa <tommi.hoynalanmaa@iki.fi>
---
This patch header follows DEP-3: http://dep.debian.net/deps/dep3/
--- a/module/statprof.scm
+++ b/module/statprof.scm
@@ -355,13 +355,16 @@
 
 (define-record-type call-data
   (make-call-data name printable source
-                  call-count cum-sample-count self-sample-count)
+                  call-count cum-sample-count corr-cum-sample-count
+		  self-sample-count)
   call-data?
   (name call-data-name)
   (printable call-data-printable)
   (source call-data-source)
   (call-count call-data-call-count set-call-data-call-count!)
   (cum-sample-count call-data-cum-sample-count set-call-data-cum-sample-count!)
+  (corr-cum-sample-count call-data-corr-cum-sample-count
+			 set-call-data-corr-cum-sample-count!)
   (self-sample-count call-data-self-sample-count set-call-data-self-sample-count!))
 
 (define (source->string source)
@@ -387,6 +390,10 @@
   (set-call-data-cum-sample-count! cd (1+ (call-data-cum-sample-count cd))))
 (define (inc-call-data-self-sample-count! cd)
   (set-call-data-self-sample-count! cd (1+ (call-data-self-sample-count cd))))
+(define (inc-call-data-corr-cum-sample-count! cd)
+  (set-call-data-corr-cum-sample-count!
+   cd
+   (1+ (call-data-corr-cum-sample-count cd))))
 
 (define (skip-count-call buffer start len)
   ;; If we are counting all procedure calls, count-call might be on the
@@ -424,7 +431,8 @@
                                         (and call-counts
                                              (hashv-ref call-counts entry))
                                         0
-                                        0)))
+                                        0
+					0)))
               (hashv-set! table entry data)
               data))))
 
@@ -443,12 +451,16 @@
                         pos)))
           (inc-call-data-self-sample-count!
            (addr->call-data (vector-ref buffer pos)))
-          (let visit-stack ((pos pos))
+          (let visit-stack ((pos pos)
+			    (visited-data '()))
             (cond
              ((vector-ref buffer pos)
               => (lambda (ip)
-                   (inc-call-data-cum-sample-count! (addr->call-data ip))
-                   (visit-stack (1+ pos))))
+		   (let ((cur-data (addr->call-data ip)))
+		     (inc-call-data-cum-sample-count! cur-data)
+		     (if (not (memv cur-data visited-data))
+			 (inc-call-data-corr-cum-sample-count! cur-data))
+		     (visit-stack (1+ pos) (cons cur-data visited-data)))))
              (else
               (visit-stacks (1+ pos)))))))
        (else table)))))
@@ -502,13 +514,15 @@
 
 (define-record-type stats
   (make-stats proc-name proc-source
-              %-time-in-proc cum-secs-in-proc self-secs-in-proc
+              %-time-in-proc cum-secs-in-proc corr-cum-secs-in-proc
+	      self-secs-in-proc
               calls)
   stats?
   (proc-name statprof-stats-proc-name)
   (proc-source statprof-stats-proc-source)
   (%-time-in-proc statprof-stats-%-time-in-proc)
   (cum-secs-in-proc statprof-stats-cum-secs-in-proc)
+  (corr-cum-secs-in-proc statprof-stats-corr-cum-secs-in-proc)
   (self-secs-in-proc statprof-stats-self-secs-in-proc)
   (calls statprof-stats-calls))
 
@@ -534,6 +548,7 @@
          (proc-source (and=> (call-data-source call-data) source->string))
          (self-samples (call-data-self-sample-count call-data))
          (cum-samples (call-data-cum-sample-count call-data))
+         (corr-cum-samples (call-data-corr-cum-sample-count call-data))
          (all-samples (statprof-sample-count state))
          (secs-per-sample (/ (statprof-accumulated-time state)
                              (statprof-sample-count state)))
@@ -547,6 +562,7 @@
                 proc-source
                 (* (/ self-samples all-samples) 100.0)
                 (* cum-samples secs-per-sample 1.0)
+                (* corr-cum-samples secs-per-sample 1.0)
                 (* self-samples secs-per-sample 1.0)
                 num-calls)))
 
@@ -577,9 +593,10 @@
            (sorted-stats (sort stats-list stats-sorter)))
 
       (define (display-stats-line stats)
-        (format port "~6,2f ~9,2f ~9,2f"
+        (format port "~6,2f  ~9,2f  ~9,2f ~9,2f"
                 (statprof-stats-%-time-in-proc stats)
                 (statprof-stats-cum-secs-in-proc stats)
+                (statprof-stats-corr-cum-secs-in-proc stats)
                 (statprof-stats-self-secs-in-proc stats))
         (if (call-counts state)
             (if (statprof-stats-calls stats)
@@ -599,15 +616,15 @@
     
       (if (call-counts state)
           (begin
-            (format  port "~5a ~10a   ~7a  ~8a\n"
-                     "%  " "cumulative" "self" "")
-            (format  port "~5a  ~9a  ~8a  ~7a ~a\n"
-                     "time" "seconds" "seconds" "calls" "procedure"))
+            (format  port "~5a  ~10a ~10a  ~7a  ~8a\n"
+                     "%  " "cumulative" "corr. cum." "self" "")
+            (format  port "~5a  ~10a ~10a  ~8a  ~7a ~a\n"
+                     "time" "seconds" "seconds" "seconds" "calls" "procedure"))
           (begin
-            (format  port "~5a ~10a   ~7a  ~8a\n"
-                     "%" "cumulative" "self" "")
-            (format  port "~5a  ~10a  ~7a  ~a\n"
-                     "time" "seconds" "seconds" "procedure")))
+            (format  port "~5a  ~10a ~10a  ~7a  ~8a\n"
+                     "%" "cumulative" "corr. cum." "self" "")
+            (format  port "~5a  ~10a ~10a  ~7a   ~a\n"
+                     "time" "seconds" "seconds" "seconds" "procedure")))
 
       (for-each display-stats-line sorted-stats)