goops.c no longer knows about <class> slot allocation

* libguile/goops.c (scm_class_of): Access "redefined" slot by name in
  the case where we need to change the class of an instance.
  (scm_sys_goops_early_init): Move up capture of class-precedence-list
  so SCM_SUBCLASSP can use it.

* libguile/goops.h (SCM_CLASS_CLASS_LAYOUT, scm_si_redefined)
  (scm_si_direct_supers, scm_si_direct_slots, scm_si_direct_subclasses)
  (scm_si_direct_methods, scm_si_cpl scm_si_slots)
  (scm_si_getters_n_setters, SCM_N_CLASS_SLOTS, SCM_OBJ_CLASS_REDEF):
  Remove.  Now C code has no special knowledge about the layout of
  GOOPS classes.
  (SCM_SUBCLASSP): Use scm_class_precedence_list to get CPL.
  (SCM_INST, SCM_ACCESSORS_OF): Remove unused macros that were
  undocumented and nonsensical.

2 files changed, 13 insertions, 36 deletions

diff --git a/libguile/goops.c b/libguile/goops.c
index 070b6bcc3..aabd6ad8a 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -69,6 +69,7 @@
 
 SCM_KEYWORD (k_name, "name");
 SCM_KEYWORD (k_setter, "setter");
+SCM_SYMBOL (sym_redefined, "redefined");
 SCM_GLOBAL_SYMBOL (scm_sym_args, "args");
 
 static int goops_loaded_p = 0;
@@ -254,14 +255,16 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
                                    : SCM_IN_PCLASS_INDEX | SCM_PTOBNUM (x))];
 	case scm_tcs_struct:
 	  if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS_VALID)
+            /* A GOOPS object with a valid class.  */
 	    return SCM_CLASS_OF (x);
 	  else if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS)
+            /* A GOOPS object whose class might have been redefined.  */
 	    {
-	      /* Goops object */
-	      if (! scm_is_false (SCM_OBJ_CLASS_REDEF (x)))
-		scm_change_object_class (x,
-					 SCM_CLASS_OF (x),         /* old */
-					 SCM_OBJ_CLASS_REDEF (x)); /* new */
+              SCM class = SCM_CLASS_OF (x);
+              SCM new_class = scm_slot_ref (class, sym_redefined);
+              if (!scm_is_false (new_class))
+		scm_change_object_class (x, class, new_class);
+              /* Re-load class from instance.  */
 	      return SCM_CLASS_OF (x);
 	    }
 	  else
@@ -1060,6 +1063,9 @@ SCM_DEFINE (scm_sys_goops_early_init, "%goops-early-init", 0, 0, 0,
   var_make = scm_c_lookup ("make");
   var_inherit_applicable = scm_c_lookup ("inherit-applicable!");
 
+  /* For SCM_SUBCLASSP.  */
+  var_class_precedence_list = scm_c_lookup ("class-precedence-list");
+
   var_slot_ref_using_class = scm_c_lookup ("slot-ref-using-class");
   var_slot_set_using_class_x = scm_c_lookup ("slot-set-using-class!");
   var_slot_bound_using_class_p = scm_c_lookup ("slot-bound-using-class?");
@@ -1159,7 +1165,6 @@ SCM_DEFINE (scm_sys_goops_loaded, "%goops-loaded", 0, 0, 0,
   var_class_direct_slots = scm_c_lookup ("class-direct-slots");
   var_class_direct_subclasses = scm_c_lookup ("class-direct-subclasses");
   var_class_direct_methods = scm_c_lookup ("class-direct-methods");
-  var_class_precedence_list = scm_c_lookup ("class-precedence-list");
   var_class_slots = scm_c_lookup ("class-slots");
 
   var_generic_function_methods = scm_c_lookup ("generic-function-methods");
diff --git a/libguile/goops.h b/libguile/goops.h
index f7233cb4d..fafd7fa37 100644
--- a/libguile/goops.h
+++ b/libguile/goops.h
@@ -54,36 +54,7 @@
 #define SCM_CLASSF_GOOPS         SCM_VTABLE_FLAG_GOOPS_CLASS
 #define SCM_CLASSF_GOOPS_OR_VALID (SCM_CLASSF_GOOPS | SCM_CLASSF_GOOPS_VALID)
 
-/*
- * scm_class_class
- */
-
-/* see also, SCM_VTABLE_BASE_LAYOUT, and build_class_class_slots */
-#define SCM_CLASS_CLASS_LAYOUT                  \
-  "pw" /* redefined */                          \
-  "pw" /* direct supers */                      \
-  "pw" /* direct slots */                       \
-  "pw" /* direct subclasses */                  \
-  "pw" /* direct methods */                     \
-  "pw" /* cpl */                                \
-  "pw" /* slots */                              \
-  "pw" /* getters-n-setters */
-
-#define scm_si_redefined         (scm_vtable_offset_user + 0)
-#define scm_si_direct_supers 	 (scm_vtable_offset_user + 1) /* (class ...) */
-#define scm_si_direct_slots	 (scm_vtable_offset_user + 2) /* ((name . options) ...) */
-#define scm_si_direct_subclasses (scm_vtable_offset_user + 3) /* (class ...) */
-#define scm_si_direct_methods	 (scm_vtable_offset_user + 4) /* (methods ...) */
-#define scm_si_cpl		 (scm_vtable_offset_user + 5) /* (class ...) */
-#define scm_si_slots		 (scm_vtable_offset_user + 6) /* ((name . options) ...) */
-#define scm_si_getters_n_setters (scm_vtable_offset_user + 7)
-#define SCM_N_CLASS_SLOTS	 (scm_vtable_offset_user + 8)
-
-#define SCM_OBJ_CLASS_REDEF(x)  (SCM_PACK (SCM_STRUCT_VTABLE_DATA (x) [scm_si_redefined]))
-#define SCM_INST(x)	       SCM_STRUCT_DATA (x)
-
 #define SCM_CLASS_OF(x)        SCM_STRUCT_VTABLE (x)
-#define SCM_ACCESSORS_OF(x)    (SCM_PACK (SCM_STRUCT_VTABLE_DATA (x)[scm_si_getters_n_setters]))
 
 #define SCM_CLASSP(x) \
   (SCM_STRUCTP (x) && SCM_STRUCT_VTABLE_FLAGS (x) & SCM_CLASSF_METACLASS)
@@ -96,7 +67,8 @@
 #define SCM_SLOT(x, i)         (SCM_STRUCT_SLOT_REF (x, i))
 #define SCM_SET_SLOT(x, i, v)  (SCM_STRUCT_SLOT_SET (x, i, v))
 
-#define SCM_SUBCLASSP(c1, c2)  (scm_is_true (scm_c_memq (c2, SCM_SLOT (c1, scm_si_cpl))))
+#define SCM_SUBCLASSP(c1, c2) \
+  (scm_is_true (scm_c_memq (c2, scm_class_precedence_list (c1))))
 #define SCM_IS_A_P(x, c) \
   (SCM_INSTANCEP (x) && SCM_SUBCLASSP (SCM_CLASS_OF (x), c))