1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00

Better state handling in statprof

* module/statprof.scm (statprof-fold-call-data)
  (statprof-proc-call-data): Add optional state arg.
  (gcprof): Add optional port arg, and pass state arg explicitly.
  (statprof-display-anomalies, statprof-display)
  (statprof-call-data->stats): Pass state explicitly.
This commit is contained in:
Andy Wingo 2014-04-14 16:54:51 +02:00
parent 3b14dd2f27
commit a234ab929c

View file

@ -565,7 +565,8 @@ always collects full stacks.)"
(visit-stacks (1+ pos) (cons (reverse stack) out)))))) (visit-stacks (1+ pos) (cons (reverse stack) out))))))
(else (reverse out)))))) (else (reverse out))))))
(define (statprof-fold-call-data proc init) (define* (statprof-fold-call-data proc init #:optional
(state (existing-profiler-state)))
"Fold @var{proc} over the call-data accumulated by statprof. Cannot be "Fold @var{proc} over the call-data accumulated by statprof. Cannot be
called while statprof is active. @var{proc} should take two arguments, called while statprof is active. @var{proc} should take two arguments,
@code{(@var{call-data} @var{prior-result})}. @code{(@var{call-data} @var{prior-result})}.
@ -578,14 +579,15 @@ it represents different functions with the same name."
(lambda (key value prior-result) (lambda (key value prior-result)
(proc value prior-result)) (proc value prior-result))
init init
(stack-samples->procedure-data (existing-profiler-state)))) (stack-samples->procedure-data state)))
(define (statprof-proc-call-data proc) (define* (statprof-proc-call-data proc #:optional
(state (existing-profiler-state)))
"Returns the call-data associated with @var{proc}, or @code{#f} if "Returns the call-data associated with @var{proc}, or @code{#f} if
none is available." none is available."
(when (statprof-active?) (when (statprof-active?)
(error "Can't call statprof-proc-call-data while profiler is running.")) (error "Can't call statprof-proc-call-data while profiler is running."))
(hashv-ref (stack-samples->procedure-data (existing-profiler-state)) (hashv-ref (stack-samples->procedure-data state)
(cond (cond
((primitive? proc) (procedure-name proc)) ((primitive? proc) (procedure-name proc))
((program? proc) (program-code proc)) ((program? proc) (program-code proc))
@ -616,9 +618,9 @@ none is available."
(proc-source (and=> (call-data-source call-data) source->string)) (proc-source (and=> (call-data-source call-data) source->string))
(self-samples (call-data-self-sample-count call-data)) (self-samples (call-data-self-sample-count call-data))
(cum-samples (call-data-cum-sample-count call-data)) (cum-samples (call-data-cum-sample-count call-data))
(all-samples (statprof-sample-count)) (all-samples (statprof-sample-count state))
(secs-per-sample (/ (statprof-accumulated-time) (secs-per-sample (/ (statprof-accumulated-time state)
(statprof-sample-count))) (statprof-sample-count state)))
(num-calls (and (call-counts state) (num-calls (and (call-counts state)
(statprof-call-data-calls call-data)))) (statprof-call-data-calls call-data))))
@ -657,14 +659,15 @@ none is available."
"Displays a gprof-like summary of the statistics collected. Unless an "Displays a gprof-like summary of the statistics collected. Unless an
optional @var{port} argument is passed, uses the current output port." optional @var{port} argument is passed, uses the current output port."
(cond (cond
((zero? (statprof-sample-count)) ((zero? (statprof-sample-count state))
(format port "No samples recorded.\n")) (format port "No samples recorded.\n"))
(else (else
(let* ((stats-list (statprof-fold-call-data (let* ((stats-list (statprof-fold-call-data
(lambda (data prior-value) (lambda (data prior-value)
(cons (statprof-call-data->stats data) (cons (statprof-call-data->stats data)
prior-value)) prior-value))
'())) '()
state))
(sorted-stats (sort stats-list stats-sorter))) (sorted-stats (sort stats-list stats-sorter)))
(define (display-stats-line stats) (define (display-stats-line stats)
@ -705,9 +708,9 @@ optional @var{port} argument is passed, uses the current output port."
(for-each display-stats-line sorted-stats) (for-each display-stats-line sorted-stats)
(display "---\n" port) (display "---\n" port)
(simple-format #t "Sample count: ~A\n" (statprof-sample-count)) (simple-format #t "Sample count: ~A\n" (statprof-sample-count state))
(simple-format #t "Total time: ~A seconds (~A seconds in GC)\n" (simple-format #t "Total time: ~A seconds (~A seconds in GC)\n"
(statprof-accumulated-time) (statprof-accumulated-time state)
(/ (gc-time-taken state) (/ (gc-time-taken state)
1.0 internal-time-units-per-second)))))) 1.0 internal-time-units-per-second))))))
@ -725,9 +728,10 @@ statistics.@code{}"
(call-data-name data) (call-data-name data)
(call-data-call-count data) (call-data-call-count data)
(call-data-cum-sample-count data)))) (call-data-cum-sample-count data))))
#f) #f
(simple-format #t "Total time: ~A\n" (statprof-accumulated-time)) state)
(simple-format #t "Sample count: ~A\n" (statprof-sample-count))) (simple-format #t "Total time: ~A\n" (statprof-accumulated-time state))
(simple-format #t "Sample count: ~A\n" (statprof-sample-count state)))
(define (statprof-display-anomolies) (define (statprof-display-anomolies)
(issue-deprecation-warning "statprof-display-anomolies is a misspelling. " (issue-deprecation-warning "statprof-display-anomolies is a misspelling. "
@ -884,7 +888,7 @@ default: @code{#f}
#:count-calls? ,(kw-arg-ref #:count-calls? args #f) #:count-calls? ,(kw-arg-ref #:count-calls? args #f)
#:full-stacks? ,(kw-arg-ref #:full-stacks? args #f))) #:full-stacks? ,(kw-arg-ref #:full-stacks? args #f)))
(define* (gcprof thunk #:key (loop 1) full-stacks?) (define* (gcprof thunk #:key (loop 1) full-stacks? (port (current-output-port)))
"Do an allocation profile of the execution of @var{thunk}. "Do an allocation profile of the execution of @var{thunk}.
The stack will be sampled soon after every garbage collection, yielding The stack will be sampled soon after every garbage collection, yielding
@ -930,4 +934,4 @@ times."
(gc-time-taken state))) (gc-time-taken state)))
(accumulate-time state (get-internal-run-time)) (accumulate-time state (get-internal-run-time))
(set-profile-level! state 0) (set-profile-level! state 0)
(statprof-display)))))) (statprof-display port state))))))