mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

statprof: Better tree-format profiles

Browse source 
* module/statprof.scm (statprof-fetch-call-tree): Add #:precise? keyword
  argument, defaulting to false.  Search for cycles after computing
  printable source locations instead of doing so over addresses -- it
  could be that two addresses map to the same source location, and from
  the user's perspective they are then indistinguishable in the
  printout.
This commit is contained in:
Andy Wingo 2016-01-07 16:56:39 +01:00
parent cf2fadf603
commit ee85113f4a
1 changed files with 29 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

48
module/statprof.scm
View file

@ -850,42 +850,52 @@ to @code{statprof-reset}."
'() '()
(detect-cycle items vlist-null))) (detect-cycle items vlist-null)))
(define* (statprof-fetch-call-tree #:optional (state (existing-profiler-state))) (define* (statprof-fetch-call-tree #:optional (state (existing-profiler-state))
#:key precise?)
"Return a call tree for the previous statprof run. "Return a call tree for the previous statprof run.
The return value is a list of nodes, each of which is of the type: The return value is a list of nodes, each of which is of the type:
@code @code
node ::= (@var{proc} @var{count} . @var{nodes}) node ::= (@var{proc} @var{count} . @var{nodes})
@end code" @end code"
(define (callee->printable callee) (define-syntax-rule (define-memoized (fn arg) body)
(define fn
(let ((table (make-hash-table)))
(lambda (arg)
(cond
((hash-get-handle table arg) => cdr)
(else
(let ((res body))
(hash-set! table arg res)
res)))))))
(define-memoized (callee->printable callee)
(cond (cond
((number? callee) ((number? callee)
(let* ((pdi (find-program-debug-info callee)) (let* ((pdi (find-program-debug-info callee))
(name (or (and=> (and pdi (program-debug-info-name pdi)) (name (or (and=> (and pdi (program-debug-info-name pdi))
symbol->string) symbol->string)
(string-append "#x" (number->string callee 16)))) (string-append "#x" (number->string callee 16))))
(loc (and=> (find-source-for-addr callee) source->string))) (loc (and=> (find-source-for-addr
(or (and (not precise?)
(and=> pdi program-debug-info-addr))
callee))
source->string)))
(if loc (if loc
(string-append name " at " loc) (string-append name " at " loc)
name))) name)))
((list? callee)
(string-join (map callee->printable callee) ", "))
(else (else
(with-output-to-string (lambda () (write callee)))))) (with-output-to-string (lambda () (write callee))))))
(define (memoize/1 proc table) (define (munge-stack stack)
(lambda (x) ;; We collect the sample in newest-to-oldest
(cond ;; order. Change to have the oldest first.
((hash-get-handle table x) => cdr) (let ((stack (reverse stack)))
(else (define (cycle->printable item)
(let ((res (proc x))) (if (string? item)
(hash-set! table x res) item
res))))) (string-join (map cycle->printable item) ", ")))
(let ((callee->printable (memoize/1 callee->printable (make-hash-table)))) (map cycle->printable (collect-cycles (map callee->printable stack)))))
(cons #t (lists->trees (map (lambda (callee-list) (let ((stacks (map munge-stack (stack-samples->callee-lists state))))
(map callee->printable (cons #t (lists->trees stacks equal?))))
(collect-cycles (reverse callee-list))))
(stack-samples->callee-lists state))
equal?))))
(define (statprof-display/tree port state) (define (statprof-display/tree port state)
(match (statprof-fetch-call-tree state) (match (statprof-fetch-call-tree state)