diff options
author | Andy Wingo <wingo@pobox.com> | 2014-02-28 10:48:41 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-02-28 10:48:41 +0100 |
commit | a7ede58d01bdd33460c135634aef0dcbd4935688 (patch) | |
tree | 66ed35ccb9230a599ebdeb9e5d9bd6eafe444abf | |
parent | e68ed8397debf26dcad0b0066239bed6ed9580d4 (diff) | |
download | guile-a7ede58d01bdd33460c135634aef0dcbd4935688.tar.gz |
Slight gcprof refactor
* module/statprof.scm (gcprof): Refactor a bit.
-rw-r--r-- | module/statprof.scm | 37 |
1 files changed, 12 insertions, 25 deletions
diff --git a/module/statprof.scm b/module/statprof.scm index af41622c2..aa6a2fbb3 100644 --- a/module/statprof.scm +++ b/module/statprof.scm @@ -729,9 +729,7 @@ whole call tree, for later analysis. Use @code{statprof-fetch-stacks} or (let ((state (fresh-profiler-state #:full-stacks? full-stacks?))) (parameterize ((profiler-state state)) (define (gc-callback) - (cond - ((inside-profiler? state)) - (else + (unless (inside-profiler? state) (set-inside-profiler?! state #t) ;; FIXME: should be able to set an outer frame for the stack cut @@ -745,35 +743,24 @@ whole call tree, for later analysis. Use @code{statprof-fetch-stacks} or (accumulate-time state stop-time) (set-last-start-time! state (get-internal-run-time))) - (set-inside-profiler?! state #f)))) - - (define (start) - (set-profile-level! state (+ (profile-level state) 1)) - (when (= (profile-level state) 1) - (set-remaining-prof-time! state 0) - (set-last-start-time! state (get-internal-run-time)) - (set-gc-time-taken! state (assq-ref (gc-stats) 'gc-time-taken)) - (add-hook! after-gc-hook gc-callback) - #t)) - - (define (stop) - (set-profile-level! state (- (profile-level state) 1)) - (when (zero? (profile-level state)) - (set-gc-time-taken! state - (- (assq-ref (gc-stats) 'gc-time-taken) - (gc-time-taken state))) - (remove-hook! after-gc-hook gc-callback) - (accumulate-time state (get-internal-run-time)) - (set-last-start-time! state #f))) + (set-inside-profiler?! state #f))) (dynamic-wind (lambda () - (start)) + (set-profile-level! state 1) + (set-last-start-time! state (get-internal-run-time)) + (set-gc-time-taken! state (assq-ref (gc-stats) 'gc-time-taken)) + (add-hook! after-gc-hook gc-callback)) (lambda () (let lp ((i loop)) (unless (zero? i) (thunk) (lp (1- i))))) (lambda () - (stop) + (remove-hook! after-gc-hook gc-callback) + (set-gc-time-taken! state + (- (assq-ref (gc-stats) 'gc-time-taken) + (gc-time-taken state))) + (accumulate-time state (get-internal-run-time)) + (set-profile-level! state 0) (statprof-display)))))) |