Bug in latest PCL when used w/ AKCL + 'fix'

[newton@vlsi.caltech.edu (Mike Newton)]

I believe there is a problem with either get-setf-method or
get-setf-method-multiple-value in the kcl-patches.lsp.  This
shows up when compiling std-class.lsp under AKCL version
1.175.  The below file is a 'minimal' (80 line) test case.
Either compile the whole thing or just load the two
get-setf... defuns and then try to compile the last defun.

Note that this 'bug' is easy to get around if you are running
Akcl 1.175 -- just #|... out ...|# the definitions of 
getf-setf... in the file kcl-patches.lsp and everything compiles
fine.

- mike (No longer in exile in Hilo.)

newton@csvax.caltech.edu	{ucbvax!cithep,amdahl}!cit-vax!newton
Caltech 256-80			818-356-6771 (afternoons,nights)
Pasadena CA 91125		Beach Bums Anonymous, Pasadena President

	Life's a beach.  Then you graduate.

;;; This is PART of the file kcl-patches.lsp from PCL, (c) Xerox....

(in-package 'system)

;;;
;;; setf patches
;;;

(defun get-setf-method (form)
  (multiple-value-bind (vars vals stores store-form access-form)
      (get-setf-method-multiple-value form)
    (unless (listp vars)
	    (error 
 "The temporary variables component, ~s, 
  of the setf-method for ~s is not a list."
             vars form))
    (unless (listp vals)
	    (error 
 "The values forms component, ~s, 
  of the setf-method for ~s is not a list."
             vals form))
    (unless (listp stores)
	    (error 
 "The store variables component, ~s,  
  of the setf-method for ~s is not a list."
             stores form))
    (unless (= (list-length stores) 1)
	    (error "Multiple store-variables are not allowed."))
    (values vars vals stores store-form access-form)))

(defun get-setf-method-multiple-value (form)
  (cond ((symbolp form)
	 (let ((store (gensym)))
	   (values nil nil (list store) `(setq ,form ,store) form)))
	((or (not (consp form)) (not (symbolp (car form))))
	 (error "Cannot get the setf-method of ~S." form))
	((get (car form) 'setf-method)
	 (apply (get (car form) 'setf-method) (cdr form)))
	((get (car form) 'setf-update-fn)
	 (let ((vars (mapcar #'(lambda (x)
	                         (declare (ignore x))
	                         (gensym))
	                     (cdr form)))
	       (store (gensym)))
	   (values vars (cdr form) (list store)
	           `(,(get (car form) 'setf-update-fn)
		     ,@vars ,store)
		   (cons (car form) vars))))
	((get (car form) 'setf-lambda)
	 (let* ((vars (mapcar #'(lambda (x)
	                          (declare (ignore x))
	                          (gensym))
	                      (cdr form)))
		(store (gensym))
		(l (get (car form) 'setf-lambda))
		(f `(lambda ,(car l) 
		      (funcall #'(lambda ,(cadr l) ,@(cddr l))
			       ',store))))
	   (values vars (cdr form) (list store)
		   (apply f vars)
		   (cons (car form) vars))))
	((macro-function (car form))
	 (get-setf-method-multiple-value (macroexpand-1 form)))
	(t
	 (error "Cannot expand the SETF form ~S." form))))

;;; from PCL file std-class.lsp, (c) Xerox....

(defstruct (class-precedence-description (:conc-name nil) (:constructor make-cpd ()))
  (cpd-class  nil)
  (cpd-supers ())
  (cpd-after  ())
  (cpd-count  0))

(defun compute-std-cpl-phase-2 (all-cpds)
  (dolist (cpd all-cpds)
    (let ((supers (cpd-supers cpd)))
      (when supers
	(incf (cpd-count (car supers)) 1)))))