Doc-de: update to notation manual 4

[lilypond.git] / scm / memory-trace.scm

diff --git a/scm/memory-trace.scm b/scm/memory-trace.scm
index f5a19e8e4b688210dce8ccf897344fdb25545895..345d1327f0f47f4ca4cdebe350b577f2fa077172 100644 (file)
--- a/scm/memory-trace.scm
+++ b/scm/memory-trace.scm
@@ -1,3 +1,5 @@
+;;;; memory-trace.scm
+
 (define-module (scm memory-trace))
 (use-modules (lily)
             (ice-9 format))
@@ -31,22 +33,29 @@
 (define (record-stack key continuation . args)
   (if (eq? (current-thread) trace-thread)
       #t ;; do nothing.
-      (begin
+      (let*
+         ((cells (assoc-get '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))
@@ -58,7 +67,7 @@
   (set! trace-points '())
   (set! continue-tracing #t)
   (set! trace-count 0)
-  (set! start-memory (cdr (assoc 'total-cells-allocated (gc-stats))))
+  (set! start-memory (assoc-get 'total-cells-allocated (gc-stats)))
   (set! start-time (tms:utime (times)))
   
   (install-tracepoint))
@@ -91,20 +100,20 @@
     (for-each
      (lambda (r)
        (let*
-          ((mem (- (cdr (assoc 'total-cells-allocated r)) start-memory))
-           (proc (cdr (assoc 'proc r)))
-           (stack (cdr (assoc 'stack r)))
-           (time (- (cdr (assoc 'time r)) start-time)))
+          ((mem (- (assoc-get 'cells r) start-memory))
+           (proc (assoc-get 'proc r))
+           (stack (assoc-get 'stack r))
+           (time (- (assoc-get 'time r) start-time)))
         
         (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
                   ((j 0 (1+ j))
-                   (stack (cdr (assoc 'stack r)) stack))
+                   (stack (assoc-get 'stack r) stack))
                   ((>= j (vector-length stack)))
                 
                 (format stacks-out "\t~a\n"