~ chicken-core (chicken-5) 8dcd283fdc1f279ace1417844bba7d4e27a2577f

commit 8dcd283fdc1f279ace1417844bba7d4e27a2577f
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Sun Dec 6 20:07:30 2015 +0100
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Sat Jan 16 19:55:59 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 63dd804e..896a9095 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,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 a4b4958e..a8535a6d 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:
 
@@ -121,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 4cd35633..b4eae89d 100644
--- a/runtime.c
+++ b/runtime.c
@@ -9460,6 +9460,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;