This is the mail archive of the guile@cygnus.com mailing list for the guile project.
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
>>>>> "Jim" == Jim Blandy <jimb@red-bean.com> writes:
Jim> It might be appropriate for tracing to be controlled by a variable
Jim> which is dynamically bound. So when invoking code you want to
Jim> profile, you bind this variable to #t, telling Guile to profile
Jim> function apps. The evaluator would bind this variable to #f while
Jim> calling the tracing handler, so the handler doesn't get profiled
Jim> itself.
This is pretty much how tracing works already. The trace enter/exit
handlers must explicitly re-enable the trace debug option, since the
stuff that invokes the handlers starts out by turning it off.
Tracing (when tracing *all* apply's) should only restart once back
inside the user code (ie. the stuff we are interested in). Presumably
this can be solved, but I got lost in trying to find an indicator on
when this is the case.
The problem is that the trace handlers are invoked through a throw
from inside the evaluator, which makes it kind of hard to track the
route back into the user code, since every single apply counts after
tracing has been turned back on. The trace handler cannot do the
re-enabling, I think, because the throw handling code does further
work before we are back inside the user part.
The simple solution is to do the tracing through a C function which is
known not to call the evaluator, but my motivation to try to implement
a usefull profile handler in C while trying to reverse engineer the
scheme stack and debug frame formats just wasn't big enough :-)
Below follows what I came up with instead. It still needs some
polishing and a lot more testing, but it seems to work.
Jim> Hmm. Let me ask the obvious: have you turned debugging off? Enabling
Jim> debugging slows down the evaluator by a factor of two.
Ok, this is on my todo list of things to try. However, I am using the
same options and the same code when comparing performance in the two
snapshots. I'll report back if I learn more.
----
[beware of signature at end]
;;; profiler.scm --- a call profiler implementation.
;; This is the beginnings of a simple profiler tool for guile.
;; It uses the trace interface. It traces both execution time and gc
;; stats.
;; In order to profile a function, it muist first be
;; instrumented. This is done by `profile' which takes any number of
;; functions and instruments them. Once this is set up, profiling is
;; started by calling `profile-start'. Do your test and then call
;; `profile-stop' if you want. Call `profile-report' to see the
;; results. You may reset the collected data with `profile-reset'. Use
;; `unprofile' to remove instrumentation from a function.
;; The macro `profile-module' takes a module description (both list
;; form and module values are accepted) and instruments all functions
;; defined in that module.
;; The variable `profile-instrumented' holds a list of functions that
;; has been instrumented.
;; The variable `profile-hits' holds a list of symbols of functions
;; that has been encountered during profiling so far.
;; The variable `profile-trace' determines whether functions should
;; traced as well as profiled. If true, output is printed whenever
;; functions are entered and left.
;; Beware that instrumenting the profile functions probably is a bad
;; idea.
;; Beware also that since this uses the trace facility, tarcing and
;; profiling will not mix well, but see `profile-trace' above.
;; Rough edges wraning:
;; This still needs some polishing and a lot of testing.
;; No attempt has been made to assert the overheads of the profiler
;; itself, so use caution in the interpretation.
;; Bulk-uninstrumentation is somewhat shaky.
;; This code has been inspired by hjstein@bfr.co.il (Harvey J. Stein).
(define-module (profiler))
(use-modules (ice-9 debug))
(export profile-reset profile-start profile-stop
profile-report profile-hits profile-instrumented
profile unprofile profile-module)
;;user options
(define profile-trace #t)
(define profile-data-size 431)
;; internal variables
(define profile-data #f)
(define profile-stack ())
(define profile-hits ())
(define (profile-reset)
(set! profile-data (make-vector profile-data-size ()))
(set! profile-stack ())
(set! profile-hits ()))
(define (profile-dummy) ())
(define (profile-start)
(or (vector? profile-data) (profile-reset))
(trace profile-dummy)
(set! apply-frame-handler profile-enter)
(set! exit-frame-handler profile-exit))
(define (profile-stop)
(debug-disable 'trace))
;;enter and exit has been borrowed from the standard guile trace code.
(define (profile-enter key cont tail)
(if (eq? (stack-id cont) 'repl-stack)
(let ((cep (current-error-port))
(frame (last-stack-frame cont)))
(and profile-trace (display-application frame cep))
(profile-register frame #f)))
(debug-enable 'trace))
(define (profile-exit key cont retval)
(if (eq? (stack-id cont) 'repl-stack)
(let ((cep (current-error-port))
(frame (stack-ref (make-stack #t) 9)))
(if profile-trace (begin (write retval cep) (newline cep)))
(profile-register frame #t)))
(debug-enable 'trace))
;(define debug ())
(define <name> 0)
(define <count> 1)
(define <count-check> 2)
(define <real-time> 3)
(define <gc-bytes> 6)
(define (profile-register frame exit?)
;(set! debug (cons frame debug))
(let* ((real-clock (get-internal-real-time))
(gc-clock (gc-stats))
(clocks (list (cons 'real-time real-clock)
(assq 'gc-time-taken gc-clock)
(assq 'cells-allocated gc-clock)
(assq 'bytes-malloced gc-clock)))
(proc (and (frame-procedure? frame)
(or (procedure-name (frame-procedure frame))
(frame-procedure frame))))
(hit? (memq proc profile-hits))
(record (or (hashq-ref profile-data proc #f)
(hashq-set! profile-data proc
(vector proc
0 ;count
0 ;count check
(cons 0 0) ;real time
(cons 0 0) ;gc time
(cons 0 0) ;cells
(cons 0 0) ;bytes
)))))
(or hit? (set! profile-hits (cons proc profile-hits)))
(if (not exit?)
;;entering a profiled procedure
(begin
(vector-set! record <count> (1+ (vector-ref record <count>)))
(vector-set! record <count-check> (1+ (vector-ref record <count-check>)))
(do ((index <real-time> (1+ index))
(clock clocks (cdr clock)))
((null? clock))
(set-cdr! (vector-ref record index) (cdr (car clock)))))
;;leaving a profiled procedure
(begin
(vector-set! record <count-check> (1- (vector-ref record <count-check>)))
(do ((index <real-time> (1+ index))
(clock clocks (cdr clock)))
((null? clock))
(let ((entry (vector-ref record index)))
(set-car! entry (+ (car entry) (- (cdr (car clock))
(cdr entry))))))))))
(define (profile-report)
(newline)
(newline)
(display "Table is organized as: <name> <call count> <count check> <real time> <gc time> <gc cells> <gc bytes>\n")
(newline)
(newline)
(for-each (lambda (proc)
(let ((record (hashq-ref profile-data proc)))
(if record
(begin
(display (vector-ref record <name>))(display "\t")
(display (vector-ref record <count>))(display "\t")
(display (vector-ref record <count-check>))(display "\t")
(do ((index <real-time> (1+ index)))
((> index <gc-bytes>))
(let ((entry (vector-ref record index)))
(display (car entry))(display "\t")))
(newline)))))
profile-hits))
(define profile-instrumented ())
(define (profile . syms)
(set! profile-instrumented (append profile-instrumented syms))
(apply trace syms)
(debug-disable 'trace))
;;FIXME need to clean up instrumented better than this.
(define (unprofile . syms)
(apply untrace (if (pair? syms)
syms
profile-instrumented))
(or (pair? syms) (set! profile-instrumented ())))
(define-macro (profile-module module)
"Instrument all procedures in MODULE.
Accepts both module values and module list forms."
(let* ((module* (cond ((pair? module) (resolve-module module))
((module? module) module)
(#t (error "This is not a module:" module))))
(symbols (module-map (lambda (x y) x) module*)))
(do ((syms symbols (cdr syms))
(sym (car symbols) (car syms))
(procs ()))
((null? syms) (apply profile procs))
(if (procedure? (module-symbol-binding (current-module) sym))
(set! symbols* (cons sym symbols*))))))
---------------------------+--------------------------------------------------
Christian Lynbech | Telebit Communications A/S
Fax: +45 8628 8186 | Fabrik 11, DK-8260 Viby J
Phone: +45 8628 8177 + 28 | email: chl@tbit.dk --- URL: http://www.telebit.dk
---------------------------+--------------------------------------------------
Hit the philistines three times over the head with the Elisp reference manual.
- petonic@hal.com (Michael A. Petonic)