From 030bc9eb9e8e66703736b90460a7688ca48e0756 Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sat, 2 Jan 2016 17:24:37 +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.

Conflicts:
	chicken-profile.scm
---
 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 61ec005..6534f8f 100644
--- a/chicken-profile.scm
+++ b/chicken-profile.scm
@@ -159,8 +159,10 @@ EOF
   (make-vector symbol-table-size '()))
 
 (define (read-profile)
-  (let ((hash (make-symbol-table)))
-    (do ((line (read) (read)))
+  (let* ((hash (make-symbol-table))
+	 (header (read))
+	 (type (if (symbol? header) header 'instrumented)))
+    (do ((line (if (symbol? header) (read) header) (read)))
 	((eof-object? line))
       (##sys#hash-table-set!
        hash (first line)
@@ -172,7 +174,7 @@ EOF
        (lambda (sym counts)
 	 (set! alist (alist-cons sym counts alist)))
        hash)
-      alist)))
+      (cons type alist))))
 
 (define (format-string str cols #!optional right (padc #\space))
   (let* ((len (string-length str))
@@ -195,17 +197,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 621f4ed..8586d2d 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)
 
 
@@ -122,7 +125,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 8e171cf..230603f 100644
--- a/runtime.c
+++ b/runtime.c
@@ -13229,6 +13229,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