guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. v2.1.0-771-gd20dd74


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. v2.1.0-771-gd20dd74
Date: Fri, 21 Feb 2014 21:26:02 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=d20dd74ecab6d5be216c97d28cb654d4446dfba5

The branch, master has been updated
       via  d20dd74ecab6d5be216c97d28cb654d4446dfba5 (commit)
       via  4d0c358b4cc15977b553940e2bb57f981896afe5 (commit)
       via  4eb1fb9b8a926710a1040e483104dd8abb6f18e4 (commit)
       via  45a7de8268b71b8ce41a2a360c830a825ce06949 (commit)
       via  56bfce7c5d519301a92f75255c839415dc91fda6 (commit)
       via  62fd93e24268c64d8157c18ce3b48e70bc50a129 (commit)
       via  998f8494b73290d1d67f1c92f37e550ff49ba356 (commit)
      from  c65ea594e92ebf6fb30ece92b063501c8abedf72 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit d20dd74ecab6d5be216c97d28cb654d4446dfba5
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 21 22:18:02 2014 +0100

    add a statprof fixme
    
    * module/statprof.scm: Add a fixme.

commit 4d0c358b4cc15977b553940e2bb57f981896afe5
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 21 22:12:47 2014 +0100

    statprof-active? instead of checking profile level
    
    * module/statprof.scm (statprof-reset, statprof-fold-call-data):
      (statprof-proc-call-data, statprof-accumulated-time):
      (statprof-sample-count): Refactor some things to use statprof-active?
      instead of checking the profile level manually.

commit 4eb1fb9b8a926710a1040e483104dd8abb6f18e4
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 21 21:56:01 2014 +0100

    statprof-reset creates a new state
    
    * module/statprof.scm (fresh-profiler-state): New helper.
      (ensure-profiler-state): Use it.
      (accumulate-time): No need to add 0.0 here.
      (statprof-reset): Create a new state instead of mutating the existing
      one.

commit 45a7de8268b71b8ce41a2a360c830a825ce06949
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 21 21:43:39 2014 +0100

    More statprof state refactorings
    
    * module/statprof.scm (existing-profiler-state): New helper, gets the
      profiler state or fails if there is no state.
      (sample-stack-procs, profile-signal-handler, count-call)
      (statprof-fold-call-data, statprof-proc-call-data)
      (statprof-call-data->stats, statprof-display)
      (statprof-display-anomolies, statprof-accumulated-time)
      (statprof-sample-count, statprof-fetch-stacks)
      (statprof-fetch-call-tree): Use the new helper.
      (statprof-active?): Don't create a state if there isn't one already.

commit 56bfce7c5d519301a92f75255c839415dc91fda6
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 21 21:25:50 2014 +0100

    inside-profiler? to parameter instead of global variable
    
    * module/statprof.scm (<state>): Add inside-profiler? member.  Move
      mutations of inside-profiler? here.

commit 62fd93e24268c64d8157c18ce3b48e70bc50a129
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 21 21:01:10 2014 +0100

    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.

commit 998f8494b73290d1d67f1c92f37e550ff49ba356
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 21 19:20:16 2014 +0100

    reform statprof commentary
    
    * module/statprof.scm: Reformat the commentary.

-----------------------------------------------------------------------

Summary of changes:
 module/statprof.scm |  478 +++++++++++++++++++++++++++-----------------------
 1 files changed, 258 insertions(+), 220 deletions(-)

diff --git a/module/statprof.scm b/module/statprof.scm
index 7c3a339..85665f0 100644
--- a/module/statprof.scm
+++ b/module/statprof.scm
@@ -1,7 +1,7 @@
 ;;;; (statprof) -- a statistical profiler for Guile
 ;;;; -*-scheme-*-
 ;;;;
-;;;;   Copyright (C) 2009, 2010, 2011, 2013  Free Software Foundation, Inc.
+;;;;   Copyright (C) 2009, 2010, 2011, 2013, 2014  Free Software Foundation, 
Inc.
 ;;;;    Copyright (C) 2004, 2009 Andy Wingo <wingo at pobox dot com>
 ;;;;    Copyright (C) 2001 Rob Browning <rlb at defaultvalue dot org>
 ;;;; 
@@ -22,109 +22,95 @@
 
 
 ;;; 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}.
