Hi

Here is a properly formatted version of the patch.

     - Tommi Höynälänmaa


Tommi Höynälänmaa kirjoitti 26.1.2021 klo 13.27:
Hi

I made an enhanced version of Guile statprof that computes the cumulative time spent in procedures correctly (so that recursive invocations of the same procedure are counted only once). The patch is attached. Please inform me if you find any bugs.

     - Tommi Höynälänmaa



Description: Implement corrected cumulative execution time in statprof
Author: Tommi Höynälänmaa <tommi.hoynalan...@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)
 

Attachment: OpenPGP_0xBB861FDE40460F83.asc
Description: application/pgp-keys

Attachment: OpenPGP_signature
Description: OpenPGP digital signature

Reply via email to