Re: Profiling in Lush
Yury Sulsky <[email protected]>
| Newsgroups | gmane.lisp.lush.devel |
|---|---|
| Message-ID | <[email protected]> |
So just a follow up--I've been using the attached code for a little
while, and it works well for me. Maybe it'll be useful for others?
Here's the usage:
(profile
<regular function or class method definition, compiled or interpreted>
)
(profile-stats <fn-name or '(class-name method-name)>)
or
(profile-stats-all)
? (load "profile")
? (profile
(de aaa ()
(sleep 1))
)
? (profile
(de bbb ()
(aaa))
)
? (bbb)
? (profile-stats-all )
bbb was called 1 times, time alone / total = 0.000999928 / 1 secs (avg.
= 0.000999928 / 1) [0.1%]
aaa was called 1 times, time alone / total = 0.999 / 0.999 secs (avg. =
0.999 / 0.999) [99.9%]
Yury
On Wed, 2005-04-20 at 18:35 -0400, Leon Bottou wrote:
> On Wednesday 20 April 2005 05:40 pm, Yury Sulsky wrote:
> > Hi,
> >
> > Is there any profiling code in Lush? If not, is anybody working on it?
> > I couldn't find any and was planning on writing some, but I figured I
> > should ask first.
>
> Not that I know...
> - L
>
>
> -------------------------------------------------------
> This SF.Net email is sponsored by: New Crystal Reports XI.
> Version 11 adds new functionality designed to reduce time involved in
> creating, integrating, and deploying reporting solutions. Free runtime info,
> new features, or free trial, at: http://www.businessobjects.com/devxi/728
> _______________________________________________
> Lush-devel mailing list
> [email protected]
> https://lists.sourceforge.net/lists/listinfo/lush-devel
profile.lsh
(text/plain, 7.2 KB)
;;; XXX: for some reason, when editing this file, files that use profile
;;; don't get rebuilt automatically
;; this only works if it's set before using profile
(when (null *disable-profiling*)
(setq *disable-profiling* nil))
(de symbcat (&rest parts)
(string->symbol (apply 'concat (map (lambda (part)
(if (symbolp part)
(symbol->string part)
(if (consp part)
(concat (symbol->string (car part))
"--"
(symbol->string (cadr part)))
part)))
parts))))
(de profile-c-var (lisp-name)
(regex-subst "[^a-zA-Z0-9]" "_" (symbol->string lisp-name)))
(de profile-header-footer (fn-name fn-body)
(let ((numcalls-symb (symbcat "profile-" fn-name "-numcalls"))
(ttotal-symb (symbcat "profile-" fn-name "-ttotal"))
(talone-symb (symbcat "profile-" fn-name "-talone"))
(running-symb (symbcat "profile-" fn-name "-running")))
;; to avoid problems with defmethod interp mode, create vars beforehand
(profile-clear-stats fn-name)
`(let ((tstart 0)
(tend 0)
(orig-talone 0) ; talone gets modified when a nested profiled func is called
(final-talone 0))
(ifcompiled
(progn
((-double-) tstart tend)
(cpheader "#include <sys/time.h>")
#{
{
struct timeval tv;
gettimeofday (&tv, NULL);
$tstart = ((double) tv.tv_sec) + ((double) tv.tv_usec) / 1.0e6;
}
#}
(cinline ,(concat "var_get (named (\"" (symbol->string numcalls-symb) "\"))->Number++;"))
(cinline ,(concat "var_get (named (\"" (symbol->string running-symb) "\"))->Number++;"))
(cinline ,(concat "%s = var_get (named (\"" (symbol->string talone-symb) "\"))->Number;")
orig-talone)
(prog1
(progn ,@fn-body)
#{
{
struct timeval tv;
gettimeofday (&tv, NULL);
$tend = ((double) tv.tv_sec) + ((double) tv.tv_usec) / 1.0e6;
}
#}
(cinline ,(concat "var_get (named (\"" (symbol->string running-symb) "\"))->Number--;"))
(cinline ,(concat "var_get (named (\"" (symbol->string ttotal-symb) "\"))->Number += %s - %s;")
tend tstart)
(cinline ,(concat "%s = (var_get (named (\"" (symbol->string talone-symb) "\"))->Number += %s - %s);")
final-talone tend tstart)
#{
{
struct at *fn;
double duration_alone;
duration_alone = $final_talone - $orig_talone;
fn = var_get (named ("profiled-funcs"));
while (fn)
{
struct at *fn_name, *running, *talone;
char var_base[80] = "profile-";
char var_name[80];
fn_name = fn->Car;
if (CONSP (fn_name))
{ // a class method
strcat (var_base, nameof (fn_name->Car));
strcat (var_base, "--");
strcat (var_base, nameof (fn_name->Cdr->Car));
}
else
{
strcat (var_base, nameof (fn_name));
}
strcpy (var_name, var_base);
strcat (var_name, "-running");
running = var_get (named (var_name));
strcpy (var_name, var_base);
strcat (var_name, "-talone");
talone = var_get (named (var_name));
if (running->Number > 0.5)
talone->Number -= duration_alone;
fn = fn->Cdr;
}
}
#}))
(incr ,numcalls-symb)
(incr ,running-symb)
(setq orig-talone ,talone-symb)
(setq tstart (time))
(prog1
(progn ,@fn-body)
(setq tend (time))
(incr ,running-symb -1)
(let* ((duration-total (- tend tstart))
(final-talone (+ ,talone-symb duration-total))
(duration-alone (- final-talone orig-talone))
(fn profiled-funcs))
(incr ,ttotal-symb duration-total)
(setq ,talone-symb final-talone)
(while fn
(let* ((fn-name (car fn))
(running (eval (symbcat "profile-" fn-name "-running")))
(talone-symb (symbcat "profile-" fn-name "-talone"))
(talone (eval talone-symb)))
(when (> running 0.5)
(set talone-symb (- talone duration-alone))))
(setq fn (cdr fn)))))))))
(de profile-stats (fn-name &optional all-total-times)
(let ((numcalls (eval (symbcat "profile-" fn-name "-numcalls")))
(ttotal (eval (symbcat "profile-" fn-name "-ttotal")))
(talone (eval (symbcat "profile-" fn-name "-talone"))))
(if (= 0 numcalls)
(printf "%l has not been called yet.\n" fn-name)
(when (not all-total-times)
(setq all-total-times 0))
(printf "%l was called %d times, time alone / total = %f / %f secs (avg. = %f / %f)%s\n"
fn-name numcalls talone ttotal (/ talone numcalls) (/ ttotal numcalls)
(if (<> 0 all-total-times)
(sprintf " [%f%%]" (/ (* 100 talone) all-total-times))
"")))))
(de profile-clear-stats (fn-name)
(let ((numcalls-symb (symbcat "profile-" fn-name "-numcalls"))
(ttotal-symb (symbcat "profile-" fn-name "-ttotal"))
(talone-symb (symbcat "profile-" fn-name "-talone"))
(running-symb (symbcat "profile-" fn-name "-running")))
;; use (number x) to ensure different variables are created
(set numcalls-symb (number 0))
(set ttotal-symb (number 0))
(set talone-symb (number 0))
(set running-symb (number 0))))
(de profile-stats-all ()
(let ((fn profiled-funcs)
(all-total-times 0))
(while fn
(incr all-total-times (eval (symbcat "profile-" (car fn) "-talone")))
(setq fn (cdr fn)))
(setq fn profiled-funcs)
(while fn
(profile-stats (car fn) all-total-times)
(setq fn (cdr fn)))))
(de profile-clear-stats-all ()
(let ((fn profiled-funcs))
(while fn
(profile-clear-stats (car fn))
(setq fn (cdr fn)))))
(when (not profiled-funcs)
(setq profiled-funcs ()))
(dmd profile (fn)
(when (not *disable-profiling*)
(let ((fn-name (if (<> (car fn) 'defmethod) (cadr fn) (list (cadr fn) (caddr fn))))
(fn-start (if (<> (car fn) 'defmethod) (nthcdr 2 fn) (nthcdr 3 fn))))
(profile-clear-stats fn-name)
(setq profiled-funcs (cons fn-name profiled-funcs))
(rplacd fn-start (list (profile-header-footer fn-name (cdr fn-start))))))
fn)