~ chicken-core (chicken-5) a68c580475ded09cc716e5777a2a63cc29ba26ec

commit a68c580475ded09cc716e5777a2a63cc29ba26ec
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Sat Jan 2 17:24:37 2016 +0100
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Sat Jan 16 19:23:11 2016 +1300

    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.
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/chicken-profile.scm b/chicken-profile.scm
index 61ec0050..7e70236f 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,26 @@ 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 621f4ed4..f39f807d 100644
--- a/profiler.scm
+++ b/profiler.scm
@@ -37,6 +37,10 @@
 
 (define-constant profile-info-entry-size 5)
 
+(define empty-file?
+  (foreign-lambda* bool ((scheme-object p))
+    "C_return(ftell(C_port_file(p)) == 0);"))
+
 
 ;;; Globals:
 
@@ -122,7 +126,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 460c0cfc..b4ab27ed 100644
--- a/runtime.c
+++ b/runtime.c
@@ -13234,6 +13234,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;