CLASS-NAME must be a generic function.

src/clos/boot.lsp

@@ -20,7 +20,7 @@
   (let ((class (si:allocate-raw-instance nil metaclass 12)))
     (unless metaclass
       (si:instance-class-set class class))
-    (setf (class-name                class) name
+    (setf (class-id                  class) name
 	  (class-direct-superclasses class) nil
 	  (class-direct-subclasses   class) nil
 	  (class-slots               class) nil
@@ -142,4 +142,10 @@
 (defmethod slot-exists-p ((instance t) slot-name)
   nil)
 
+(defmethod class-name ((class class))
+  (class-id class))
+
+(defmethod (setf class-name) (new-value (class class))
+  (setf (class-id class) new-value))
+
 ;;; ----------------------------------------------------------------------

src/clos/fixup.lsp

@@ -16,7 +16,7 @@
   (let* ((method-name (car method-info))
 	 (gfun (fdefinition method-name))
 	 (standard-method-class (find-class 'standard-method)))
-    (when (eq 'T (class-name (si:instance-class gfun)))
+    (when (eq 'T (class-id (si:instance-class gfun)))
       ;; complete the generic function object
       (si:instance-class-set gfun (find-class 'STANDARD-GENERIC-FUNCTION))
       (si::instance-sig-set gfun)

src/clos/kernel.lsp

@@ -46,7 +46,7 @@
 
 (eval-when (compile eval)
   (defparameter +class-slots+
-    '((name :initarg :name :initform nil :accessor class-name)
+    '((name :initarg :name :initform nil :accessor class-id)
       (direct-superclasses :initarg :direct-superclasses
        :accessor class-direct-superclasses)
       (direct-subclasses :initform nil :accessor class-direct-subclasses)

src/cmp/sysfun.lsp

@@ -1091,7 +1091,7 @@ type_of(#0)==t_bitvector"))
 	    #+clos
 	    (clos::ensure-class clos::install-method
 	     clos::standard-instance-set
-	     clos::class-name
+	     clos::class-id
 	     clos::class-direct-superclasses
 	     clos::class-direct-subclasses
 	     clos::class-slots