summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2016-02-01 11:27:14 +0100
committerAndy Wingo <wingo@pobox.com>2016-02-01 11:27:14 +0100
commit4066ee31920d52ec0549ce882f883b92992f894b (patch)
treed2530cf74beca8d2b3c4485cbb68b0fd81b84692
parentcd0b61a04e5fa7db62c8795d3bdbee1bc831199a (diff)
downloadguile-4066ee31920d52ec0549ce882f883b92992f894b.tar.gz
Better call-counting profiles in statprof
* module/statprof.scm: Update commentary. (count-call): Don't bother stopping and starting the timer. The overhead of call counting perturbs timing too much already, and somewhat paradoxically stopping and starting the timer takes too much time. (skip-count-call): New function. (stack-samples->procedure-data, stack-samples->callee-lists): If we are counting calls, skip any part of the stack that is inside count-call.
-rw-r--r--module/statprof.scm71
1 files changed, 39 insertions, 32 deletions
diff --git a/module/statprof.scm b/module/statprof.scm
index 7a18bb420..3c7c3f7c9 100644
--- a/module/statprof.scm
+++ b/module/statprof.scm
@@ -35,7 +35,7 @@
;;;
;;; This would run the thunk with statistical profiling, finally
;;; displaying a gprof flat-style table of statistics which could
-;;; something like this:
+;;; look something like this:
;;;
;;; @example
;;; % cumulative self self total
@@ -75,14 +75,6 @@
;;; 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
@@ -374,14 +366,9 @@
(define (count-call frame)
(let ((state (existing-profiler-state)))
(unless (inside-profiler? state)
- (accumulate-time state (get-internal-run-time))
-
- ;; We know local 0 is a SCM value: the c
(let* ((key (frame-instruction-pointer-or-primitive-procedure-name frame))
(handle (hashv-create-handle! (call-counts state) key 0)))
- (set-cdr! handle (1+ (cdr handle))))
-
- (set-last-start-time! state (get-internal-run-time)))))
+ (set-cdr! handle (1+ (cdr handle)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -490,6 +477,26 @@ always collects full stacks.)"
(define (inc-call-data-self-sample-count! cd)
(set-call-data-self-sample-count! cd (1+ (call-data-self-sample-count cd))))
+(define (skip-count-call buffer start len)
+ ;; If we are counting all procedure calls, count-call might be on the
+ ;; stack. If it is, skip that part of the stack.
+ (match (program-address-range count-call)
+ ((lo . hi)
+ (let lp ((pos start))
+ (if (< pos len)
+ (let ((key (vector-ref buffer pos)))
+ (cond
+ ((not key)
+ ;; End of stack; count-call not on the stack.
+ start)
+ ((and (number? key) (<= lo key) (< key hi))
+ ;; Found count-call.
+ (1+ pos))
+ (else
+ ;; Otherwise keep going.
+ (lp (1+ pos)))))
+ start)))))
+
(define (stack-samples->procedure-data state)
(let ((table (make-hash-table))
(addr-cache (make-hash-table))
@@ -536,19 +543,19 @@ always collects full stacks.)"
(let visit-stacks ((pos 0))
(cond
((< pos len)
- ;; FIXME: if we are counting all procedure calls, and
- ;; count-call is on the stack, we need to not count the part
- ;; of the stack that is within count-call.
- (inc-call-data-self-sample-count!
- (callee->call-data (vector-ref buffer pos)))
- (let visit-stack ((pos pos))
- (cond
- ((vector-ref buffer pos)
- => (lambda (callee)
- (inc-call-data-cum-sample-count! (callee->call-data callee))
- (visit-stack (1+ pos))))
- (else
- (visit-stacks (1+ pos))))))
+ (let ((pos (if call-counts
+ (skip-count-call buffer pos len)
+ pos)))
+ (inc-call-data-self-sample-count!
+ (callee->call-data (vector-ref buffer pos)))
+ (let visit-stack ((pos pos))
+ (cond
+ ((vector-ref buffer pos)
+ => (lambda (callee)
+ (inc-call-data-cum-sample-count! (callee->call-data callee))
+ (visit-stack (1+ pos))))
+ (else
+ (visit-stacks (1+ pos)))))))
(else table)))))
(define (stack-samples->callee-lists state)
@@ -557,10 +564,10 @@ always collects full stacks.)"
(let visit-stacks ((pos 0) (out '()))
(cond
((< pos len)
- ;; FIXME: if we are counting all procedure calls, and
- ;; count-call is on the stack, we need to not count the part
- ;; of the stack that is within count-call.
- (let visit-stack ((pos pos) (stack '()))
+ (let visit-stack ((pos (if (call-counts state)
+ (skip-count-call buffer pos len)
+ pos))
+ (stack '()))
(cond
((vector-ref buffer pos)
=> (lambda (callee)