- (define out (open-output-file (format #f "~a.graph" base)))
- (define stacks-out (open-output-file (format #f "~a.stacks" base)))
- (define i 0)
- (define last-mem 0)
- (format out "# memory trace with ~a points\n" (length trace-points))
-
- (for-each
- (lambda (r)
- (let*
- ((mem (cdr (assoc 'total-cells-allocated r)))
- (proc (cdr (assoc 'proc r)))
- (stack (cdr (assoc 'stack r))))
-
- (format out "~a ~a\n" i mem)
- (if stack
- (begin
- (format stacks-out "~15a - delta-mem: ~15a - ~a \n" i
- (- mem last-mem) proc)
- (do
- ((j 0 (1+ j))
- (stack (cdr (assoc 'stack r)) stack))
- ((>= j (vector-length stack)))
-
- (format stacks-out "\t~a\n"
- (vector-ref stack j)))))
-
- (set! i (1+ i))
- (set! last-mem mem)
- ))
- (reverse trace-points)))
-
+ (let*
+ ((stacks-name (format #f "~a.stacks" base))
+ (graph-name (format #f "~a.graph" base))
+ (graph-out (open-output-file graph-name))
+ (stacks-out (open-output-file stacks-name))
+ (i 0)
+ (last-mem 0)
+ )
+
+ (ly:progress "Memory statistics to ~a and ~a..."
+ stacks-name graph-name)
+ (format graph-out "# memory trace with ~a points\n" (length trace-points))
+ (for-each
+ (lambda (r)
+ (let*
+ ((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
+ time
+ (- mem last-mem) proc)
+ (do
+ ((j 0 (1+ j))
+ (stack (assoc-get 'stack r) stack))
+ ((>= j (vector-length stack)))
+
+ (format stacks-out "\t~a\n"
+ (vector-ref stack j)))))
+
+ (set! i (1+ i))
+ (set! last-mem mem)
+ ))
+ (reverse trace-points))))