From 3bd25d9033889b8482e95e3422547cfc70cb490b Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sun, 6 Dec 2015 20:07:30 +0100
Subject: [PATCH 3/3] Fix statistical percentage chicken-profile output

Now both profiling types write a header in the first line to indicate
the type of file, so that chicken-profiles knows whether to take the
highest or the total of the run time as 100% when dividing.
---
 chicken-profile.scm | 24 +++++++++++++++++-------
 profiler.scm        |  8 +++++++-
 runtime.c           |  1 +
 3 files changed, 25 insertions(+), 8 deletions(-)

diff --git a/chicken-profile.scm b/chicken-profile.scm
index 63dd804..b54674a 100644
--- a/chicken-profile.scm
+++ b/chicken-profile.scm
@@ -152,15 +152,17 @@ EOF
       (error "invalid argument to -decimals option" arg)))
 
 (define (read-profile)
-  (let ((hash (make-hash-table eq?)))
-    (do ((line (read) (read)))
+  (let* ((hash (make-hash-table eq?))
+	 (header (read))
+	 (type (if (symbol? header) header 'instrumented)))
+    (do ((line (if (symbol? header) (read) header) (read)))
 	((eof-object? line))
       (hash-table-set!
        hash (first line)
        (map (lambda (x y) (and x y (+ x y)))
 	    (hash-table-ref/default hash (first line) '(0 0)) 
 	    (cdr line))))
-    (hash-table->alist hash)))
+    (cons type (hash-table->alist hash))))
 
 (define (format-string str cols #!optional right (padc #\space))
   (let* ((len (string-length str))
@@ -183,17 +185,25 @@ EOF
 
 (define (write-profile)
   (print "reading `" file "' ...\n")
-  (let* ((data0 (with-input-from-file file read-profile))
-	 (max-t (foldl (lambda (r t) (max r (third t))) 0 data0))
+  (let* ((type&data0 (with-input-from-file file read-profile))
+	 (type  (car type&data0))
+	 (data0 (cdr type&data0))
+	 ;; Instrumented profiling results in total runtime being
+	 ;; counted for the outermost "main" procedure, while
+	 ;; statistical counts time spent only inside the procedure
+	 ;; itself.  Ideally we'd have both, but that's tricky to do.
+	 (total-t (foldl (if (eq? type 'instrumented)
+			     (lambda (r t) (max r (third t)))
+			     (lambda (r t) (+ r (third t)))) 0 data0))
 	 (data (sort (map
 		      (lambda (t)
 			(append
 			 t
 			 (let ((c (second t)) ; count
-			       (t (third t))) ; total time
+			       (t (third t))) ; time tallied to procedure
 			   (list (or (and c (> c 0) (/ t c)) ; time / count
 				     0)
-				 (or (and (> max-t 0) (* (/ t max-t) 100)) ; % of max-time
+				 (or (and (> total-t 0) (* (/ t total-t) 100)) ; % of total-time
 				     0)
 				 ))))
 		      data0)
diff --git a/profiler.scm b/profiler.scm
index a4b4958..2a7bc63 100644
--- a/profiler.scm
+++ b/profiler.scm
@@ -35,6 +35,9 @@
 
 (define-foreign-variable profile-id int "C_getpid()")
 
+(define empty-file? (foreign-lambda* bool ((scheme-object p))
+		      "C_return(ftell(C_port_file(p)) == 0);"))
+
 (define-constant profile-info-entry-size 5)
 
 
@@ -121,7 +124,10 @@
 	(##sys#print "[debug] writing profile...\n" #f ##sys#standard-error) )
       (apply
        with-output-to-file ##sys#profile-name
-       (lambda () 
+       (lambda ()
+	 (when (empty-file? (current-output-port)) ; header needed?
+	   (write 'instrumented)
+	   (write-char #\newline))
 	 (for-each
 	  (lambda (vec)
 	    (let ([len (##sys#size vec)])
diff --git a/runtime.c b/runtime.c
index 8c09564..58b8f49 100644
--- a/runtime.c
+++ b/runtime.c
@@ -9455,6 +9455,7 @@ C_word C_i_dump_statistical_profile()
   if (fp == NULL)
     panic(C_text("could not write profile!"));
 
+  C_fputs(C_text("statistical\n"), fp);
   for(n = 0; n < PROFILE_TABLE_SIZE; ++n) {
     for(b = bp[ n ]; b != NULL; b = b2) {
       b2 = b->next;
-- 
2.1.4