(safe #f "Run safely")
(strict-infinity-checking #f "If yes, crash on encountering Inf/NaN.")
(separate-log-files #f "Output to FILE.log per file.")
- (trace-memory #f "Statistically record Scheme cell usage, and dump to file.")
+ (trace-memory-frequency #f "Record Scheme cell usage this many times per second, and dump to file.")
(ttf-verbosity 0
"how much verbosity for TTF font embedding?")
(show-available-fonts #f
(if separate-logs
(ly:stderr-redirect (format "~a.log" base) "w"))
- (if (ly:get-option 'trace-memory)
- (mtrace:start-trace 50))
+ (if (ly:get-option 'trace-memory-frequency)
+ (mtrace:start-trace (ly:get-option 'trace-memory-frequency)))
(lilypond-file handler x)
(if start-measurements
(dump-profile x start-measurements (profile-measurements)))
- (if (ly:get-option 'trace-memory)
+ (if (ly:get-option 'trace-memory-frequency)
(begin
(mtrace:stop-trace)
(mtrace:dump-results base)))
(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))
(define-public (mtrace:stop-trace)
(set! continue-tracing #f))
-(define-public mtrace:trace-depth 8)
+(define-public mtrace:trace-depth 12)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define trace-count 0)
(define usecond-interval 100000)
+(define (arg-procedure args)
+ (if (and (pair? args)
+ (pair? (cdr args))
+ (pair? (cadr args)))
+ (caadr args) #f))
(define (record-stack key continuation . args)
(if (eq? (current-thread) trace-thread)
(set! trace-points
(cons (list
- (assoc 'total-cells-allocated (gc-stats))
- (cons 'stack (extract-trace continuation)))
+ (assoc 'total-cells-allocated (gc-stats))
+ (cons 'stack (extract-trace continuation))
+ (cons 'proc (arg-procedure args))
+ )
+
trace-points))
(set! busy-tracing #f))))
(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)
- (format out "~a ~a\n" i
- (cdr (assoc 'total-cells-allocated r)))
-
- (if (assoc 'stack r)
- (format stacks-out "~a: ~a\n"
- i
- (cdr (assoc 'stack r))))
-
- (set! i (1+ i)))
+ (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)))