mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 14:21:10 +02:00
Code Activity

tweaks to statprof

Browse source 
* module/statprof.scm (make-call-data): Change so that call-data holds
  the proc, not its name. Remove set-call-data-name!.
  (get-call-data): Adapt caller.
  (sample-stack-procs): Always sample procedures on the stack, even
  anonymous ones.
  (profile-signal-handler): Fix stack cutting to work with compiled
  statprof.scm.
  (count-call): Always count calls, even to anonymous procedures.
  (statprof-call-data->stats): Use call-data-printable for printing the
  call data.
  (statprof-display-anomolies): Fix a couple longstanding bugs caught by
  compiler warnings.
This commit is contained in:
Andy Wingo 2009-12-20 23:17:05 +01:00
parent 47f3ce525e
commit c165c50d07
1 changed files with 23 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

44
module/statprof.scm
View file

@ -187,16 +187,17 @@
;; If you change the call-data data structure, you need to also change
;; sample-uncount-frame.
(define (make-call-data name call-count cum-sample-count self-sample-count)
(vector (or name (error "internal error (we don't count anonymous procs)"))
call-count cum-sample-count self-sample-count))
(define (call-data-name cd) (vector-ref cd 0))
(define (make-call-data proc call-count cum-sample-count self-sample-count)
(vector proc call-count cum-sample-count self-sample-count))
(define (call-data-proc cd) (vector-ref cd 0))
(define (call-data-name cd) (procedure-name (call-data-proc cd)))
(define (call-data-printable cd)
(or (call-data-name cd)
(with-output-to-string (lambda () (write (call-data-proc cd))))))
(define (call-data-call-count cd) (vector-ref cd 1))
(define (call-data-cum-sample-count cd) (vector-ref cd 2))
(define (call-data-self-sample-count cd) (vector-ref cd 3))
(define (set-call-data-name! cd name)
(vector-set! cd 0 name))
(define (inc-call-data-call-count! cd)
(vector-set! cd 1 (1+ (vector-ref cd 1))))
(define (inc-call-data-cum-sample-count! cd)
@ -210,7 +211,7 @@
(define (get-call-data proc)
(or (hashq-ref procedure-data proc)
(let ((call-data (make-call-data (procedure-name proc) 0 0 0)))
(let ((call-data (make-call-data proc 0 0 0)))
(hashq-set! procedure-data proc call-data)
call-data)))
@ -248,13 +249,11 @@
;; slate.
(set! hit-count-call? #t)
(loop (frame-previous frame) (make-hash-table 13) #f))
((procedure-name proc)
(else
(hashq-set! procs-seen proc #t)
(loop (frame-previous frame)
procs-seen
(or self proc)))
(else
(loop (frame-previous frame) procs-seen self)))))
(or self proc))))))
(else
(loop (frame-previous frame) procs-seen self))))
hit-count-call?))
@ -268,10 +267,14 @@
;; stack cut
(if (positive? profile-level)
(let* ((stop-time (get-internal-run-time))
;; cut down to the signal handler, then we rely on
;; knowledge of guile: it dispatches signal handlers
;; through a thunk, so cut one more procedure
(stack (make-stack #t profile-signal-handler 0 1))
;; cut down to the signal handler. note that this will only
;; work if statprof.scm is compiled; otherwise we get
;; `eval' on the stack instead, because if it's not
;; compiled, profile-signal-handler is a thunk that
;; tail-calls eval. perhaps we should always compile the
;; signal handler instead...
(stack (or (make-stack #t profile-signal-handler)
(pk 'what! (make-stack #t))))
(inside-apply-trap? (sample-stack-procs stack)))
(if (not inside-apply-trap?)
@ -307,9 +310,8 @@
(and=> (frame-procedure (last-stack-frame continuation))
(lambda (proc)
(if (procedure-name proc)
(inc-call-data-call-count!
(get-call-data proc)))))
(inc-call-data-call-count!
(get-call-data proc))))
(set! last-start-time (get-internal-run-time)))))
@ -426,7 +428,7 @@ none is available."
;; self-secs-per-call
;; total-secs-per-call)
(let* ((proc-name (call-data-name call-data))
(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))
@ -523,12 +525,12 @@ statistics.@code{}"
(lambda (data prior-value)
(if (and %count-calls?
(zero? (call-data-call-count data))
(positive? (call-data-sample-count data)))
(positive? (call-data-cum-sample-count data)))
(simple-format #t
"==[~A ~A ~A]\n"
(call-data-name data)
(call-data-call-count data)
(call-data-sample-count data))))
(call-data-cum-sample-count data))))
#f)
(simple-format #t "Total time: ~A\n" (statprof-accumulated-time))
(simple-format #t "Sample count: ~A\n" (statprof-sample-count)))