statprof and gcprof procedures use a fresh statprof state

* module/statprof.scm (statprof, gcprof): Create a fresh statprof
  state.

diff --git a/module/statprof.scm b/module/statprof.scm
index 6cc9857..b432105 100644 (file)
--- a/module/statprof.scm
+++ b/module/statprof.scm
@@ -658,25 +658,24 @@ 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)))
-                      (inexact->exact (* 1e6 (- (/ 1 hz)
-                                                (floor (/ 1 hz)))))
-                      count-calls?
-                      full-stacks?)
-      (statprof-start))
-    (lambda ()
-      (let lp ((i loop))
-        (unless (zero? i)
-          (thunk)
-          (lp (1- i)))))
-    (lambda ()
-      (statprof-stop)
-      (statprof-display)
-      (set-procedure-data! state #f))))
+  (let ((state (fresh-profiler-state)))
+    (parameterize ((profiler-state state))
+      (dynamic-wind
+        (lambda ()
+          (statprof-reset (inexact->exact (floor (/ 1 hz)))
+                          (inexact->exact (* 1e6 (- (/ 1 hz)
+                                                    (floor (/ 1 hz)))))
+                          count-calls?
+                          full-stacks?)
+          (statprof-start))
+        (lambda ()
+          (let lp ((i loop))
+            (unless (zero? i)
+              (thunk)
+              (lp (1- i)))))
+        (lambda ()
+          (statprof-stop)
+          (statprof-display))))))
 
 (define-macro (with-statprof . args)
   "Profiles the expressions in its body.
@@ -732,68 +731,68 @@ 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)
-    (when (positive? (profile-level state))
-      (error "Can't reset profiler while profiler is running."))
-    (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
-     ((inside-profiler? state))
-     (else
-      (set-inside-profiler?! state #t)
-
-      ;; FIXME: should be able to set an outer frame for the stack cut
-      (let ((stop-time (get-internal-run-time))
-            ;; Cut down to gc-callback, and then one before (the
-            ;; after-gc async).  See the note in profile-signal-handler
-            ;; also.
-            (stack (or (make-stack #t gc-callback 0 1)
-                       (pk 'what! (make-stack #t)))))
-        (sample-stack-procs state stack)
-        (accumulate-time state stop-time)
-        (set-last-start-time! state (get-internal-run-time)))
+  (let ((state (fresh-profiler-state)))
+    (parameterize ((profiler-state state))
+
+      (define (reset)
+        (when (positive? (profile-level state))
+          (error "Can't reset profiler while profiler is running."))
+        (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
+         ((inside-profiler? state))
+         (else
+          (set-inside-profiler?! state #t)
+
+          ;; FIXME: should be able to set an outer frame for the stack cut
+          (let ((stop-time (get-internal-run-time))
+                ;; Cut down to gc-callback, and then one before (the
+                ;; after-gc async).  See the note in profile-signal-handler
+                ;; also.
+                (stack (or (make-stack #t gc-callback 0 1)
+                           (pk 'what! (make-stack #t)))))
+            (sample-stack-procs state stack)
+            (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 #f)
-      (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)
-      (set-vm-trace-level! (1+ (vm-trace-level)))
-      #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)))
-
-  (dynamic-wind
-    (lambda ()
-      (reset)
-      (start))
-    (lambda ()
-      (let lp ((i loop))
-        (unless (zero? i)
-          (thunk)
-          (lp (1- i)))))
-    (lambda ()
-      (stop)
-      (statprof-display)
-      (set-procedure-data! state #f))))
+          (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 #f)
+          (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)
+          (set-vm-trace-level! (1+ (vm-trace-level)))
+          #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)))
+
+      (dynamic-wind
+        (lambda ()
+          (reset)
+          (start))
+        (lambda ()
+          (let lp ((i loop))
+            (unless (zero? i)
+              (thunk)
+              (lp (1- i)))))
+        (lambda ()
+          (stop)
+          (statprof-display))))))