Newsgroups: comp.lang.lisp
Path: utzoo!utgpu!news-server.csri.toronto.edu!rpi!zaphod.mps.ohio-state.edu!think.com!barmar
From: barmar@think.com (Barry Margolin)
Subject: Re: monitoring functions
Message-ID: <1991Apr1.181743.18493@Think.COM>
Keywords: modify code at runtime
Sender: news@Think.COM
Organization: Thinking Machines Corporation, Cambridge MA, USA
References: <14131@medusa.cs.purdue.edu>
Date: Mon, 1 Apr 91 18:17:43 GMT

In article <14131@medusa.cs.purdue.edu> yeh@cs.purdue.EDU (Wei Jen Yeh) writes:
>  Has anyone written a ``wrapping'' function?

Some Lisps include an "advice" mechanism, which is specifically for
adding temporary wrappers around functions.

>This is what I mean.  (BTW, I use akcl.)

I don't know whether AKCL has advice.  I know Symbolics and Lucid both do,
and I think Franz does.

>I need to selectively monitor the execution times of various functions at
>runtime.  Thus some way of modifying the code at runtime is needed.
>The functions are compiled, so the short-cut of defining lambda-blocks won't
>work.  I wrote up the following pieces of code:

I'm not crazy about your code (always be wary about using EVAL), but it
looks like it should work.  Here's my (untested) version:

(defun monitor_1fun (fname)
  (if (fboundp fname)
      (if (get fname 'monitored)
	  (error "Function ~A is already being monitored." fname)
	  (let ((old-function (symbol-function fname)))
	    (setf (get fname 'monitored) old-function) ; no need to use SI:PUTPROP
	    (setf (symbol-function fname) ;no need for SI:FSET
		  #'(lambda (&rest args)
		      (start_bench fname) ; the beauty of lexical vars!
		      (apply old-function args)	; your MYFUNCALL == APPLY
		      (end_bench fname)))
	    (push fname *monitor_list*)
	    *monitor_list*))
      (error "Function ~A is not defined." fname)))

(defun unmonitor_1fun (fname)
  (let ((old-function (get fname 'monitored)))
    (if old-function
	(progn
	  (setf (symbol-function fname) old-function)
	  (remprop fname 'monitored)
	  (setq *monitor_list* (delete fname *monitor_list*)))
	(error "Function ~A is not being monitored" fname))))

--
Barry Margolin, Thinking Machines Corp.

barmar@think.com
{uunet,harvard}!think!barmar