-;;
-;;A simple use of statprof would look like this:
-;;
-;;@example
-;;  (statprof-reset 0 50000 #t)
-;;  (statprof-start)
-;;  (do-something)
-;;  (statprof-stop)
-;;  (statprof-display)
-;;@end example
-;;
-;;This would reset statprof, clearing all accumulated statistics, then
-;;start profiling, run some code, stop profiling, and finally display a
-;;gprof flat-style table of statistics which will look something like
-;;this:
-;;
-;;@example
-;;  %   cumulative      self              self    total
-;; time    seconds   seconds    calls  ms/call  ms/call  name
-;; 35.29      0.23      0.23     2002     0.11     0.11  -
-;; 23.53      0.15      0.15     2001     0.08     0.08  positive?
-;; 23.53      0.15      0.15     2000     0.08     0.08  +
-;; 11.76      0.23      0.08     2000     0.04     0.11  do-nothing
-;;  5.88      0.64      0.04     2001     0.02     0.32  loop
-;;  0.00      0.15      0.00        1     0.00   150.59  do-something
-;; ...
-;;@end example
-;;
-;;All of the numerical data with the exception of the calls column is
-;;statistically approximate. In the following column descriptions, and
-;;in all of statprof, "time" refers to execution time (both user and
-;;system), not wall clock time.
-;;
-;;@table @asis
-;;@item % time
-;;The percent of the time spent inside the procedure itself
-;;(not counting children).
-;;@item cumulative seconds
-;;The total number of seconds spent in the procedure, including
-;;children.
-;;@item self seconds
-;;The total number of seconds spent in the procedure itself (not counting
-;;children).
-;;@item calls
-;;The total number of times the procedure was called.
-;;@item self ms/call
-;;The average time taken by the procedure itself on each call, in ms.
-;;@item total ms/call
-;;The average time taken by each call to the procedure, including time
-;;spent in child functions.
-;;@item name
-;;The name of the procedure.
-;;@end table
-;;
-;;The profiler uses @code{eq?} and the procedure object itself to
-;;identify the procedures, so it won't confuse different procedures with
-;;the same name. They will show up as two different rows in the output.
-;;
-;;Right now the profiler is quite simplistic.  I cannot provide
-;;call-graphs or other higher level information.  What you see in the
-;;table is pretty much all there is. Patches are welcome :-)
-;;
-;;@section Implementation notes
-;;
-;;The profiler works by setting the unix profiling signal
-;;@code{ITIMER_PROF} to go off after the interval you define in the call
-;;to @code{statprof-reset}. When the signal fires, a sampling routine is
-;;run which looks at the current procedure that's executing, and then
-;;crawls up the stack, and for each procedure encountered, increments
-;;that procedure's sample count. Note that if a procedure is encountered
-;;multiple times on a given stack, it is only counted once. After the
-;;sampling is complete, the profiler resets profiling timer to fire
-;;again after the appropriate interval.
-;;
-;;Meanwhile, the profiler keeps track, via @code{get-internal-run-time},
-;;how much CPU time (system and user -- which is also what
-;;@code{ITIMER_PROF} tracks), has elapsed while code has been executing
-;;within a statprof-start/stop block.
-;;
-;;The profiler also tries to avoid counting or timing its own code as
-;;much as possible.
-;;
+;;;
+;;; @code{(statprof)} is a statistical profiler for Guile.
+;;;
+;;; A simple use of statprof would look like this:
+;;;
+;;; @example
+;;;   (statprof-reset 0 50000 #t)
+;;;   (statprof-start)
+;;;   (do-something)
+;;;   (statprof-stop)
+;;;   (statprof-display)
+;;; @end example
+;;;
+;;; This would reset statprof, clearing all accumulated statistics, then
+;;; start profiling, run some code, stop profiling, and finally display a
+;;; gprof flat-style table of statistics which will look something like
+;;; this:
+;;;
+;;; @example
+;;;   %   cumulative      self              self    total
+;;;  time    seconds   seconds    calls  ms/call  ms/call  name
+;;;  35.29      0.23      0.23     2002     0.11     0.11  -
+;;;  23.53      0.15      0.15     2001     0.08     0.08  positive?
+;;;  23.53      0.15      0.15     2000     0.08     0.08  +
+;;;  11.76      0.23      0.08     2000     0.04     0.11  do-nothing
+;;;   5.88      0.64      0.04     2001     0.02     0.32  loop
+;;;   0.00      0.15      0.00        1     0.00   150.59  do-something
+;;;  ...
+;;; @end example
+;;;
+;;; All of the numerical data with the exception of the calls column is
+;;; statistically approximate. In the following column descriptions, and
+;;; in all of statprof, "time" refers to execution time (both user and
+;;; system), not wall clock time.
+;;;
+;;; @table @asis
+;;; @item % time
+;;; The percent of the time spent inside the procedure itself
+;;; (not counting children).
+;;; @item cumulative seconds
+;;; The total number of seconds spent in the procedure, including
+;;; children.
+;;; @item self seconds
+;;; The total number of seconds spent in the procedure itself (not counting
+;;; children).
+;;; @item calls
+;;; The total number of times the procedure was called.
+;;; @item self ms/call
+;;; The average time taken by the procedure itself on each call, in ms.
+;;; @item total ms/call
+;;; The average time taken by each call to the procedure, including time
+;;; spent in child functions.
+;;; @item name
+;;; The name of the procedure.
+;;; @end table
+;;;
+;;; The profiler uses @code{eq?} and the procedure object itself to
+;;; identify the procedures, so it won't confuse different procedures with
+;;; the same name. They will show up as two different rows in the output.
+;;;
+;;; Right now the profiler is quite simplistic.  I cannot provide
+;;; call-graphs or other higher level information.  What you see in the
+;;; table is pretty much all there is. Patches are welcome :-)
+;;;
+;;; @section Implementation notes
+;;;
+;;; The profiler works by setting the unix profiling signal
+;;; @code{ITIMER_PROF} to go off after the interval you define in the call
+;;; to @code{statprof-reset}. When the signal fires, a sampling routine is
+;;; run which looks at the current procedure that's executing, and then
+;;; crawls up the stack, and for each procedure encountered, increments
+;;; that procedure's sample count. Note that if a procedure is encountered
+;;; multiple times on a given stack, it is only counted once. After the
+;;; sampling is complete, the profiler resets profiling timer to fire
+;;; again after the appropriate interval.
+;;;
+;;; Meanwhile, the profiler keeps track, via @code{get-internal-run-time},
+;;; how much CPU time (system and user -- which is also what
+;;; @code{ITIMER_PROF} tracks), has elapsed while code has been executing
+;;; within a statprof-start/stop block.
+;;;
+;;; The profiler also tries to avoid counting or timing its own code as
+;;; much as possible.
+;;;
 ;;; Code:
 
-;; When you add new features, please also add tests to ./tests/ if you
-;; have time, and then add the new files to ./run-tests.  Also, if
-;; anyone's bored, there are a lot of existing API bits that don't
-;; have tests yet.
-
-;; TODO
-;;
-;; Check about profiling C functions -- does profiling primitives work?
-;; Also look into stealing code from qprof so we can sample the C stack
-;; Call graphs?
-
 (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)
@@ -173,23 +159,56 @@
 ;;
 ;; 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 inside-profiler?)
+  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!)
+  ;; True if we are inside the profiler.
+  (inside-profiler? inside-profiler? set-inside-profiler?!))
+
+(define profiler-state (make-parameter #f))
+
+(define* (fresh-profiler-state #:key (count-calls? #f)
+                               (sampling-frequency '(0 . 10000))
+                               (full-stacks? #f))
+  (make-state 0.0 #f 0 sampling-frequency #f 0 count-calls? 0.0 #f '()
+              (make-hash-table) #f))
+
+(define (ensure-profiler-state)
+  (or (profiler-state)
+      (let ((state (fresh-profiler-state)))
+        (profiler-state state)
+        state)))
+
+(define (existing-profiler-state)
+  (or (profiler-state)
+      (error "expected there to be a profiler state")))
 
 ;; If you change the call-data data structure, you need to also change
 ;; sample-uncount-frame.
@@ -211,30 +230,38 @@
 (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)
+                            (- 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))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; SIGPROF handler
 
+;; FIXME: Instead of this messing about with hash tables and
+;; frame-procedure, just record the stack of return addresses into a
+;; growable vector, and resolve them to procedures when analyzing
+;; instead of at collection time.
+;;
 (define (sample-stack-procs stack)
   (let ((stacklen (stack-length stack))
-        (hit-count-call? #f))
+        (hit-count-call? #f)
+        (state (existing-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))
@@ -267,14 +294,14 @@
         (loop (frame-previous frame) procs-seen self))))
     hit-count-call?))
 
-(define inside-profiler? #f)
-
 (define (profile-signal-handler sig)
-  (set! inside-profiler? #t)
+  (define state (existing-profiler-state))
+
+  (set-inside-profiler?! state #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
@@ -294,67 +321,71 @@
               ;; 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))
+  (set-inside-profiler?! state #f))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Count total calls.
 
 (define (count-call frame)
-  (if (not inside-profiler?)
+  (define state (existing-profiler-state))
+
+  (if (not (inside-profiler? state))
       (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 (profiler-state))
+  (and state (positive? (profile-level state))))
 
 ;; Do not call this from statprof internal functions -- user only.
 (define (statprof-start)
   "Start the address@hidden"
   ;; 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)))
@@ -364,19 +395,21 @@ than @code{statprof-stop}, @code{#f} otherwise."
   "Stop the address@hidden"
   ;; 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?)
@@ -387,19 +420,15 @@ 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)
-      (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 '())
-  (sigaction SIGPROF profile-signal-handler)
-  #t)
+  (when (statprof-active?)
+    (error "Can't reset profiler while profiler is running."))
+  (let ((state (fresh-profiler-state #:count-calls? count-calls?
+                                     #:sampling-frequency
+                                     (cons sample-seconds sample-microseconds)
+                                     #:full-stacks? full-stacks?)))
+    (profiler-state state)
+    (sigaction SIGPROF profile-signal-handler)
+    #t))
 
 (define (statprof-fold-call-data proc init)
   "Fold @var{proc} over the call-data accumulated by statprof. Cannot be
@@ -408,21 +437,19 @@ 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)
-      (error "Can't call statprof-fold-called while profiler is running."))
-
+  (when (statprof-active?)
+    (error "Can't call statprof-fold-call-data while profiler is running."))
   (hash-fold
    (lambda (key value prior-result)
      (proc value prior-result))
    init
-   procedure-data))
+   (procedure-data (existing-profiler-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)
-      (error "Can't call statprof-fold-called while profiler is running."))
-
+  (when (statprof-active?)
+    (error "Can't call statprof-proc-call-data while profiler is running."))
   (get-call-data proc))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -438,13 +465,15 @@ none is available."
   ;;                 self-secs-per-call
   ;;                 total-secs-per-call)
 
+  (define state (existing-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)
@@ -480,10 +509,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 (existing-profiler-state))
   
   (cond
    ((zero? (statprof-sample-count))
@@ -497,7 +526,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)
@@ -512,7 +541,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  address@hidden"
                      "%  " "cumulative" "self" "" "self" "total" "")
@@ -530,14 +559,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
 address@hidden"
+  (define state (existing-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
@@ -551,15 +582,15 @@ address@hidden"
 
 (define (statprof-accumulated-time)
   "Returns the time accumulated during the last statprof address@hidden"
-  (if (positive? profile-level)
-      (error "Can't get accumulated time while profiler is running."))
-  (/ accumulated-time internal-time-units-per-second))
+  (when (statprof-active?)
+    (error "Can't get accumulated time while profiler is running."))
+  (/ (accumulated-time (existing-profiler-state)) 
internal-time-units-per-second))
 
 (define (statprof-sample-count)
   "Returns the number of samples taken during the last statprof address@hidden"
-  (if (positive? profile-level)
-      (error "Can't get accumulated time while profiler is running."))
-  sample-count)
+  (when (statprof-active?)
+    (error "Can't get sample count while profiler is running."))
+  (sample-count (existing-profiler-state)))
 
 (define statprof-call-data-name call-data-name)
 (define statprof-call-data-calls call-data-call-count)
@@ -572,7 +603,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 (existing-profiler-state))
+  (stacks state))
 
 (define procedure=?
   (lambda (a b)
@@ -625,7 +657,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 (existing-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))
@@ -641,6 +674,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)))
@@ -658,7 +693,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.
@@ -714,22 +749,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))
+
   (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
-     (inside-profiler?)
+     ((inside-profiler? state))
      (else
-      (set! inside-profiler? #t)
+      (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))
@@ -739,31 +776,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))))
+      (set-inside-profiler?! state #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 ()
@@ -778,4 +816,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))))


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]