[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

A stab at fixing a bug in Victoria Day PCL

I use "Victoria Day" PCL. It has a bug with certain uses of
EQL-specializers which makes it impossible to compile
clue/intrinsics.lisp. I got a patch for this written by
gregor.pa@xerox.com (26 may 89), which seemed to fix the problem.
However, when I got clue going, I noticed that it took a very long
time (30 cpu seconds) to instantiate contacts (make-contact).

The time was spent in cluei:default-options and in
initialize-instance. When a generic function first is created it has a
function definition that will "compile" itself and then call the
result (notice-methods-change et al). When something a generic
function depends on is redefined the generic function is
"invalidated", which means resetting its function-definition to the
initial one. However, in certain cases (like the above mentioned) this
process also meant doing initialization of other classes, which caused
the invalidation of the originating generic function. This had the
effect that it had to "compile" itself every time it was called.

The fix I tried was for notice-methods-change to do nothing if the
generic function is being initialized (member of the list
*invalid-generic-functions-on-stack*). This seemed to work, contacts
now take a very long time to instantiate only the first time, and I
haven't noticed any bad side-effects yet. What do the pcl-gurus say
about this?

Here follows notice-methods-change from Gregors patch (this is *not*
the complete patch by Gregor) with my fix added (marked with *'s) and
a lot of comments deleted.

;from file methods.lisp
(defun notice-methods-change (generic-function)
  (let ((old-discriminator-code
	 (generic-function-discriminator-code generic-function)))
    (if *notice-methods-change-force-p*
	(notice-methods-change-1 generic-function)

	(if (not (memq generic-function *invalid-generic-functions-on-stack*)) ; **********

	     #'(lambda (&rest args)
		 (declare (dbg:invisible-frame :clos-internal))
		 (if (memq generic-function *invalid-generic-functions-on-stack*)
		     (if old-discriminator-code
			 (apply old-discriminator-code args)
			 (error "Tried to call an invalid generic function ~
                              that never was valid at all."))
		     (notice-methods-change-2 generic-function args))))))))

Mats Johnson, UDAC, Box 2103, S-750 02 Uppsala, SWEDEN. Phone +46 18-187858
E-mail: matsj@delfi.UDAC.UU.SE