summaryrefslogtreecommitdiff
path: root/module/statprof.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2014-02-21 21:01:10 +0100
committerAndy Wingo <wingo@pobox.com>2014-02-21 21:01:10 +0100
commit62fd93e24268c64d8157c18ce3b48e70bc50a129 (patch)
treedf4b47d28638603c6c77c25adb9f37dcbc84df12 /module/statprof.scm
parent998f8494b73290d1d67f1c92f37e550ff49ba356 (diff)
downloadguile-62fd93e24268c64d8157c18ce3b48e70bc50a129.tar.gz
Beginnings of statprof threadsafety
* module/statprof.scm (<state>, profiler-state, ensure-profiler-state): A mostly-mechanical refactor to encapsulate profiler state in a parameter and a record instead of global variables.
Diffstat (limited to 'module/statprof.scm')
-rw-r--r--module/statprof.scm263
1 files changed, 155 insertions, 108 deletions
diff --git a/module/statprof.scm b/module/statprof.scm
index 95fcf4aeb..0d47ded87 100644
--- a/module/statprof.scm
+++ b/module/statprof.scm
@@ -23,11 +23,7 @@
;;; Commentary:
;;;
-;;; @code{(statprof)} is intended to be a fairly simple
-;;; statistical profiler for guile. It is in the early stages yet, so
-;;; consider its output still suspect, and please report any bugs to
-;;; @email{guile-devel at gnu.org}, or to me directly at @email{rlb at
-;;; defaultvalue.org}.
+;;; @code{(statprof)} is a statistical profiler for Guile.
;;;
;;; A simple use of statprof would look like this:
;;;
@@ -114,6 +110,7 @@
(define-module (statprof)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
#:autoload (ice-9 format) (format)
#:use-module (system vm vm)
#:use-module (system vm frame)
@@ -162,23 +159,44 @@
;;
;; Right now, this profiler is not per-thread and is not thread safe.
-(define accumulated-time #f) ; total so far.
-(define last-start-time #f) ; start-time when timer is active.
-(define sample-count #f) ; total count of sampler calls.
-(define sampling-frequency #f) ; in (seconds . microseconds)
-(define remaining-prof-time #f) ; time remaining when prof suspended.
-(define profile-level 0) ; for user start/stop nesting.
-(define %count-calls? #t) ; whether to catch apply-frame.
-(define gc-time-taken 0) ; gc time between statprof-start and
- ; statprof-stop.
-(define record-full-stacks? #f) ; if #t, stash away the stacks
- ; for later analysis.
-(define stacks '())
-
-;; procedure-data will be a hash where the key is the function object
-;; itself and the value is the data. The data will be a vector like
-;; this: #(name call-count cum-sample-count self-sample-count)
-(define procedure-data #f)
+(define-record-type <state>
+ (make-state accumulated-time last-start-time sample-count
+ sampling-frequency remaining-prof-time profile-level
+ count-calls? gc-time-taken record-full-stacks?
+ stacks procedure-data)
+ state?
+ ;; Total time so far.
+ (accumulated-time accumulated-time set-accumulated-time!)
+ ;; Start-time when timer is active.
+ (last-start-time last-start-time set-last-start-time!)
+ ;; Total count of sampler calls.
+ (sample-count sample-count set-sample-count!)
+ ;; (seconds . microseconds)
+ (sampling-frequency sampling-frequency set-sampling-frequency!)
+ ;; Time remaining when prof suspended.
+ (remaining-prof-time remaining-prof-time set-remaining-prof-time!)
+ ;; For user start/stop nesting.
+ (profile-level profile-level set-profile-level!)
+ ;; Whether to catch apply-frame.
+ (count-calls? count-calls? set-count-calls?!)
+ ;; GC time between statprof-start and statprof-stop.
+ (gc-time-taken gc-time-taken set-gc-time-taken!)
+ ;; If #t, stash away the stacks for future analysis.
+ (record-full-stacks? record-full-stacks? set-record-full-stacks?!)
+ ;; If record-full-stacks?, the stashed full stacks.
+ (stacks stacks set-stacks!)
+ ;; A hash where the key is the function object itself and the value is
+ ;; the data. The data will be a vector like this:
+ ;; #(name call-count cum-sample-count self-sample-count)
+ (procedure-data procedure-data set-procedure-data!))
+
+(define profiler-state (make-parameter #f))
+
+(define (ensure-profiler-state)
+ (or (profiler-state)
+ (let ((state (make-state #f #f #f #f #f 0 #t 0 #f '() #f)))
+ (profiler-state state)
+ state)))
;; If you change the call-data data structure, you need to also change
;; sample-uncount-frame.
@@ -200,17 +218,20 @@
(define (inc-call-data-self-sample-count! cd)
(vector-set! cd 3 (1+ (vector-ref cd 3))))
-(define-macro (accumulate-time stop-time)
- `(set! accumulated-time
- (+ accumulated-time 0.0 (- ,stop-time last-start-time))))
+(define (accumulate-time state stop-time)
+ (set-accumulated-time! state
+ (+ (accumulated-time state)
+ 0.0
+ (- stop-time (last-start-time state)))))
(define (get-call-data proc)
+ (define state (ensure-profiler-state))
(let ((k (cond
((program? proc) (program-code proc))
(else proc))))
- (or (hashv-ref procedure-data k)
+ (or (hashv-ref (procedure-data state) k)
(let ((call-data (make-call-data proc 0 0 0)))
- (hashv-set! procedure-data k call-data)
+ (hashv-set! (procedure-data state) k call-data)
call-data))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -218,12 +239,13 @@
(define (sample-stack-procs stack)
(let ((stacklen (stack-length stack))
- (hit-count-call? #f))
+ (hit-count-call? #f)
+ (state (ensure-profiler-state)))
- (if record-full-stacks?
- (set! stacks (cons stack stacks)))
+ (if (record-full-stacks? state)
+ (set-stacks! state (cons stack (stacks state))))
- (set! sample-count (+ sample-count 1))
+ (set-sample-count! state (+ (sample-count state) 1))
;; Now accumulate stats for the whole stack.
(let loop ((frame (stack-ref stack 0))
(procs-seen (make-hash-table 13))
@@ -259,11 +281,13 @@
(define inside-profiler? #f)
(define (profile-signal-handler sig)
+ (define state (ensure-profiler-state))
+
(set! inside-profiler? #t)
;; FIXME: with-statprof should be able to set an outer frame for the
;; stack cut
- (if (positive? profile-level)
+ (if (positive? (profile-level state))
(let* ((stop-time (get-internal-run-time))
;; cut down to the signal handler. note that this will only
;; work if statprof.scm is compiled; otherwise we get
@@ -283,19 +307,19 @@
;; and eliminate inside-profiler? because it seems to
;; confuse guile wrt re-enabling the trap when
;; count-call finishes.
- (if %count-calls?
+ (if (count-calls? state)
(set-vm-trace-level! (1- (vm-trace-level))))
- (accumulate-time stop-time)))
+ (accumulate-time state stop-time)))
(setitimer ITIMER_PROF
0 0
- (car sampling-frequency)
- (cdr sampling-frequency))
+ (car (sampling-frequency state))
+ (cdr (sampling-frequency state)))
(if (not inside-apply-trap?)
(begin
- (set! last-start-time (get-internal-run-time))
- (if %count-calls?
+ (set-last-start-time! state (get-internal-run-time))
+ (if (count-calls? state)
(set-vm-trace-level! (1+ (vm-trace-level))))))))
(set! inside-profiler? #f))
@@ -304,46 +328,50 @@
;; Count total calls.
(define (count-call frame)
+ (define state (ensure-profiler-state))
+
(if (not inside-profiler?)
(begin
- (accumulate-time (get-internal-run-time))
+ (accumulate-time state (get-internal-run-time))
(and=> (frame-procedure frame)
(lambda (proc)
(inc-call-data-call-count!
(get-call-data proc))))
- (set! last-start-time (get-internal-run-time)))))
+ (set-last-start-time! state (get-internal-run-time)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (statprof-active?)
"Returns @code{#t} if @code{statprof-start} has been called more times
than @code{statprof-stop}, @code{#f} otherwise."
- (positive? profile-level))
+ (define state (ensure-profiler-state))
+ (positive? (profile-level state)))
;; Do not call this from statprof internal functions -- user only.
(define (statprof-start)
"Start the profiler.@code{}"
;; After some head-scratching, I don't *think* I need to mask/unmask
;; signals here, but if I'm wrong, please let me know.
- (set! profile-level (+ profile-level 1))
- (if (= profile-level 1)
- (let* ((rpt remaining-prof-time)
+ (define state (ensure-profiler-state))
+ (set-profile-level! state (+ (profile-level state) 1))
+ (if (= (profile-level state) 1)
+ (let* ((rpt (remaining-prof-time state))
(use-rpt? (and rpt
(or (positive? (car rpt))
(positive? (cdr rpt))))))
- (set! remaining-prof-time #f)
- (set! last-start-time (get-internal-run-time))
- (set! gc-time-taken
- (cdr (assq 'gc-time-taken (gc-stats))))
+ (set-remaining-prof-time! state #f)
+ (set-last-start-time! state (get-internal-run-time))
+ (set-gc-time-taken! state
+ (cdr (assq 'gc-time-taken (gc-stats))))
(if use-rpt?
(setitimer ITIMER_PROF 0 0 (car rpt) (cdr rpt))
(setitimer ITIMER_PROF
0 0
- (car sampling-frequency)
- (cdr sampling-frequency)))
- (if %count-calls?
+ (car (sampling-frequency state))
+ (cdr (sampling-frequency state))))
+ (if (count-calls? state)
(add-hook! (vm-apply-hook) count-call))
(set-vm-trace-level! (1+ (vm-trace-level)))
#t)))
@@ -353,19 +381,21 @@ than @code{statprof-stop}, @code{#f} otherwise."
"Stop the profiler.@code{}"
;; After some head-scratching, I don't *think* I need to mask/unmask
;; signals here, but if I'm wrong, please let me know.
- (set! profile-level (- profile-level 1))
- (if (zero? profile-level)
+ (define state (ensure-profiler-state))
+ (set-profile-level! state (- (profile-level state) 1))
+ (if (zero? (profile-level state))
(begin
- (set! gc-time-taken
- (- (cdr (assq 'gc-time-taken (gc-stats))) gc-time-taken))
+ (set-gc-time-taken! state
+ (- (cdr (assq 'gc-time-taken (gc-stats)))
+ (gc-time-taken state)))
(set-vm-trace-level! (1- (vm-trace-level)))
- (if %count-calls?
+ (if (count-calls? state)
(remove-hook! (vm-apply-hook) count-call))
;; I believe that we need to do this before getting the time
;; (unless we want to make things even more complicated).
- (set! remaining-prof-time (setitimer ITIMER_PROF 0 0 0 0))
- (accumulate-time (get-internal-run-time))
- (set! last-start-time #f))))
+ (set-remaining-prof-time! state (setitimer ITIMER_PROF 0 0 0 0))
+ (accumulate-time state (get-internal-run-time))
+ (set-last-start-time! state #f))))
(define* (statprof-reset sample-seconds sample-microseconds count-calls?
#:optional full-stacks?)
@@ -376,17 +406,18 @@ data. If @var{full-stacks?} is true, collect all sampled stacks into a
list for later analysis.
Enables traps and debugging as necessary."
- (if (positive? profile-level)
+ (define state (ensure-profiler-state))
+ (if (positive? (profile-level state))
(error "Can't reset profiler while profiler is running."))
- (set! %count-calls? count-calls?)
- (set! accumulated-time 0)
- (set! last-start-time #f)
- (set! sample-count 0)
- (set! sampling-frequency (cons sample-seconds sample-microseconds))
- (set! remaining-prof-time #f)
- (set! procedure-data (make-hash-table 131))
- (set! record-full-stacks? full-stacks?)
- (set! stacks '())
+ (set-count-calls?! state count-calls?)
+ (set-accumulated-time! state 0)
+ (set-last-start-time! state #f)
+ (set-sample-count! state 0)
+ (set-sampling-frequency! state (cons sample-seconds sample-microseconds))
+ (set-remaining-prof-time! state #f)
+ (set-procedure-data! state (make-hash-table 131))
+ (set-record-full-stacks?! state full-stacks?)
+ (set-stacks! state '())
(sigaction SIGPROF profile-signal-handler)
#t)
@@ -397,19 +428,22 @@ called while statprof is active. @var{proc} should take two arguments,
Note that a given proc-name may appear multiple times, but if it does,
it represents different functions with the same name."
- (if (positive? profile-level)
+ (define state (ensure-profiler-state))
+ (if (positive? (profile-level state))
(error "Can't call statprof-fold-called while profiler is running."))
(hash-fold
(lambda (key value prior-result)
(proc value prior-result))
init
- procedure-data))
+ (procedure-data state)))
(define (statprof-proc-call-data proc)
"Returns the call-data associated with @var{proc}, or @code{#f} if
none is available."
- (if (positive? profile-level)
+ (define state (ensure-profiler-state))
+
+ (if (positive? (profile-level state))
(error "Can't call statprof-fold-called while profiler is running."))
(get-call-data proc))
@@ -427,13 +461,15 @@ none is available."
;; self-secs-per-call
;; total-secs-per-call)
+ (define state (ensure-profiler-state))
+
(let* ((proc-name (call-data-printable call-data))
(self-samples (call-data-self-sample-count call-data))
(cum-samples (call-data-cum-sample-count call-data))
(all-samples (statprof-sample-count))
(secs-per-sample (/ (statprof-accumulated-time)
(statprof-sample-count)))
- (num-calls (and %count-calls? (statprof-call-data-calls call-data))))
+ (num-calls (and (count-calls? state) (statprof-call-data-calls call-data))))
(vector proc-name
(* (/ self-samples all-samples) 100.0)
@@ -469,10 +505,10 @@ none is available."
(statprof-stats-cum-secs-in-proc y))
diff))))
-(define (statprof-display . port)
+(define* (statprof-display #:optional (port (current-output-port)))
"Displays a gprof-like summary of the statistics collected. Unless an
optional @var{port} argument is passed, uses the current output port."
- (if (null? port) (set! port (current-output-port)))
+ (define state (ensure-profiler-state))
(cond
((zero? (statprof-sample-count))
@@ -486,7 +522,7 @@ optional @var{port} argument is passed, uses the current output port."
(sorted-stats (sort stats-list stats-sorter)))
(define (display-stats-line stats)
- (if %count-calls?
+ (if (count-calls? state)
(format port "~6,2f ~9,2f ~9,2f ~7d ~8,2f ~8,2f "
(statprof-stats-%-time-in-proc stats)
(statprof-stats-cum-secs-in-proc stats)
@@ -501,7 +537,7 @@ optional @var{port} argument is passed, uses the current output port."
(display (statprof-stats-proc-name stats) port)
(newline port))
- (if %count-calls?
+ (if (count-calls? state)
(begin
(format port "~5a ~10a ~7a ~8a ~8a ~8a ~8@a\n"
"% " "cumulative" "self" "" "self" "total" "")
@@ -519,14 +555,16 @@ optional @var{port} argument is passed, uses the current output port."
(simple-format #t "Sample count: ~A\n" (statprof-sample-count))
(simple-format #t "Total time: ~A seconds (~A seconds in GC)\n"
(statprof-accumulated-time)
- (/ gc-time-taken 1.0 internal-time-units-per-second))))))
+ (/ (gc-time-taken state) 1.0 internal-time-units-per-second))))))
(define (statprof-display-anomolies)
"A sanity check that attempts to detect anomolies in statprof's
statistics.@code{}"
+ (define state (ensure-profiler-state))
+
(statprof-fold-call-data
(lambda (data prior-value)
- (if (and %count-calls?
+ (if (and (count-calls? state)
(zero? (call-data-call-count data))
(positive? (call-data-cum-sample-count data)))
(simple-format #t
@@ -540,15 +578,17 @@ statistics.@code{}"
(define (statprof-accumulated-time)
"Returns the time accumulated during the last statprof run.@code{}"
- (if (positive? profile-level)
+ (define state (ensure-profiler-state))
+ (if (positive? (profile-level state))
(error "Can't get accumulated time while profiler is running."))
- (/ accumulated-time internal-time-units-per-second))
+ (/ (accumulated-time state) internal-time-units-per-second))
(define (statprof-sample-count)
"Returns the number of samples taken during the last statprof run.@code{}"
- (if (positive? profile-level)
+ (define state (ensure-profiler-state))
+ (if (positive? (profile-level state))
(error "Can't get accumulated time while profiler is running."))
- sample-count)
+ (sample-count state))
(define statprof-call-data-name call-data-name)
(define statprof-call-data-calls call-data-call-count)
@@ -561,7 +601,8 @@ to @code{statprof-reset}.
Note that stacks are only collected if the @var{full-stacks?} argument
to @code{statprof-reset} is true."
- stacks)
+ (define state (ensure-profiler-state))
+ (stacks state))
(define procedure=?
(lambda (a b)
@@ -614,7 +655,8 @@ The return value is a list of nodes, each of which is of the type:
@code
node ::= (@var{proc} @var{count} . @var{nodes})
@end code"
- (cons #t (lists->trees (map stack->procedures stacks) procedure=?)))
+ (define state (ensure-profiler-state))
+ (cons #t (lists->trees (map stack->procedures (stacks state)) procedure=?)))
(define* (statprof thunk #:key (loop 1) (hz 100) (count-calls? #f)
(full-stacks? #f))
@@ -630,6 +672,8 @@ If @var{full-stacks?} is true, at each sample, statprof will store away the
whole call tree, for later analysis. Use @code{statprof-fetch-stacks} or
@code{statprof-fetch-call-tree} to retrieve the last-stored stacks."
+ (define state (ensure-profiler-state))
+
(dynamic-wind
(lambda ()
(statprof-reset (inexact->exact (floor (/ 1 hz)))
@@ -647,7 +691,7 @@ whole call tree, for later analysis. Use @code{statprof-fetch-stacks} or
(lambda ()
(statprof-stop)
(statprof-display)
- (set! procedure-data #f))))
+ (set-procedure-data! state #f))))
(define-macro (with-statprof . args)
"Profiles the expressions in its body.
@@ -703,16 +747,18 @@ If @var{full-stacks?} is true, at each sample, statprof will store away the
whole call tree, for later analysis. Use @code{statprof-fetch-stacks} or
@code{statprof-fetch-call-tree} to retrieve the last-stored stacks."
+ (define state (ensure-profiler-state))
+
(define (reset)
- (if (positive? profile-level)
+ (if (positive? (profile-level state))
(error "Can't reset profiler while profiler is running."))
- (set! accumulated-time 0)
- (set! last-start-time #f)
- (set! sample-count 0)
- (set! %count-calls? #f)
- (set! procedure-data (make-hash-table 131))
- (set! record-full-stacks? full-stacks?)
- (set! stacks '()))
+ (set-accumulated-time! state 0)
+ (set-last-start-time! state #f)
+ (set-sample-count! state 0)
+ (set-count-calls?! state #f)
+ (set-procedure-data! state (make-hash-table 131))
+ (set-record-full-stacks?! state full-stacks?)
+ (set-stacks! state '()))
(define (gc-callback)
(cond
@@ -728,31 +774,32 @@ whole call tree, for later analysis. Use @code{statprof-fetch-stacks} or
(stack (or (make-stack #t gc-callback 0 1)
(pk 'what! (make-stack #t)))))
(sample-stack-procs stack)
- (accumulate-time stop-time)
- (set! last-start-time (get-internal-run-time)))
+ (accumulate-time state stop-time)
+ (set-last-start-time! state (get-internal-run-time)))
(set! inside-profiler? #f))))
(define (start)
- (set! profile-level (+ profile-level 1))
- (if (= profile-level 1)
+ (set-profile-level! state (+ (profile-level state) 1))
+ (if (= (profile-level state) 1)
(begin
- (set! remaining-prof-time #f)
- (set! last-start-time (get-internal-run-time))
- (set! gc-time-taken (cdr (assq 'gc-time-taken (gc-stats))))
+ (set-remaining-prof-time! state #f)
+ (set-last-start-time! state (get-internal-run-time))
+ (set-gc-time-taken! state (cdr (assq 'gc-time-taken (gc-stats))))
(add-hook! after-gc-hook gc-callback)
(set-vm-trace-level! (1+ (vm-trace-level)))
#t)))
(define (stop)
- (set! profile-level (- profile-level 1))
- (if (zero? profile-level)
+ (set-profile-level! state (- (profile-level state) 1))
+ (if (zero? (profile-level state))
(begin
- (set! gc-time-taken
- (- (cdr (assq 'gc-time-taken (gc-stats))) gc-time-taken))
+ (set-gc-time-taken! state
+ (- (cdr (assq 'gc-time-taken (gc-stats)))
+ (gc-time-taken state)))
(remove-hook! after-gc-hook gc-callback)
- (accumulate-time (get-internal-run-time))
- (set! last-start-time #f))))
+ (accumulate-time state (get-internal-run-time))
+ (set-last-start-time! state #f))))
(dynamic-wind
(lambda ()
@@ -767,4 +814,4 @@ whole call tree, for later analysis. Use @code{statprof-fetch-stacks} or
(lambda ()
(stop)
(statprof-display)
- (set! procedure-data #f))))
+ (set-procedure-data! state #f))))