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] |
Christian Lynbech <lynbech@tbit.dk> writes: > >>>>> "Jim" == Jim Blandy <jimb@red-bean.com> writes: > > Jim> I'd encourage folks to take a stab at this; post your code to the > Jim> list. > > I am working at a simple solution, using Harvey Steins excellent idea > about hooking into the trace facility. I'll post my results when I > have something working, presumably during this weekend. > > My current code will only profile functions that have been explicitly > instrumented (having the trace property set to true), which isn't > perfect but better than nothing (and it will instrument whole modules > in one fell swoop, so it isn't that bad). > > Harvey Stein was asking why only functions with the trace property > would be traced. Having spent some time yesterday on the issue > (substituting experiments for philosophical reasoning) the answer > seems to be that enabling tracing on *every* apply would yield an > infinite loop since the trace handler (and surrounding facilities such > as the repl) would need to do applys also. If this is to work, there > needs to be some mechanism that would allow the code in the evaluator > to decide when to trace the apply and when not to. Ideas are welcome. What I really meant was where in the code is it taken into effect. I wanted to know a little more about what exactly is possible with the tracing facility. BTW, I got my wrapping code working with guile. It's appended below. Using it, I discovered that the sgml output time from extract.scm was almost all in the following function: (define (sgml-markup s) (define proc-regexp (make-regexp "`([^'` \t]*)'")) (define tf-regexp (make-regexp "(#[tf])")) (my-regexp-substitute/global #f tf-regexp (my-regexp-substitute/global #f proc-regexp s `pre "<link linkend=\"" (lambda (m) (sgml-escape-xref (match:substring m 1))) "\"><function>" 1 "</function></link>" `post) `pre "<literal>" 1 "</literal>" `post)) I also found the following startling fact: guile> (with-profiling (sgml sgml-markup sgml-render-start sgml-render-end my-regexp-substitute/global sgml-escape-xref make-regexp) (with-output-to-file "foo" (lambda () (sgml s)))) Function Called Time ------------------- ---------- --------- make-regexp 2564.0 2.130 sgml-escape-xref 20.0 0.070 my-regexp-substitute/global 5128.0 13.770 sgml-render-end 1594.0 0.240 sgml-render-start 1594.0 0.270 sgml-markup 1272.0 25.440 sgml 2866.0 27.190 defines inside of defines are *not* just being evaluated at load time!!!!! I find this truly remarkable! Why is this!?!?!?!? ;;; wrappers.scm - Library for wrapping functions & executing forms. ;;; Useful for implementing tracing & profiling (as is ;;; done here). ;;; Version 0.8 ;;; ;;; Copyright (c) 1995 Harvey J. Stein (hjstein@math.huji.ac.il) ;;; This code is GPLed. For more info ;;; ;;; Usage: ;;; For tracing: ;;; (with-tracing (foo bar baz) (baz 19)) ;;; Executes (baz 19), while tracing entries to & exits from foo, ;;; bar & baz. ;;; ;;; For profiling: ;;; (with-profiling ...) ;;; Same story, but keeps track of execution times and prints ;;; results at end. ;;; ;;; In general: ;;; (with-wrappers wrapper starter ender simlist form) ;;; wrapper should be a function which takes 2 args, a symbol & a ;;; fcn. It should return a fcn. Starter & ender are thunks. ;;; Simlist is a list of symbols. Form is an sexp to evaluate. ;;; Basically, the defn of all symbols s in simlist are replaced with ;;; (wrapper 's s). Then starter is called, form is executed, ;;; ender is called, and the result of form is returned. The ;;; execution of ender is guaranteed by the use of dynamic-wind. ;;; Undoing the damage of wrapper is guaranteed by fluid-let. ;;; Bugs/To do: ;;; -Requires call to clock to be added to Stk - I added it to ;;; posix, even though it's not really posix (but it is ANSI C). ;;; If clock doesn't exist, I use the time from ;;; (get-internal-info). But, this causes lots of extra consing ;;; (and extra time taken up in the profiling). ;;; -How can I wrap symbols defined in children environments? ;;; -Would be nice to add some more statistics to the profiling ;;; (such as # of cells consed, etc). ;;; -Profiling should also figure out how much time of the time ;;; spent in a subroutine is actually spent amongst the children... ;;; -Maybe dynamic-wind should also be used in wrappers - On the one ;;; hand this would enable tracing to track continuation usage, but ;;; on the other hand, it might introduce alot of overhead. (if (not (member "/usr/lib" %load-path)) (set! %load-path (cons "/usr/lib" %load-path))) ; HACK for guile to find slib!!!!!!! (use-modules (ice-9 slib)) (require 'format) (define-macro (with-wrappers wrapper starter ender symlist form) (let ((oldsym (map (lambda (sym) (gensym)) symlist))) `(let ,(map (lambda (old sym) (list old sym)) oldsym symlist) (dynamic-wind (lambda () (,starter) ,@(map (lambda (sym) `(set! ,sym (,wrapper ',sym ,sym))) symlist)) (lambda () ,form) (lambda () ,@(map (lambda (sym old) `(set! ,sym ,old)) symlist oldsym) (,ender)))))) ;;; ----------- Tracing code ------------------ (define-macro (with-tracing simlist form) `(with-wrappers trace:trace-wrap trace:trace-start (lambda () ()) ,simlist ,form)) (define trace:trace-start #f) (define trace:trace-wrap #f) (define trace:start #f) (define trace:end #f) (define trace:header #f) ;;; Trying to be safe in the face of the user wrapping these fcns, but ;;; I didn't quite make it - it didn't seem to work. (let ((set! set!) (lambda lambda) (let let) (apply apply) (format format) (cons cons) (+ +) (1+ 1+) (length length) (>= >=) (*trace-stack* '())) (define (loc-trace:trace-start) (set! *trace-stack* ())) (define (loc-trace:trace-wrap name func) (lambda l (loc-trace:start name l) (let ((res (apply func l))) (loc-trace:end name l res) res))) (define (loc-trace:start name l) (loc-trace:header) (format #t "~s\n" (cons name l)) (set! *trace-stack* (cons name *trace-stack*))) (define (loc-trace:end name l res) (set! *trace-stack* (cdr *trace-stack*)) (loc-trace:header) (format #t "~s = ~s\n" (cons name l) res)) (define (loc-trace:header) (do ((i 0 (1+ i)) (end (length *trace-stack*))) ((>= i end)) (format #t "| "))) (set! trace:trace-start loc-trace:trace-start) (set! trace:trace-wrap loc-trace:trace-wrap) (set! trace:start loc-trace:start) (set! trace:end loc-trace:end) (set! trace:header loc-trace:header )) ;;; ----------- Profiling code ------------------ (define (profile:hash-table-for-each table func) (for-each (lambda (d) (func (car d) (cdr d))) (cdr table))) (define (profile:make-hash-table) (list 'hash-table)) (define (profile:hash-table-put! table key val) (let ((v (assoc key (cdr table)))) (if v (set-cdr! v val) (set-cdr! table (cons (cons key val) (cdr table)))))) (define (profile:clock) (/ (get-internal-run-time) internal-time-units-per-second)) (define-macro (with-profiling simlist form) `(with-wrappers profile:profile-wrap profile:profile-start profile:profile-end ,simlist ,form)) (define *profile-stack* #f) (define *profile-times* #f) (define (profile:profile-start) (set! *profile-stack* ()) (set! *profile-times* (profile:make-hash-table))) (define (formout:make-fmt-fcn s) (lambda (p . args) (apply format p s args))) (define (profile:profile-end) (define funccol (formout:make-fmt-fcn "~20a")) (define calledcol (formout:make-fmt-fcn "~10f")) (define timecol (formout:make-fmt-fcn "~10,3f")) (format #t "Function Called Time\n") (format #t "------------------- ---------- ---------\n") (profile:hash-table-for-each *profile-times* (lambda (func prof-data) (funccol #t (symbol->string func)) (calledcol #t (profile:times-called prof-data)) (timecol #t (profile:elapsed-time prof-data)) (format #t "\n")))) (define (profile:times-called v) (vector-ref v 0)) (define (profile:elapsed-time v) (vector-ref v 1)) (define (profile:profile-wrap name func) (let ((results (make-vector 10 0))) (let ((res ()) (time -1)) (profile:hash-table-put! *profile-times* name results) (lambda l (cond ((< time 0) (set! time (profile:clock)) (set! res (apply func l)) (vector-set! results 1 (+ (vector-ref results 1) (- (profile:clock) time))) (vector-set! results 0 (1+ (vector-ref results 0))) (set! time -1) res) (else (set! res (apply func l)) (vector-set! results 0 (1+ (vector-ref results 0))) res)))))) -- Harvey J. Stein BFM Financial Research hjstein@bfr.co.il