From d45b36b615bcd88681afe11f21d39f524d5a2bc9 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Thu, 18 Jan 2007 01:30:45 +0100 Subject: [PATCH] memory tracing refinements. --- scm/lily.scm | 3 ++- scm/memory-trace.scm | 19 +++++++++---------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/scm/lily.scm b/scm/lily.scm index a0940d9be9..cb1e593e37 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -122,7 +122,8 @@ on errors, and print a stack trace.") ;;; debugging evaluator is slower. This should ;;; have a more sensible default. -(if (ly:get-option 'verbose) +(if (or (ly:get-option 'verbose) + (ly:get-option 'trace-memory-frequencency)) (begin (ly:set-option 'protected-scheme-parsing #f) (debug-enable 'debug) diff --git a/scm/memory-trace.scm b/scm/memory-trace.scm index dd86c49107..0bcf5bd19c 100644 --- a/scm/memory-trace.scm +++ b/scm/memory-trace.scm @@ -1,6 +1,5 @@ (define-module (scm memory-trace)) -(use-modules (ice-9 format)) (define-public (mtrace:start-trace freq) (set! usecond-interval (inexact->exact (/ 1000000 freq))) (call-with-new-thread start-install-tracepoint)) @@ -32,6 +31,7 @@ (set! busy-tracing #t) (trap-disable 'traps) (trap-disable 'enter-frame) + (set! trace-count (1+ trace-count)) (set! trace-points @@ -39,6 +39,7 @@ (assoc 'total-cells-allocated (gc-stats)) (cons 'stack (extract-trace continuation)) (cons 'proc (arg-procedure args)) + (cons 'time (tms:utime (times))) ) trace-points)) @@ -62,20 +63,22 @@ (install-tracepoint))) (define-public (mtrace:dump-results base) - (define out (open-output-file (format #f "~a.graph" base))) + (define out-graph (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)) + (define last-mem 0) + + (format out-graph "# 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)))) + (stack (cdr (assoc 'stack r))) + (time (cdr (assoc 'time r)))) - (format out "~a ~a\n" i mem) + (format out-graph "~a ~a\n" time mem) (if stack (begin (format stacks-out "~15a - delta-mem: ~15a - ~a \n" i @@ -125,9 +128,5 @@ trace)) - - - - -- 2.39.2