statprof-call-data->stats
statprof-stats-proc-name
+ statprof-stats-proc-source
statprof-stats-%-time-in-proc
statprof-stats-cum-secs-in-proc
statprof-stats-self-secs-in-proc
(values))
(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-data?
(name call-data-name)
- (source call-data-source)
(printable call-data-printable)
+ (source call-data-source)
(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!)
(self-sample-count call-data-self-sample-count set-call-data-self-sample-count!))
data))))
(define (addr->printable addr pdi)
- (if pdi
- (program-debug-info-printable pdi)
- (string-append "#x" (number->string addr 16))))
+ (or (and=> (and=> pdi program-debug-info-name) symbol->string)
+ (string-append "anon #x" (number->string addr 16))))
(define (inc-call-data-cum-sample-count! cd)
(set-call-data-cum-sample-count! cd (1+ (call-data-cum-sample-count cd))))
(entry (if pdi (program-debug-info-addr pdi) addr)))
(or (hashv-ref table entry)
(let ((data (make-call-data (and=> pdi program-debug-info-name)
- (find-source-for-addr entry)
(addr->printable entry pdi)
+ (find-source-for-addr entry)
(and call-counts
(hashv-ref call-counts entry))
0
;; a primitive
((symbol? callee) callee)
(else #f))
- #f
(with-output-to-string (lambda () (write callee)))
+ #f
(and call-counts (hashv-ref call-counts callee))
0
0)))
;; 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)
stats?
(proc-name statprof-stats-proc-name)
+ (proc-source statprof-stats-proc-source)
(%-time-in-proc statprof-stats-%-time-in-proc)
(cum-secs-in-proc statprof-stats-cum-secs-in-proc)
(self-secs-in-proc statprof-stats-self-secs-in-proc)
"Returns an object of type @code{statprof-stats}."
(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))
(cum-samples (call-data-cum-sample-count call-data))
(all-samples (statprof-sample-count))
(num-calls (and (call-counts state)
(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)
(* cum-samples secs-per-sample 1.0)
(* self-samples secs-per-sample 1.0)
(* 1000 (statprof-stats-cum-secs-per-call stats)))
(format port " "))
(display " " port))
- (display (statprof-stats-proc-name stats) port)
- (newline port))
+ (let ((source (statprof-stats-proc-source stats))
+ (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)
(begin
(format port "~5a ~10a ~7a ~8a ~8a ~8a ~8@a\n"
"% " "cumulative" "self" "" "self" "total" "")
- (format port "~5a ~9a ~8a ~8a ~8a ~8a ~8@a\n"
- "time" "seconds" "seconds" "calls" "ms/call" "ms/call" "name"))
+ (format port "~5a ~9a ~8a ~8a ~8a ~8a ~a\n"
+ "time" "seconds" "seconds" "calls" "ms/call" "ms/call" "procedure"))
(begin
- (format port "~5a ~10a ~7a ~8@a\n"
+ (format port "~5a ~10a ~7a ~8a\n"
"%" "cumulative" "self" "")
- (format port "~5a ~10a ~7a ~8@a\n"
- "time" "seconds" "seconds" "name")))
+ (format port "~5a ~10a ~7a ~a\n"
+ "time" "seconds" "seconds" "procedure")))
(for-each display-stats-line sorted-stats)