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

More statprof refactors

* module/statprof.scm (statprof-display, statprof-display-anomalies)
  (statprof-accumulated-time, statprof-sample-count)
  (statprof-fetch-stacks, statprof-fetch-call-tree): Take optional state
  argument.
  (statprof-display-anomolies): Deprecate this mis-spelling.
  (statprof): Just compute usecs for the period.
This commit is contained in:
Andy Wingo 2014-02-28 11:06:55 +01:00
parent a7ede58d01
commit 91db6c4f9c

View file

@ -140,7 +140,8 @@
statprof-stats-cum-secs-per-call statprof-stats-cum-secs-per-call
statprof-display statprof-display
statprof-display-anomolies statprof-display-anomalies
statprof-display-anomolies ; Deprecated spelling.
statprof-fetch-stacks statprof-fetch-stacks
statprof-fetch-call-tree statprof-fetch-call-tree
@ -487,11 +488,10 @@ none is available."
(statprof-stats-cum-secs-in-proc y)) (statprof-stats-cum-secs-in-proc y))
diff)))) diff))))
(define* (statprof-display #:optional (port (current-output-port))) (define* (statprof-display #:optional (port (current-output-port))
(state (existing-profiler-state)))
"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."
(define state (existing-profiler-state))
(cond (cond
((zero? (statprof-sample-count)) ((zero? (statprof-sample-count))
(format port "No samples recorded.\n")) (format port "No samples recorded.\n"))
@ -540,11 +540,10 @@ optional @var{port} argument is passed, uses the current output port."
(/ (gc-time-taken state) (/ (gc-time-taken state)
1.0 internal-time-units-per-second)))))) 1.0 internal-time-units-per-second))))))
(define (statprof-display-anomolies) (define* (statprof-display-anomalies #:optional (state
"A sanity check that attempts to detect anomolies in statprof's (existing-profiler-state)))
"A sanity check that attempts to detect anomalies in statprof's
statistics.@code{}" statistics.@code{}"
(define state (existing-profiler-state))
(statprof-fold-call-data (statprof-fold-call-data
(lambda (data prior-value) (lambda (data prior-value)
(when (and (count-calls? state) (when (and (count-calls? state)
@ -559,30 +558,31 @@ statistics.@code{}"
(simple-format #t "Total time: ~A\n" (statprof-accumulated-time)) (simple-format #t "Total time: ~A\n" (statprof-accumulated-time))
(simple-format #t "Sample count: ~A\n" (statprof-sample-count))) (simple-format #t "Sample count: ~A\n" (statprof-sample-count)))
(define (statprof-accumulated-time) (define (statprof-display-anomolies)
"Returns the time accumulated during the last statprof run.@code{}" (issue-deprecation-warning "statprof-display-anomolies is a misspelling. "
(when (statprof-active?) "Use statprof-display-anomalies instead.")
(error "Can't get accumulated time while profiler is running.")) (statprof-display-anomalies))
(/ (accumulated-time (existing-profiler-state)) 1.0 internal-time-units-per-second))
(define (statprof-sample-count) (define* (statprof-accumulated-time #:optional (state
(existing-profiler-state)))
"Returns the time accumulated during the last statprof run.@code{}"
(/ (accumulated-time state) 1.0 internal-time-units-per-second))
(define* (statprof-sample-count #:optional (state (existing-profiler-state)))
"Returns the number of samples taken during the last statprof run.@code{}" "Returns the number of samples taken during the last statprof run.@code{}"
(when (statprof-active?) (sample-count state))
(error "Can't get sample count while profiler is running."))
(sample-count (existing-profiler-state)))
(define statprof-call-data-name call-data-name) (define statprof-call-data-name call-data-name)
(define statprof-call-data-calls call-data-call-count) (define statprof-call-data-calls call-data-call-count)
(define statprof-call-data-cum-samples call-data-cum-sample-count) (define statprof-call-data-cum-samples call-data-cum-sample-count)
(define statprof-call-data-self-samples call-data-self-sample-count) (define statprof-call-data-self-samples call-data-self-sample-count)
(define (statprof-fetch-stacks) (define* (statprof-fetch-stacks #:optional (state (existing-profiler-state)))
"Returns a list of stacks, as they were captured since the last call "Returns a list of stacks, as they were captured since the last call
to @code{statprof-reset}. to @code{statprof-reset}.
Note that stacks are only collected if the @var{full-stacks?} argument Note that stacks are only collected if the @var{full-stacks?} argument
to @code{statprof-reset} is true." to @code{statprof-reset} is true."
(define state (existing-profiler-state))
(stacks state)) (stacks state))
(define procedure=? (define procedure=?
@ -629,14 +629,13 @@ to @code{statprof-reset} is true."
frame-previous frame-previous
(stack-ref stack 0)))) (stack-ref stack 0))))
(define (statprof-fetch-call-tree) (define* (statprof-fetch-call-tree #:optional (state (existing-profiler-state)))
"Return a call tree for the previous statprof run. "Return a call tree for the previous statprof run.
The return value is a list of nodes, each of which is of the type: The return value is a list of nodes, each of which is of the type:
@code @code
node ::= (@var{proc} @var{count} . @var{nodes}) node ::= (@var{proc} @var{count} . @var{nodes})
@end code" @end code"
(define state (existing-profiler-state))
(cons #t (lists->trees (map stack->procedures (stacks state)) procedure=?))) (cons #t (lists->trees (map stack->procedures (stacks state)) procedure=?)))
(define* (statprof thunk #:key (loop 1) (hz 100) (count-calls? #f) (define* (statprof thunk #:key (loop 1) (hz 100) (count-calls? #f)
@ -657,9 +656,8 @@ whole call tree, for later analysis. Use @code{statprof-fetch-stacks} or
(parameterize ((profiler-state state)) (parameterize ((profiler-state state))
(dynamic-wind (dynamic-wind
(lambda () (lambda ()
(statprof-reset (inexact->exact (floor (/ 1 hz))) (statprof-reset 0
(inexact->exact (* 1e6 (- (/ 1 hz) (inexact->exact (round (/ 1e6 hz)))
(floor (/ 1 hz)))))
count-calls? count-calls?
full-stacks?) full-stacks?)
(statprof-start)) (statprof-start))