mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

statprof-display prints source locations

Browse source 
* module/statprof.scm (call-data): Source is after printable.
  (addr->printable): Just produce a name, without source.  Anonymous
  printables get "anon " prefixed.
  (stack-samples->procedure-data): Adapt to call-data change.
  (stats): Add "proc-source" element.
  (statprof-call-data->stats): Give a source to the call-data.
  (statprof-display): Print source also.
This commit is contained in:
Andy Wingo 2014-03-01 12:59:58 +01:00
parent e3997e709b
commit ee3f9604dd
1 changed files with 31 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

48
module/statprof.scm
View file

@ -130,6 +130,7 @@
statprof-call-data->stats statprof-call-data->stats
statprof-stats-proc-name statprof-stats-proc-name
statprof-stats-proc-source
statprof-stats-%-time-in-proc statprof-stats-%-time-in-proc
statprof-stats-cum-secs-in-proc statprof-stats-cum-secs-in-proc
statprof-stats-self-secs-in-proc statprof-stats-self-secs-in-proc
@ -371,12 +372,12 @@ always collects full stacks.)"
(values)) (values))
(define-record-type call-data (define-record-type call-data
(make-call-data name source printable (make-call-data name printable source
call-count cum-sample-count self-sample-count) call-count cum-sample-count self-sample-count)
call-data? call-data?
(name call-data-name) (name call-data-name)
(source call-data-source)
(printable call-data-printable) (printable call-data-printable)
(source call-data-source)
(call-count call-data-call-count set-call-data-call-count!) (call-count call-data-call-count set-call-data-call-count!)
(cum-sample-count call-data-cum-sample-count set-call-data-cum-sample-count!) (cum-sample-count call-data-cum-sample-count set-call-data-cum-sample-count!)
(self-sample-count call-data-self-sample-count set-call-data-self-sample-count!)) (self-sample-count call-data-self-sample-count set-call-data-self-sample-count!))
@ -405,9 +406,8 @@ always collects full stacks.)"
data)))) data))))
(define (addr->printable addr pdi) (define (addr->printable addr pdi)
(if pdi (or (and=> (and=> pdi program-debug-info-name) symbol->string)
(program-debug-info-printable pdi) (string-append "anon #x" (number->string addr 16))))
(string-append "#x" (number->string addr 16))))
(define (inc-call-data-cum-sample-count! cd) (define (inc-call-data-cum-sample-count! cd)
(set-call-data-cum-sample-count! cd (1+ (call-data-cum-sample-count cd)))) (set-call-data-cum-sample-count! cd (1+ (call-data-cum-sample-count cd))))
@ -425,8 +425,8 @@ always collects full stacks.)"
(entry (if pdi (program-debug-info-addr pdi) addr))) (entry (if pdi (program-debug-info-addr pdi) addr)))
(or (hashv-ref table entry) (or (hashv-ref table entry)
(let ((data (make-call-data (and=> pdi program-debug-info-name) (let ((data (make-call-data (and=> pdi program-debug-info-name)
(find-source-for-addr entry)
(addr->printable entry pdi) (addr->printable entry pdi)
(find-source-for-addr entry)
(and call-counts (and call-counts
(hashv-ref call-counts entry)) (hashv-ref call-counts entry))
0 0
@ -444,8 +444,8 @@ always collects full stacks.)"
;; a primitive ;; a primitive
((symbol? callee) callee) ((symbol? callee) callee)
(else #f)) (else #f))
#f
(with-output-to-string (lambda () (write callee))) (with-output-to-string (lambda () (write callee)))
#f
(and call-counts (hashv-ref call-counts callee)) (and call-counts (hashv-ref call-counts callee))
0 0
0))) 0)))
@ -523,10 +523,12 @@ none is available."
;; Stats ;; Stats
(define-record-type stats (define-record-type stats
(make-stats proc-name %-time-in-proc cum-secs-in-proc self-secs-in-proc (make-stats proc-name proc-source
%-time-in-proc cum-secs-in-proc self-secs-in-proc
calls self-secs-per-call cum-secs-per-call) calls self-secs-per-call cum-secs-per-call)
stats? stats?
(proc-name statprof-stats-proc-name) (proc-name statprof-stats-proc-name)
(proc-source statprof-stats-proc-source)
(%-time-in-proc statprof-stats-%-time-in-proc) (%-time-in-proc statprof-stats-%-time-in-proc)
(cum-secs-in-proc statprof-stats-cum-secs-in-proc) (cum-secs-in-proc statprof-stats-cum-secs-in-proc)
(self-secs-in-proc statprof-stats-self-secs-in-proc) (self-secs-in-proc statprof-stats-self-secs-in-proc)
@ -538,7 +540,8 @@ none is available."
"Returns an object of type @code{statprof-stats}." "Returns an object of type @code{statprof-stats}."
(define state (existing-profiler-state)) (define state (existing-profiler-state))
(let* ((proc-name (call-data-printable call-data)) (let* ((proc-name (call-data-name call-data))
(proc-source (and=> (call-data-source call-data) source->string))
(self-samples (call-data-self-sample-count call-data)) (self-samples (call-data-self-sample-count call-data))
(cum-samples (call-data-cum-sample-count call-data)) (cum-samples (call-data-cum-sample-count call-data))
(all-samples (statprof-sample-count)) (all-samples (statprof-sample-count))
@ -547,7 +550,11 @@ none is available."
(num-calls (and (call-counts state) (num-calls (and (call-counts state)
(statprof-call-data-calls call-data)))) (statprof-call-data-calls call-data))))
(make-stats proc-name (make-stats (or proc-name
;; If there is no name and no source, fall back to
;; printable.
(and (not proc-source) (call-data-printable call-data)))
proc-source
(* (/ self-samples all-samples) 100.0) (* (/ self-samples all-samples) 100.0)
(* cum-samples secs-per-sample 1.0) (* cum-samples secs-per-sample 1.0)
(* self-samples secs-per-sample 1.0) (* self-samples secs-per-sample 1.0)
@ -601,20 +608,27 @@ optional @var{port} argument is passed, uses the current output port."
(* 1000 (statprof-stats-cum-secs-per-call stats))) (* 1000 (statprof-stats-cum-secs-per-call stats)))
(format port " ")) (format port " "))
(display " " port)) (display " " port))
(display (statprof-stats-proc-name stats) port) (let ((source (statprof-stats-proc-source stats))
(newline port)) (name (statprof-stats-proc-name stats)))
(when source
(display source port)
(when name
(display ":" port)))
(when name
(display name port))
(newline port)))
(if (call-counts state) (if (call-counts state)
(begin (begin
(format port "~5a ~10a ~7a ~8a ~8a ~8a ~8@a\n" (format port "~5a ~10a ~7a ~8a ~8a ~8a ~8@a\n"
"% " "cumulative" "self" "" "self" "total" "") "% " "cumulative" "self" "" "self" "total" "")
(format port "~5a ~9a ~8a ~8a ~8a ~8a ~8@a\n" (format port "~5a ~9a ~8a ~8a ~8a ~8a ~a\n"
"time" "seconds" "seconds" "calls" "ms/call" "ms/call" "name")) "time" "seconds" "seconds" "calls" "ms/call" "ms/call" "procedure"))
(begin (begin
(format port "~5a ~10a ~7a ~8@a\n" (format port "~5a ~10a ~7a ~8a\n"
"%" "cumulative" "self" "") "%" "cumulative" "self" "")
(format port "~5a ~10a ~7a ~8@a\n" (format port "~5a ~10a ~7a ~a\n"
"time" "seconds" "seconds" "name"))) "time" "seconds" "seconds" "procedure")))
(for-each display-stats-line sorted-stats) (for-each display-stats-line sorted-stats)