X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmemory-trace.scm;h=39bedc18047c8b6f1e37dfeb7460727217bd216f;hb=7b032d0e90b828bee401bc27febd3cc1a736c0c2;hp=f5a19e8e4b688210dce8ccf897344fdb25545895;hpb=684e8c983d8388417a00385d9b86b60bcc88c02b;p=lilypond.git

diff --git a/scm/memory-trace.scm b/scm/memory-trace.scm
index f5a19e8e4b..39bedc1804 100644
--- a/scm/memory-trace.scm
+++ b/scm/memory-trace.scm
@@ -31,22 +31,29 @@
 (define (record-stack key continuation . args)
   (if (eq? (current-thread) trace-thread)
       #t ;; do nothing.
-      (begin
+      (let*
+	  ((cells (cdr (assoc 'total-cells-allocated (gc-stats))))
+	   (proc (arg-procedure args))
+	   (time (tms:utime (times)))
+	   (stack (extract-trace continuation)))
+	
 	(set! busy-tracing #t)
 	(trap-disable 'traps)
 	(trap-disable 'enter-frame)
 
 	(set! trace-count (1+ trace-count))
-	(ly:progress "<~a: ~a>\n"
+ 	(ly:progress "<~a: ~a/~a>\n"
 		     trace-count
-		     (- (cdr (assoc 'total-cells-allocated (gc-stats))) last-count))
-	(set! last-count (cdr (assoc 'total-cells-allocated (gc-stats))))
+		     (- time start-time)
+		     (- cells last-count))
+
+	(set! last-count cells)
 	(set! trace-points
 	      (cons (list
-		     (assoc 'total-cells-allocated (gc-stats))
-		     (cons 'stack (extract-trace continuation))
-		     (cons 'proc (arg-procedure args))
-		     (cons 'time (tms:utime (times)))
+		     (cons 'cells cells)
+		     (cons 'proc proc)
+		     (cons 'stack stack)
+		     (cons 'time time)
 		     )
 		    
 		    trace-points))
@@ -91,7 +98,7 @@
     (for-each
      (lambda (r)
        (let*
-	   ((mem (- (cdr (assoc 'total-cells-allocated r)) start-memory))
+	   ((mem (- (cdr (assoc 'cells r)) start-memory))
 	    (proc (cdr (assoc 'proc r)))
 	    (stack (cdr (assoc 'stack r)))
 	    (time (- (cdr (assoc 'time r)) start-time)))
@@ -99,7 +106,7 @@
 	 (format graph-out "~a ~a\n" time mem)
 	 (if stack
 	     (begin
-	       (format stacks-out "~5a t = ~5a - delta-mem: ~15a - ~a \n" i
+	       (format stacks-out "~5a t = ~5a - delta-mem: ~15a - ~a\n" i
 		       time
 		       (- mem last-mem) proc)
 	       (do