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:
parent
3b14dd2f27
commit
a234ab929c
1 changed files with 20 additions and 16 deletions
|
@ -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))))))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue