Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!sdd.hp.com!zaphod.mps.ohio-state.edu!rpi!uupsi!sunic!kth.se!ugle.unit.no!ugle.unit.no!haltraet
From: haltraet@gondle.idt.unit.no (Hallvard Traetteberg)
Newsgroups: comp.lang.lisp
Subject: Re: monitoring functions
Message-ID: <HALTRAET.91Apr1185806@gondle.idt.unit.no>
Date: 1 Apr 91 16:58:06 GMT
References: <14131@medusa.cs.purdue.edu>
Sender: news@ugle.unit.no
Organization: Norwegian Inst. of Tech., Div. of Computer Syst. and Telematics
Lines: 98
In-Reply-To: yeh@cs.purdue.EDU's message of 1 Apr 91 12:20:33 GMT

In article <14131@medusa.cs.purdue.edu> yeh@cs.purdue.EDU (Wei Jen Yeh) writes:

   Hello,
     Has anyone written a ``wrapping'' function?

   This is what I mean.  (BTW, I use akcl.)
   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:

   (defun monitor_1fun (fname)
     (if (fboundp fname)
	 (if (get fname 'monitored)
	     (progn (format T "function ~A is already being monitored~%" fname)
		    NIL)
	     (progn (si:fset (setq f (gentemp)) (symbol-function fname))
		    (si:putprop fname f 'monitored)
		    (eval `(defun ,fname (&rest args)
			     (start_bench ',fname)
			     (myfuncall ',f args)
			     (end_bench ',fname)))
		    (setq *Monitor_List* (cons fname *Monitor_List*))
		    *Monitor_List*))
	 (progn (format T "function ~A is not bound~%" fname)
		NIL)))

   (defun myfuncall (old_fun args)
     (eval `(funcall (function ,old_fun) ,@args)))

   However, the two defun's (thus two eval's of the args) are causing problems.
   Does anyone see what's wrong with the above routines (and corrections?)?

   It may be an obvious error, but I am too sleepy and the brain is not meeting
   its specs...ZZZZZ

   thanks in advance for any help.
   -- 
   Wei Jen Yeh                      yeh@cs.purdue.edu
				    Department of Computer Science
				    Purdue University
				    West Lafayette, Indiana

You have made one error in myfuncall, it should be defined as:

(defun myfuncall (old_fun args)
  (eval `(funcall (function ,old_fun) ',@args)))
--------------------------------------^---------
Note the extra ' which you have to include since the argument is already
evaluated.

With the above definition of monitor_1fun the value returned by the wrapper
isn't what the wrapped function returned. Maybe you should use prog1 like
this:
          (eval `(defun ,fname (&rest args)
                   (start_bench ',fname)
                   (prog1 (myfuncall ',f args)
        	          (end_bench ',fname))))

I wondered why you had to use eval, maybe I didn't understand what you meant
when you wrote:

   The functions are compiled, so the short-cut of defining lambda-blocks
   won't work.  I wrote up the following pieces of code:

Did you mean that the wrapper-function were supposed to be compiled? Anyway
here's my version of monitor:

(defun halmonitor (fname)
  (if (fboundp fname)
      (if (get fname 'monitored)
          (progn (format T "function ~A is already being monitored~%" fname)
                 NIL)
	  (setf (get fname 'monitored) (symbol-function fname)
		(symbol-function fname)
		#'(lambda (&rest args)
		    (start_bench fname)
		    (prog1
			(apply (get fname 'monitored) args)
		      (end_bench fname)))
		*Monitor_List* (cons fname *Monitor_List*)))
      (progn (format T "function ~A is not bound~%" fname)
             NIL)))

I use setf heavily because it is more portable than using si:-functions. The
old definition of fname is put in the property list. The new definition is a
closure over the variable holding fname so it can be referenced be the
wrapper-function. Also I use apply instead of funcall and return the value of
the monitored function.

To unmonitor 'fname use
   (setf (symbol-function 'fname) (get 'fname 'monitored))

Any comments on the above code, I think it's cleaner and additionally it
should be faster since it doesn't use eval at all.
--

                                       - haltraet (@idt.unit.no)