> David Fox writes
> I'm trying to implement simple call counting and profiling for STk. I
> have a hashtable code and a stopwatch class to store the amount of
> time spent in each method, but I can't quite figure out (from staring
> at eval.c) how to tell when a given method is invoked, or to find a
> good name for it to store in the hash table. It gets tricky because
> of the localvar stuff and I'm not sure what else. Erick, could you
> help me out? I just need to know when to call call
> enter_method("name") before entering a method and leave_method("name")
> after leaving it. It slows things down a bit, but its better than
> nothing.
>
> (Once it works I can post the code for this if anyone likes.)
There are two ways to do the job.
I suppose you have
(define-method M ((x <integer>)) (display "integer\n") (next-method))
(define-method M ((x <real>)) (display "real\n"))
First you can patch all the methods associated to a generic function
The list of all methods can be obtained in the slot METHODS of the gf.
(slot-ref M 'methods)
=> (#[<method> 401d7af8] #[<method> 401c9308])
After that you can obtain the closure which implement the methods quite
easily with
(map (lambda (x) (slot-ref x 'procedure))
(slot-ref M 'methods))
=> (#[closure 401d7a20] #[closure 401c9230])
And you can easily wrap these functions to make your profile. Perhaps
you can find intersting things for this wrapping in the the
"wrapper.stk" code of Harvey Stein wich is in the
http://kaolin.unice.fr/Contribs
This is the simpler solution but not the most elegant. In particular,
if you add a new method to the GF it will not be
profiled. Un-profiling is also a little bit painful.
A cleaner solution can be written using the STklos MOP. This is a
little bit harder to understand (particullary if you don't have read
AMOP) and I will not explain it here in detail. The idea consist to
define a subclass of <generic>:
(define-class <profiled-generic> (<generic>) ())
To profile a generic function, just change its class:
(change-class M <profiled-generic>)
Now you have to create a method for APPLY-GENERIC which is called when a
GF is applied. For instance you can do:
(define-method apply-generic ((gf <profiled-generic>) args)
(format #t "before calling ~S\n" gf)
(let ((res (next-method)))
(format #t "after calling ~S\n" gf)
res))
Now you have:
(M 1) ==> before calling #[<profiled-generic> m]
integer
real
after calling #[<profiled-generic> m]
If you want to profile each method one by one you can do (I don't enter in
details here, see the apply-generic given in stklos.stk to see the diffs)
(define-method apply-generic ((gf <profiled-generic>) args)
;; Verify that this function has associated methods
(if (null? (slot-ref gf 'methods))
(no-method gf args))
(let ((applicable (apply find-method gf args)))
(if applicable
(let* ((methods (sort-applicable-methods gf applicable args))
(procs (map (lambda (x) (slot-ref x 'procedure))
methods)))
;; Call the first applicable method
(letrec ((next (lambda (procs args)
(lambda new-args
(let ((a (if (null? new-args) args new-args)))
(if (null? procs)
(no-next-method gf a)
(begin
(format #t "before calling ~S\n"
gf)
(let ((res (apply (car procs)
(next (cdr procs)
a)
a)))
(format #t "after calling ~S\n"
gf)))))))))
(format #t "before calling ~S\n" gf)
(let ((res (apply (car procs) (next (cdr procs) args) args)))
(format #t "after calling ~S\n" gf)
res)))
;; No applicable method
(no-applicable-method gf args))))
This gives
(M 1) => before calling #[<profiled-generic> m]
integer
before calling #[<profiled-generic> m]
real
after calling #[<profiled-generic> m]
after calling #[<profiled-generic> m]
The inconvenients cited before don't exist here.
1. When you add a new method to M, it will be automagically
profiled (if you add it by.
2. Un-profiling is really easy just change the class of M
back to <generic>
The only drawback is that M will be really *slower* since gf protocol
invocation will be completely done in Scheme rather than in C.
-- Erick
Received on Fri Jan 10 1997 - 00:02:12 CET