diff --git a/pcl/methods.lisp b/pcl/methods.lisp
index 6f7b7898ad98571317e822f44f4d95b666389168..e8294b6a0998cae9049965391c3c14ab9e55d6c5 100644
--- a/pcl/methods.lisp
+++ b/pcl/methods.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.26 2003/03/26 17:15:21 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.27 2003/04/25 17:43:50 gerd Exp $")
 
 (in-package :pcl)
 
@@ -742,7 +742,48 @@
 			   *standard-method-combination*))
 	      type)))))
 
-(defun get-accessor-method-function (gf type class slotd)  
+;;;
+;;; Called from COMPUTE-DISCRIMINATING-FUNCTION for
+;;; SLOT-VALUE-USING-CLASS, (SETF SLOT-VALUE-USING-CLASS) and
+;;; SLOT-BOUNDP-USING-CLASS.  GF is one of these functions, TYPE is
+;;; one of the symbols READER, WRITER, or BOUNDP.
+;;;
+;;; Note that these gfs have unusual, fixed dispatch functions calling
+;;; effective methods stored in effective slot definitions, which are
+;;; set in COMPUTE-SLOT-ACCESSOR-INFO.
+;;;
+;;; FIXME: It looks to me like *NEW-CLASS* could be deleted, but
+;;; I'm not 100% sure.
+;;; 
+(defun update-slot-value-gf-info (gf type)
+  (unless *new-class*
+    (update-std-or-str-methods gf type))
+  (when (and (standard-svuc-method type)
+	     (structure-svuc-method type))
+    (flet ((update-class (class)
+	     (when (class-finalized-p class)
+	       (dolist (slotd (class-slots class))
+		 (compute-slot-accessor-info slotd type gf)))))
+      (if *new-class*
+	  (update-class *new-class*)
+	  (map-all-classes #'update-class 'slot-object)))))
+
+;;;
+;;; Return two values.  First value is a function to be stored in
+;;; effective slot definition SLOTD for reading it with
+;;; SLOT-VALUE-USING-CLASS, setting it with (SETF
+;;; SLOT-VALUE-USING-CLASS) or testing it with
+;;; SLOT-BOUNDP-USING-CLASS.  GF is one of these generic functions,
+;;; TYPE is one of the symbols READER, WRITER, BOUNDP.  CLASS is
+;;; SLOTD's class.
+;;;
+;;; Second value is true if the function returned is one of the
+;;; optimized standard functions for the purpose, which are used
+;;; when only standard methods are applicable.
+;;;
+;;; FIXME: Change all these wacky function names to something sane.
+;;; 
+(defun get-accessor-method-function (gf type class slotd)
   (let* ((std-method (standard-svuc-method type))
 	 (str-method (structure-svuc-method type))
 	 (types1 `((eql ,class) (class-eq ,class) (eql ,slotd)))
@@ -752,41 +793,63 @@
     (values
      (if std-p
 	 (get-optimized-std-accessor-method-function class slotd type)
-	 (get-accessor-from-svuc-method-function
-	  class slotd
-	  (get-secondary-dispatch-function 
-	   gf methods types
-	   `((,(car (or (member std-method methods)
-			(member str-method methods)
-			(internal-error "In get-accessor-method-function.")))
-	      ,(get-optimized-std-slot-value-using-class-method-function
-		class slotd type)))
-	   (unless (and (eq type 'writer)
-			(dolist (method methods t)
-			  (unless (eq (car (method-specializers method))
-				      *the-class-t*)
-			    (return nil))))
-	     (let ((wrappers (list (wrapper-of class)
-				   (class-wrapper class)
-				   (wrapper-of slotd))))
-	       (if (eq type 'writer)
-		   (cons (class-wrapper *the-class-t*) wrappers)
-		   wrappers))))
-	  type))
+	 (let* ((optimized-std-fn
+		 (get-optimized-std-slot-value-using-class-method-function
+		  class slotd type))
+		(method-alist
+		 `((,(car (or (member std-method methods)
+			      (member str-method methods)
+			      (internal-error "In get-accessor-method-function.")))
+		     ,optimized-std-fn)))
+		(wrappers
+		 ;;
+		 ;; This used to be wrapped in 
+		 ;; 
+		 ;; (unless (and (eq type 'writer)
+		 ;;	      (every (lambda (x)
+		 ;;		      (eq (car (method-specializers x))
+		 ;;			  *the-class-t*))
+		 ;;		    methods))
+		 ;;
+		 ;; but that looks wrong because WRAPPERS nil signals
+		 ;; to GET-SECONDARY-DISPATCH-FUNCTION that we are NOT
+		 ;; generating code for an emf, which is wrong because
+		 ;; we are.
+		 ;;
+		 ;; See the message from Kevin Rosenberg <kevin@rosenberg.net>
+		 ;; to cmucl-imp from Tue, 22 Apr 2003 13:28:23 -0600
+		 ;; and the following thread for a test case where this
+		 ;; causes problems.
+		 ;;
+		 ;; gerd, 2003-04-25
+		 (let ((wrappers (list (wrapper-of class)
+				       (class-wrapper class)
+				       (wrapper-of slotd))))
+		   (if (eq type 'writer)
+		       (cons (class-wrapper *the-class-t*) wrappers)
+		       wrappers)))
+		(sdfun (get-secondary-dispatch-function 
+			gf methods types method-alist wrappers)))
+	   (get-accessor-from-svuc-method-function class slotd sdfun type)))
      std-p)))
 
-;used by optimize-slot-value-by-class-p (vector.lisp)
-(defun update-slot-value-gf-info (gf type)
-  (unless *new-class*
-    (update-std-or-str-methods gf type))
-  (when (and (standard-svuc-method type) (structure-svuc-method type))
-    (flet ((update-class (class)
-	     (when (class-finalized-p class)
-	       (dolist (slotd (class-slots class))
-		 (compute-slot-accessor-info slotd type gf)))))
-      (if *new-class*
-	  (update-class *new-class*)
-	  (map-all-classes #'update-class 'slot-object)))))
+(defun get-accessor-from-svuc-method-function (class slotd sdfun name)
+  (macrolet ((emf-funcall (emf &rest args)
+	       `(invoke-effective-method-function ,emf nil ,@args)))
+    (let ((function
+	   (ecase name
+	     (reader
+	      (lambda (instance)
+		(emf-funcall sdfun class instance slotd)))
+	     (writer
+	      (lambda (nv instance)
+		(emf-funcall sdfun nv class instance slotd)))
+	     (boundp
+	      (lambda (instance)
+		(emf-funcall sdfun class instance slotd))))))
+      (set-function-name function `(,name ,(class-name class)
+					  ,(slot-definition-name slotd)))
+      function)))
 
 (defvar *standard-slot-value-using-class-method* nil)
 (defvar *standard-setf-slot-value-using-class-method* nil)
@@ -1433,21 +1496,12 @@
 
 (defmethod update-gf-dfun ((class std-class) gf)
   (let ((*new-class* class)
-	#|| (name (generic-function-name gf)) ||#
 	(arg-info (gf-arg-info gf)))
-    (cond #||
-	  ((eq name 'slot-value-using-class)
-	   (update-slot-value-gf-info gf 'reader))
-	  ((equal name '(setf slot-value-using-class))
-	   (update-slot-value-gf-info gf 'writer))
-	  ((eq name 'slot-boundp-using-class)
-	   (update-slot-value-gf-info gf 'boundp))
-	  ||#
-	  ((gf-precompute-dfun-and-emf-p arg-info)
-	   (multiple-value-bind (dfun cache info)
-	       (make-final-dfun-internal gf)
-	     (set-dfun gf dfun cache info) ; otherwise cache might get freed twice
-	     (update-dfun gf dfun cache info))))))
+    (when (gf-precompute-dfun-and-emf-p arg-info)
+      (multiple-value-bind (dfun cache info)
+	  (make-final-dfun-internal gf)
+	(set-dfun gf dfun cache info)
+	(update-dfun gf dfun cache info)))))
 
 ;;;
 ;;;
diff --git a/pcl/slots-boot.lisp b/pcl/slots-boot.lisp
index c29de10ef04eca1ca2f0d83717652d535e6a44f2..b5846ba7efdd7be344e06b1823cf92edc2993fc8 100644
--- a/pcl/slots-boot.lisp
+++ b/pcl/slots-boot.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots-boot.lisp,v 1.18 2003/03/26 17:15:21 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots-boot.lisp,v 1.19 2003/04/25 17:43:50 gerd Exp $")
 ;;;
 
 (in-package :pcl)
@@ -328,16 +328,6 @@
 	      (check-obsolete-instance instance)
 	      (not (eq (cdr index) +slot-unbound+))))))
 
-(defun get-accessor-from-svuc-method-function (class slotd sdfun name)
-  (macrolet ((emf-funcall (emf &rest args)
-	       `(invoke-effective-method-function ,emf nil ,@args)))
-    (set-function-name
-     (case name
-       (reader (lambda (instance) (emf-funcall sdfun class instance slotd)))
-       (writer (lambda (nv instance) (emf-funcall sdfun nv class instance slotd)))
-       (boundp (lambda (instance) (emf-funcall sdfun class instance slotd))))
-     `(,name ,(class-name class) ,(slot-definition-name slotd)))))
-
 (defun make-internal-reader-method-function (class-name slot-name)
   (list* :method-spec `(internal-reader-method ,class-name ,slot-name)
 	 (make-method-function
diff --git a/pcl/std-class.lisp b/pcl/std-class.lisp
index ef9ac4f69ef05c07e46ff3d2d8351f5d0a71c191..2bf7abb58edf25fa3b408f5b03c378b2d3a3fa3b 100644
--- a/pcl/std-class.lisp
+++ b/pcl/std-class.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.53 2003/04/18 10:06:23 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.54 2003/04/25 17:43:50 gerd Exp $")
 
 (in-package :pcl)
 
@@ -89,6 +89,20 @@
 	(compute-slot-accessor-info slotd type gf)))
     (initialize-internal-slot-gfs name)))
 
+;;;
+;;; Compute an effective method for SLOT-VALUE-USING-CLASS, (SETF
+;;; SLOT-VALUE-USING-CLASS) or SLOT-BOUNDP-USING-CLASS for reading/
+;;; writing/testing effective slot SLOTD.
+;;;
+;;; TYPE is one of the symbols READER, WRITER or BOUNDP, depending on
+;;; GF.  Store the effective method in the effective slot definition
+;;; object itself; these GFs have special dispatch functions calling
+;;; effective methods directly retrieved from effective slot
+;;; definition objects, as an optimization.
+;;;
+;;; FIXME: Change the function name to COMPUTE-SVUC-SLOTD-FUNCTION,
+;;; or some such.
+;;;
 (defmethod compute-slot-accessor-info ((slotd effective-slot-definition)
 				       type gf)
   (let* ((name (slot-value slotd 'name))
@@ -101,8 +115,6 @@
 	    (get-optimized-std-accessor-method-function class slotd type))
       (setf (slot-accessor-std-p slotd type) std-p)
       (setf (slot-accessor-function slotd type) function))
-    ;;
-    ;; Optimized accessor functions use pv tables.
     (when (and old-slotd
 	       (not (eq old-std-p (slot-accessor-std-p slotd 'all))))
       (record-pv-update-info slotd))))
@@ -883,20 +895,10 @@
 ;;;
 ;;;
 (defmethod compute-default-initargs ((class slot-class))
-  (let ((cpl (class-precedence-list class))
-	(direct (class-direct-default-initargs class)))
-    (labels ((walk (tail)
-	       (if (null tail)
-		   nil
-		   (let ((c (pop tail)))
-		     (append (if (eq c class)
-				 direct 
-				 (class-direct-default-initargs c))
-			     (walk tail))))))
-      (let ((initargs (walk cpl)))
-	(delete-duplicates initargs :test #'eq :key #'car :from-end t)))))
+  (let ((initargs (loop for c in (class-precedence-list class)
+			append (class-direct-default-initargs c))))
+    (delete-duplicates initargs :test #'eq :key #'car :from-end t)))
 
-
 ;;;
 ;;; Protocols for constructing direct and effective slot definitions.
 ;;;