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

Beginnings of statprof threadsafety

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2014-02-21 21:01:10 +01:00
parent 998f8494b7
commit 62fd93e242
1 changed files with 154 additions and 107 deletions
Download patch file Download diff file Expand all files Collapse all files

259
module/statprof.scm
View file

@ -23,11 +23,7 @@
;;; Commentary: ;;; Commentary:
;;; ;;;
;;; @code{(statprof)} is intended to be a fairly simple ;;; @code{(statprof)} is a statistical profiler for Guile.
;;; 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}.
;;; ;;;
;;; A simple use of statprof would look like this: ;;; A simple use of statprof would look like this:
;;; ;;;
@ -114,6 +110,7 @@
(define-module (statprof) (define-module (statprof)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:autoload (ice-9 format) (format) #:autoload (ice-9 format) (format)
#:use-module (system vm vm) #:use-module (system vm vm)
#:use-module (system vm frame) #:use-module (system vm frame)
@ -162,23 +159,44 @@
;; ;;
;; Right now, this profiler is not per-thread and is not thread safe. ;; Right now, this profiler is not per-thread and is not thread safe.
(define accumulated-time #f) ; total so far. (define-record-type <state>
(define last-start-time #f) ; start-time when timer is active. (make-state accumulated-time last-start-time sample-count
(define sample-count #f) ; total count of sampler calls. sampling-frequency remaining-prof-time profile-level
(define sampling-frequency #f) ; in (seconds . microseconds) count-calls? gc-time-taken record-full-stacks?
(define remaining-prof-time #f) ; time remaining when prof suspended. stacks procedure-data)
(define profile-level 0) ; for user start/stop nesting. state?
(define %count-calls? #t) ; whether to catch apply-frame. ;; Total time so far.
(define gc-time-taken 0) ; gc time between statprof-start and (accumulated-time accumulated-time set-accumulated-time!)
; statprof-stop. ;; Start-time when timer is active.
(define record-full-stacks? #f) ; if #t, stash away the stacks (last-start-time last-start-time set-last-start-time!)
; for later analysis. ;; Total count of sampler calls.
(define stacks '()) (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!))
;; procedure-data will be a hash where the key is the function object (define profiler-state (make-parameter #f))
;; 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 (ensure-profiler-state)
(define procedure-data #f) (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 ;; If you change the call-data data structure, you need to also change
;; sample-uncount-frame. ;; sample-uncount-frame.
@ -200,17 +218,20 @@
(define (inc-call-data-self-sample-count! cd) (define (inc-call-data-self-sample-count! cd)
(vector-set! cd 3 (1+ (vector-ref cd 3)))) (vector-set! cd 3 (1+ (vector-ref cd 3))))
(define-macro (accumulate-time stop-time) (define (accumulate-time state stop-time)
`(set! accumulated-time (set-accumulated-time! state
(+ accumulated-time 0.0 (- ,stop-time last-start-time)))) (+ (accumulated-time state)
0.0
(- stop-time (last-start-time state)))))
(define (get-call-data proc) (define (get-call-data proc)
(define state (ensure-profiler-state))
(let ((k (cond (let ((k (cond
((program? proc) (program-code proc)) ((program? proc) (program-code proc))
(else 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))) (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)))) call-data))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -218,12 +239,13 @@
(define (sample-stack-procs stack) (define (sample-stack-procs stack)
(let ((stacklen (stack-length stack)) (let ((stacklen (stack-length stack))
(hit-count-call? #f)) (hit-count-call? #f)
(state (ensure-profiler-state)))
(if record-full-stacks? (if (record-full-stacks? state)
(set! stacks (cons stack stacks))) (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. ;; Now accumulate stats for the whole stack.
(let loop ((frame (stack-ref stack 0)) (let loop ((frame (stack-ref stack 0))
(procs-seen (make-hash-table 13)) (procs-seen (make-hash-table 13))
@ -259,11 +281,13 @@
(define inside-profiler? #f) (define inside-profiler? #f)
(define (profile-signal-handler sig) (define (profile-signal-handler sig)
(define state (ensure-profiler-state))
(set! inside-profiler? #t) (set! inside-profiler? #t)
;; FIXME: with-statprof should be able to set an outer frame for the ;; FIXME: with-statprof should be able to set an outer frame for the
;; stack cut ;; stack cut
(if (positive? profile-level) (if (positive? (profile-level state))
(let* ((stop-time (get-internal-run-time)) (let* ((stop-time (get-internal-run-time))
;; cut down to the signal handler. note that this will only ;; cut down to the signal handler. note that this will only
;; work if statprof.scm is compiled; otherwise we get ;; work if statprof.scm is compiled; otherwise we get
@ -283,19 +307,19 @@
;; and eliminate inside-profiler? because it seems to ;; and eliminate inside-profiler? because it seems to
;; confuse guile wrt re-enabling the trap when ;; confuse guile wrt re-enabling the trap when
;; count-call finishes. ;; count-call finishes.
(if %count-calls? (if (count-calls? state)
(set-vm-trace-level! (1- (vm-trace-level)))) (set-vm-trace-level! (1- (vm-trace-level))))
(accumulate-time stop-time))) (accumulate-time state stop-time)))
(setitimer ITIMER_PROF (setitimer ITIMER_PROF
0 0 0 0
(car sampling-frequency) (car (sampling-frequency state))
(cdr sampling-frequency)) (cdr (sampling-frequency state)))
(if (not inside-apply-trap?) (if (not inside-apply-trap?)
(begin (begin
(set! last-start-time (get-internal-run-time)) (set-last-start-time! state (get-internal-run-time))
(if %count-calls? (if (count-calls? state)
(set-vm-trace-level! (1+ (vm-trace-level)))))))) (set-vm-trace-level! (1+ (vm-trace-level))))))))
(set! inside-profiler? #f)) (set! inside-profiler? #f))
@ -304,46 +328,50 @@
;; Count total calls. ;; Count total calls.
(define (count-call frame) (define (count-call frame)
(define state (ensure-profiler-state))
(if (not inside-profiler?) (if (not inside-profiler?)
(begin (begin
(accumulate-time (get-internal-run-time)) (accumulate-time state (get-internal-run-time))
(and=> (frame-procedure frame) (and=> (frame-procedure frame)
(lambda (proc) (lambda (proc)
(inc-call-data-call-count! (inc-call-data-call-count!
(get-call-data proc)))) (get-call-data proc))))
(set! last-start-time (get-internal-run-time))))) (set-last-start-time! state (get-internal-run-time)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (statprof-active?) (define (statprof-active?)
"Returns @code{#t} if @code{statprof-start} has been called more times "Returns @code{#t} if @code{statprof-start} has been called more times
than @code{statprof-stop}, @code{#f} otherwise." 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. ;; Do not call this from statprof internal functions -- user only.
(define (statprof-start) (define (statprof-start)
"Start the profiler.@code{}" "Start the profiler.@code{}"
;; After some head-scratching, I don't *think* I need to mask/unmask ;; After some head-scratching, I don't *think* I need to mask/unmask
;; signals here, but if I'm wrong, please let me know. ;; signals here, but if I'm wrong, please let me know.
(set! profile-level (+ profile-level 1)) (define state (ensure-profiler-state))
(if (= profile-level 1) (set-profile-level! state (+ (profile-level state) 1))
(let* ((rpt remaining-prof-time) (if (= (profile-level state) 1)
(let* ((rpt (remaining-prof-time state))
(use-rpt? (and rpt (use-rpt? (and rpt
(or (positive? (car rpt)) (or (positive? (car rpt))
(positive? (cdr rpt)))))) (positive? (cdr rpt))))))
(set! remaining-prof-time #f) (set-remaining-prof-time! state #f)
(set! last-start-time (get-internal-run-time)) (set-last-start-time! state (get-internal-run-time))
(set! gc-time-taken (set-gc-time-taken! state
(cdr (assq 'gc-time-taken (gc-stats)))) (cdr (assq 'gc-time-taken (gc-stats))))
(if use-rpt? (if use-rpt?
(setitimer ITIMER_PROF 0 0 (car rpt) (cdr rpt)) (setitimer ITIMER_PROF 0 0 (car rpt) (cdr rpt))
(setitimer ITIMER_PROF (setitimer ITIMER_PROF
0 0 0 0
(car sampling-frequency) (car (sampling-frequency state))
(cdr sampling-frequency))) (cdr (sampling-frequency state))))
(if %count-calls? (if (count-calls? state)
(add-hook! (vm-apply-hook) count-call)) (add-hook! (vm-apply-hook) count-call))
(set-vm-trace-level! (1+ (vm-trace-level))) (set-vm-trace-level! (1+ (vm-trace-level)))
#t))) #t)))
@ -353,19 +381,21 @@ than @code{statprof-stop}, @code{#f} otherwise."
"Stop the profiler.@code{}" "Stop the profiler.@code{}"
;; After some head-scratching, I don't *think* I need to mask/unmask ;; After some head-scratching, I don't *think* I need to mask/unmask
;; signals here, but if I'm wrong, please let me know. ;; signals here, but if I'm wrong, please let me know.
(set! profile-level (- profile-level 1)) (define state (ensure-profiler-state))
(if (zero? profile-level) (set-profile-level! state (- (profile-level state) 1))
(if (zero? (profile-level state))
(begin (begin
(set! gc-time-taken (set-gc-time-taken! state
(- (cdr (assq 'gc-time-taken (gc-stats))) gc-time-taken)) (- (cdr (assq 'gc-time-taken (gc-stats)))
(gc-time-taken state)))
(set-vm-trace-level! (1- (vm-trace-level))) (set-vm-trace-level! (1- (vm-trace-level)))
(if %count-calls? (if (count-calls? state)
(remove-hook! (vm-apply-hook) count-call)) (remove-hook! (vm-apply-hook) count-call))
;; I believe that we need to do this before getting the time ;; I believe that we need to do this before getting the time
;; (unless we want to make things even more complicated). ;; (unless we want to make things even more complicated).
(set! remaining-prof-time (setitimer ITIMER_PROF 0 0 0 0)) (set-remaining-prof-time! state (setitimer ITIMER_PROF 0 0 0 0))
(accumulate-time (get-internal-run-time)) (accumulate-time state (get-internal-run-time))
(set! last-start-time #f)))) (set-last-start-time! state #f))))
(define* (statprof-reset sample-seconds sample-microseconds count-calls? (define* (statprof-reset sample-seconds sample-microseconds count-calls?
#:optional full-stacks?) #:optional full-stacks?)
@ -376,17 +406,18 @@ data. If @var{full-stacks?} is true, collect all sampled stacks into a
list for later analysis. list for later analysis.
Enables traps and debugging as necessary." 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.")) (error "Can't reset profiler while profiler is running."))
(set! %count-calls? count-calls?) (set-count-calls?! state count-calls?)
(set! accumulated-time 0) (set-accumulated-time! state 0)
(set! last-start-time #f) (set-last-start-time! state #f)
(set! sample-count 0) (set-sample-count! state 0)
(set! sampling-frequency (cons sample-seconds sample-microseconds)) (set-sampling-frequency! state (cons sample-seconds sample-microseconds))
(set! remaining-prof-time #f) (set-remaining-prof-time! state #f)
(set! procedure-data (make-hash-table 131)) (set-procedure-data! state (make-hash-table 131))
(set! record-full-stacks? full-stacks?) (set-record-full-stacks?! state full-stacks?)
(set! stacks '()) (set-stacks! state '())
(sigaction SIGPROF profile-signal-handler) (sigaction SIGPROF profile-signal-handler)
#t) #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, Note that a given proc-name may appear multiple times, but if it does,
it represents different functions with the same name." 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.")) (error "Can't call statprof-fold-called while profiler is running."))
(hash-fold (hash-fold
(lambda (key value prior-result) (lambda (key value prior-result)
(proc value prior-result)) (proc value prior-result))
init init
procedure-data)) (procedure-data state)))
(define (statprof-proc-call-data proc) (define (statprof-proc-call-data proc)
"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."
(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.")) (error "Can't call statprof-fold-called while profiler is running."))
(get-call-data proc)) (get-call-data proc))
@ -427,13 +461,15 @@ none is available."
;; self-secs-per-call ;; self-secs-per-call
;; total-secs-per-call) ;; total-secs-per-call)
(define state (ensure-profiler-state))
(let* ((proc-name (call-data-printable call-data)) (let* ((proc-name (call-data-printable call-data))
(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))
(secs-per-sample (/ (statprof-accumulated-time) (secs-per-sample (/ (statprof-accumulated-time)
(statprof-sample-count))) (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 (vector proc-name
(* (/ self-samples all-samples) 100.0) (* (/ self-samples all-samples) 100.0)
@ -469,10 +505,10 @@ none is available."
(statprof-stats-cum-secs-in-proc y)) (statprof-stats-cum-secs-in-proc y))
diff)))) diff))))
(define (statprof-display . port) (define* (statprof-display #:optional (port (current-output-port)))
"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."
(if (null? port) (set! port (current-output-port))) (define state (ensure-profiler-state))
(cond (cond
((zero? (statprof-sample-count)) ((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))) (sorted-stats (sort stats-list stats-sorter)))
(define (display-stats-line stats) (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 " (format port "~6,2f ~9,2f ~9,2f ~7d ~8,2f ~8,2f "
(statprof-stats-%-time-in-proc stats) (statprof-stats-%-time-in-proc stats)
(statprof-stats-cum-secs-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) (display (statprof-stats-proc-name stats) port)
(newline port)) (newline port))
(if %count-calls? (if (count-calls? state)
(begin (begin
(format port "~5a ~10a ~7a ~8a ~8a ~8a ~8@a\n" (format port "~5a ~10a ~7a ~8a ~8a ~8a ~8@a\n"
"% " "cumulative" "self" "" "self" "total" "") "% " "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 "Sample count: ~A\n" (statprof-sample-count))
(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)
(/ 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) (define (statprof-display-anomolies)
"A sanity check that attempts to detect anomolies in statprof's "A sanity check that attempts to detect anomolies in statprof's
statistics.@code{}" statistics.@code{}"
(define state (ensure-profiler-state))
(statprof-fold-call-data (statprof-fold-call-data
(lambda (data prior-value) (lambda (data prior-value)
(if (and %count-calls? (if (and (count-calls? state)
(zero? (call-data-call-count data)) (zero? (call-data-call-count data))
(positive? (call-data-cum-sample-count data))) (positive? (call-data-cum-sample-count data)))
(simple-format #t (simple-format #t
@ -540,15 +578,17 @@ statistics.@code{}"
(define (statprof-accumulated-time) (define (statprof-accumulated-time)
"Returns the time accumulated during the last statprof run.@code{}" "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.")) (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) (define (statprof-sample-count)
"Returns the number of samples taken during the last statprof run.@code{}" "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.")) (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-name call-data-name)
(define statprof-call-data-calls call-data-call-count) (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 Note that stacks are only collected if the @var{full-stacks?} argument
to @code{statprof-reset} is true." to @code{statprof-reset} is true."
stacks) (define state (ensure-profiler-state))
(stacks state))
(define procedure=? (define procedure=?
(lambda (a b) (lambda (a b)
@ -614,7 +655,8 @@ 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"
(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) (define* (statprof thunk #:key (loop 1) (hz 100) (count-calls? #f)
(full-stacks? #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 whole call tree, for later analysis. Use @code{statprof-fetch-stacks} or
@code{statprof-fetch-call-tree} to retrieve the last-stored stacks." @code{statprof-fetch-call-tree} to retrieve the last-stored stacks."
(define state (ensure-profiler-state))
(dynamic-wind (dynamic-wind
(lambda () (lambda ()
(statprof-reset (inexact->exact (floor (/ 1 hz))) (statprof-reset (inexact->exact (floor (/ 1 hz)))
@ -647,7 +691,7 @@ whole call tree, for later analysis. Use @code{statprof-fetch-stacks} or
(lambda () (lambda ()
(statprof-stop) (statprof-stop)
(statprof-display) (statprof-display)
(set! procedure-data #f)))) (set-procedure-data! state #f))))
(define-macro (with-statprof . args) (define-macro (with-statprof . args)
"Profiles the expressions in its body. "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 whole call tree, for later analysis. Use @code{statprof-fetch-stacks} or
@code{statprof-fetch-call-tree} to retrieve the last-stored stacks." @code{statprof-fetch-call-tree} to retrieve the last-stored stacks."
(define state (ensure-profiler-state))
(define (reset) (define (reset)
(if (positive? profile-level) (if (positive? (profile-level state))
(error "Can't reset profiler while profiler is running.")) (error "Can't reset profiler while profiler is running."))
(set! accumulated-time 0) (set-accumulated-time! state 0)
(set! last-start-time #f) (set-last-start-time! state #f)
(set! sample-count 0) (set-sample-count! state 0)
(set! %count-calls? #f) (set-count-calls?! state #f)
(set! procedure-data (make-hash-table 131)) (set-procedure-data! state (make-hash-table 131))
(set! record-full-stacks? full-stacks?) (set-record-full-stacks?! state full-stacks?)
(set! stacks '())) (set-stacks! state '()))
(define (gc-callback) (define (gc-callback)
(cond (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) (stack (or (make-stack #t gc-callback 0 1)
(pk 'what! (make-stack #t))))) (pk 'what! (make-stack #t)))))
(sample-stack-procs stack) (sample-stack-procs stack)
(accumulate-time stop-time) (accumulate-time state stop-time)
(set! last-start-time (get-internal-run-time))) (set-last-start-time! state (get-internal-run-time)))
(set! inside-profiler? #f)))) (set! inside-profiler? #f))))
(define (start) (define (start)
(set! profile-level (+ profile-level 1)) (set-profile-level! state (+ (profile-level state) 1))
(if (= profile-level 1) (if (= (profile-level state) 1)
(begin (begin
(set! remaining-prof-time #f) (set-remaining-prof-time! state #f)
(set! last-start-time (get-internal-run-time)) (set-last-start-time! state (get-internal-run-time))
(set! gc-time-taken (cdr (assq 'gc-time-taken (gc-stats)))) (set-gc-time-taken! state (cdr (assq 'gc-time-taken (gc-stats))))
(add-hook! after-gc-hook gc-callback) (add-hook! after-gc-hook gc-callback)
(set-vm-trace-level! (1+ (vm-trace-level))) (set-vm-trace-level! (1+ (vm-trace-level)))
#t))) #t)))
(define (stop) (define (stop)
(set! profile-level (- profile-level 1)) (set-profile-level! state (- (profile-level state) 1))
(if (zero? profile-level) (if (zero? (profile-level state))
(begin (begin
(set! gc-time-taken (set-gc-time-taken! state
(- (cdr (assq 'gc-time-taken (gc-stats))) gc-time-taken)) (- (cdr (assq 'gc-time-taken (gc-stats)))
(gc-time-taken state)))
(remove-hook! after-gc-hook gc-callback) (remove-hook! after-gc-hook gc-callback)
(accumulate-time (get-internal-run-time)) (accumulate-time state (get-internal-run-time))
(set! last-start-time #f)))) (set-last-start-time! state #f))))
(dynamic-wind (dynamic-wind
(lambda () (lambda ()
@ -767,4 +814,4 @@ whole call tree, for later analysis. Use @code{statprof-fetch-stacks} or
(lambda () (lambda ()
(stop) (stop)
(statprof-display) (statprof-display)
(set! procedure-data #f)))) (set-procedure-data! state #f))))