suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

change path collection for profiling to be counts for uniqe paths

Browse Source 
svn: r2373
This commit is contained in:
Matthew Flatt 2006-03-06 13:35:49 +00:00
parent 41b06100e3
commit f2fdc19ee4
2 changed files with 29 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/errortrace/doc.txt
View File

@ -110,11 +110,11 @@ Profiling records:
in turn, provide a source location file and position).
* optionally, information about the procedure call path (i.e., a
stack trace) for every call to the procedure; follecting this
information is expensive. Path information is collected when the
`profile-paths-enabled' boolean parameter is #t; the default is #f,
but setting the parameter to #t immediately affects all procedure
instrumented for profiling information:
stack trace) for every call to the procedure; collecting this
information is relatively expensive. Path information is collected
when the `profile-paths-enabled' boolean parameter is #t; the
default is #f, but setting the parameter to #t immediately affects
all procedure instrumented for profiling information:
> (profile-paths-enabled) - returns #t if profiling collects path
information, #f otherwise
@ -139,8 +139,9 @@ To retrieve all profiling information accumulated so far, call
* the syntax source of the procedure; and
* a list of call paths, recorded while `profile-paths-enabled' is
set to #t. Each call path is a list containing two-element lists;
* a list of unique call paths recorded while `profile-paths-enabled'
is set to #t. Each call path is a pair of a count (the number of
times the path occurred) and a list containing two-element lists;
each two-element list contains the calling procedure's name or
source expression and the calling procedure's source file or #f.

35
collects/errortrace/errortrace-lib.ss
View File

@ -45,10 +45,14 @@
(set-car! v (add1 (car v)))
(when (profile-paths-enabled)
(let ([v (cddddr v)])
(set-car! v (cons (continuation-mark-set->list
(current-continuation-marks)
profile-key)
(car v)))))
(let ([cms
(continuation-mark-set->list
(current-continuation-marks)
profile-key)])
(unless (hash-table? (car v))
(set-car! v (make-hash-table 'equal)))
(hash-table-put! (car v) cms
(add1 (hash-table-get (car v) cms (lambda () 0)))))))
(if (unbox b)
#f
(begin
@ -74,12 +78,14 @@
[expr (cadddr (cdr val))]
[cmss (cadddr (cddr val))])
(list count time name expr
(map (lambda (cms)
(map (lambda (k)
(let ([v (cdr (hash-table-get profile-info k))])
(list (caddr v) (cadddr v))))
cms))
cmss))))))
(if (hash-table? cmss)
(hash-table-map cmss (lambda (ks v)
(cons v
(map (lambda (k)
(let ([v (cdr (hash-table-get profile-info k))])
(list (caddr v) (cadddr v))))
ks))))
null))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Stacktrace instrumenter
@ -247,14 +253,15 @@
(when paths?
(for-each
(lambda (cms)
(unless (null? cms)
(printf " VIA ~e" (caar cms))
(unless (null? (cdr cms))
(printf " ~e VIA ~e" (car cms) (caadr cms))
(for-each
(lambda (cm)
(printf " <- ~e" (car cm)))
(cdr cms))
(cddr cms))
(printf "~n")))
(cadddr (cdr c)))))
(quicksort (cadddr (cdr c))
(lambda (a b) (> (car a) (car b)))))))
counts)
(printf "Total samples: ~a~n" total)))