2 loading performance problems

[kanderso@WILMA.BBN.COM]

;;;-*-Mode: LISP; Package:(PCL Lisp 1000); Base:10; Syntax:Common-lisp -*-
#||
Two problems in 3/17/88 PCL that seem to effect compiling and
loading performance:

PROBLEM 1:

When you define a new class, you go through the following functions:

LOAD-DEFCLASS -> ADD-NAMED-CLASS -> UPDATE-CLASS -> PROPAGATE-CLASS-UPDATE 
-> UPDATE-METHOD-INHERITANCE:

;;; from std-class.lisp
(defmethod update-method-inheritance ((class standard-class) old-cpl new-cpl)
  (unless (eq old-cpl new-cpl)
    (dolist (old old-cpl)
      (unless (member old new-cpl)
	(dolist (old-gf (class-direct-generic-functions old))
	  (invalidate-generic-function old-gf))))
    (dolist (new new-cpl)
      (unless (member new old-cpl)
	(dolist (new-gf (class-direct-generic-functions new))
	  (invalidate-generic-function new-gf))))))

For example, in my case OLD-CPL is NIL and NEW-CPL is

(#<Standard-Class GOAL-WITH-MESSAGE 437355424> #<Standard-Class GOAL 353150335>
 #<Standard-Class BASIC-GOAL 353150330> #<Standard-Class OBJECT 245057152>
 #<Standard-Class T 245057157>)

What UPDATE-METHOD-INHERITANCE does is invalidate all the direct generic
functions of each class on the NEW-CPL, 615 of them.  There are 557
generic functions on (CLASS-NAMED 'T), including many irrelevent setf
methods that have T as their second specializer, and almost all of PCL.
So, as PCL continues to run it finds itself invalid and has to recompute
lots of its generic functions unnecessarily.  This happens over and over.

Do we really need to invalidate all of these methods?

PROBLEM 2:

When definining a method,

LOAD-DEFMETHOD -> LOAD-DEFMETHOD-INTERNAL -> ADD-NAMED-METHOD =
REAL-ADD-NAMED-METHOD -> ADD-METHOD = REAL-ADD-METHOD ->
ADD-METHOD-ON-SPECIALIZER -> SPECIALIZER-METHODS ->
(SETF CLASS-DIRECT-METHODS):

;;; From std-class.lisp
(defmethod-setf class-direct-methods ((class standard-class)) (nv)
  (let ((direct-generic-functions ()))
    (dolist (m nv)
      (pushnew (method-generic-function m)
	       direct-generic-functions :test #'eq))

    (put-slot--class class 'direct-generic-functions direct-generic-functions)
    (put-slot--class class 'direct-methods nv)))

Thus for each method defined, the CLASS-DIRECT-GENERIC-FUNCTIONS of
each specializer is needlessly CONSed up from scratch!

The patch i use simply ignores the direct-generic-functions slot, this
elimiantes about half a megacons when loading one of our applications.

;;;
;;; Patch std-class.lisp
;;; KRA: Eliminate need for class-direct-generic-functions.
(defmethod update-method-inheritance ((class standard-class) old-cpl new-cpl)
  (declare (ignore class))
  (unless (eq old-cpl new-cpl)
    (dolist (old old-cpl)
      (unless (member old new-cpl)
	(dolist (old-gf (class-direct-methods old))
	  (invalidate-generic-function (method-generic-function old-gf)))))
    (dolist (new new-cpl)
      (unless (member new old-cpl)
	(dolist (new-gf (class-direct-methods new))
	  (if (null (method-generic-function new-gf)) 
	      ;; There are occasional methods with null generic-function 
	      ;; slots.  Report if you find one.
	      (print (list 'REPORT-BUG-TO-KEN new-gf))
	      (invalidate-generic-function (method-generic-function new-gf))))))))

;;; For anyone that needs it.
(defmethod class-direct-generic-functions ((class standard-class))
  (map 'list #'method-generic-function (class-direct-methods class)))

;;; This is what i want, but i can't pull it through the metabraid, without
;;; Gregor's help.
#+not-yet
(defmethod-setf class-direct-methods ((class standard-class)) (nv)
  (put-slot--class class 'direct-methods nv))

;;; But this will do for now.
(defun |setf  CLASS-DIRECT-METHODS| (class nv)
  (put-slot--class class 'direct-methods nv))