summaryrefslogtreecommitdiff
path: root/module/statprof.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2014-02-28 10:48:41 +0100
committerAndy Wingo <wingo@pobox.com>2014-02-28 10:48:41 +0100
commita7ede58d01bdd33460c135634aef0dcbd4935688 (patch)
tree66ed35ccb9230a599ebdeb9e5d9bd6eafe444abf /module/statprof.scm
parente68ed8397debf26dcad0b0066239bed6ed9580d4 (diff)
downloadguile-a7ede58d01bdd33460c135634aef0dcbd4935688.tar.gz
Slight gcprof refactor
* module/statprof.scm (gcprof): Refactor a bit.
Diffstat (limited to 'module/statprof.scm')
-rw-r--r--module/statprof.scm37
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))))))