Remove support for tail arrays and self slots

* libguile/struct.c (scm_make_struct): Remove support for tail arrays
  and self slots.
  (set_vtable_layout_flags): Always initialize the nfields member.
  (scm_is_valid_vtable_layout): Remove support for tail arrays and self
  slots.
  (scm_i_struct_inherit_vtable_magic): No need to issue deprecation
  warning for self slots, as they are no longer supported.
  (scm_struct_init): Remove support for tail arrays and self slots.
  (scm_c_make_structv): Throw an exception if n_tail is not 0.
  (scm_allocate_struct): Adapt to scm_struct_init change.
  (scm_i_make_vtable_vtable): Initialize slots manually, to avoid
  relying on an already-initialized nfields member.
  (scm_struct_ref, scm_struct_set_x): Simplify.
* module/oop/goops.scm: As we now rely on nfields being valid, when
  recalculating slots during boot we need to avoid resetting nfields of
  <class>, even temporarily, as that would prevent any further access to
  <class>!

1 files changed, 69 insertions, 205 deletions

diff --git a/libguile/struct.c b/libguile/struct.c
index 53bf3f302..7d5139b7b 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -51,9 +51,6 @@
 
 
 
-/* A needlessly obscure test. */
-#define SCM_LAYOUT_TAILP(X)		(((X) & 32) == 0) /* R, W or O */
-
 static SCM required_vtable_fields = SCM_BOOL_F;
 static SCM required_applicable_fields = SCM_BOOL_F;
 static SCM required_applicable_with_setter_fields = SCM_BOOL_F;
@@ -99,7 +96,6 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
 	  {
 	  case 'u':
 	  case 'p':
-	  case 's':
 	    break;
 	  default:
 	    SCM_MISC_ERROR ("unrecognized field type: ~S", 
@@ -110,21 +106,9 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
 	  {
 	  case 'w':
 	  case 'h':
-	    if (scm_i_string_ref (fields, x) == 's')
-	      SCM_MISC_ERROR ("self fields not writable", SCM_EOL);
 	  case 'r':
 	  case 'o':
 	    break;
-	  case 'R':
-	  case 'W':
-	  case 'O':
-	    if (scm_i_string_ref (fields, x) == 's')
-	      SCM_MISC_ERROR ("self fields not allowed in tail array", 
-			      SCM_EOL);
-	    if (x != len - 2)
-	      SCM_MISC_ERROR ("tail array field must be last field in layout",
-			      SCM_EOL);
-	    break;
 	  default:
 	    SCM_MISC_ERROR ("unrecognized ref specification: ~S",
 			    scm_list_1 (SCM_MAKE_CHAR (c)));
@@ -139,8 +123,7 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
 
 
 /* Check whether VTABLE instances have a simple layout (i.e., either
-   only "pr" or only "pw" fields and no tail array) and update its flags
-   accordingly.  */
+   only "pr" or only "pw" fields) and update its flags accordingly.  */
 static void
 set_vtable_layout_flags (SCM vtable)
 {
@@ -179,13 +162,9 @@ set_vtable_layout_flags (SCM vtable)
 	  }
     }
 
-  if (flags & SCM_VTABLE_FLAG_SIMPLE)
-    {
-      /* VTABLE is simple so update its flags and record the size of its
-	 instances.  */
-      SCM_SET_VTABLE_FLAGS (vtable, flags);
-      SCM_STRUCT_DATA_SET (vtable, scm_vtable_index_size, len / 2);
-    }
+  /* Record computed size of vtable's instances.  */
+  SCM_SET_VTABLE_FLAGS (vtable, flags);
+  SCM_STRUCT_DATA_SET (vtable, scm_vtable_index_size, len / 2);
 }
 
 static int
@@ -205,14 +184,8 @@ scm_is_valid_vtable_layout (SCM layout)
       {
       case 'u':
       case 'p':
-      case 's':
         switch (c_layout[n+1])
           {
-          case 'W':
-          case 'R':
-          case 'O':
-            if (n + 2 != len)
-              return 0;
           case 'w':
           case 'h':
           case 'r':
@@ -228,23 +201,6 @@ scm_is_valid_vtable_layout (SCM layout)
   return 1;
 }
 
-static void
-issue_deprecation_warning_for_self_slots (SCM vtable)
-{
-  SCM olayout;
-  size_t idx, first_user_slot = 0;
-
-  olayout = scm_symbol_to_string (SCM_VTABLE_LAYOUT (vtable));
-  if (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_VTABLE))
-    first_user_slot = scm_vtable_offset_user;
-
-  for (idx = first_user_slot * 2; idx < scm_c_string_length (olayout); idx += 2)
-    if (scm_is_eq (scm_c_string_ref (olayout, idx), SCM_MAKE_CHAR ('s')))
-      scm_c_issue_deprecation_warning
-        ("Vtables with \"self\" slots are deprecated.  Initialize these "
-         "fields manually.");
-}
-
 /* Have OBJ, a newly created vtable, inherit flags from VTABLE.  VTABLE is a
    vtable-vtable and OBJ is an instance of VTABLE.  */
 void
@@ -304,54 +260,37 @@ scm_i_struct_inherit_vtable_magic (SCM vtable, SCM obj)
       SCM_SET_VTABLE_FLAGS (obj, SCM_VTABLE_FLAG_APPLICABLE);
     }
 
-  issue_deprecation_warning_for_self_slots (obj);
-
   SCM_SET_VTABLE_FLAGS (obj, SCM_VTABLE_FLAG_VALIDATED);
 }
 #undef FUNC_NAME
 
 
 static void
-scm_struct_init (SCM handle, SCM layout, size_t n_tail,
-                 size_t n_inits, scm_t_bits *inits)
+scm_struct_init (SCM handle, SCM layout, size_t n_inits, scm_t_bits *inits)
 {
   SCM vtable;
   scm_t_bits *mem;
+  size_t n_fields;
 
   vtable = SCM_STRUCT_VTABLE (handle);
+  n_fields = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
   mem = SCM_STRUCT_DATA (handle);
 
-  if (SCM_UNPACK (vtable) != 0
-      && SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE)
-      && n_tail == 0
-      && n_inits == SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size))
+  if (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE)
+      && n_inits == n_fields)
     /* The fast path: HANDLE has N_INITS "p" fields.  */
     memcpy (mem, inits, n_inits * sizeof (SCM));
   else
     {
       scm_t_wchar prot = 0;
-      int n_fields = scm_i_symbol_length (layout) / 2;
-      int tailp = 0;
       int i;
       size_t inits_idx = 0;
 
       i = -2;
       while (n_fields)
 	{
-	  if (!tailp)
-	    {
-	      i += 2;
-	      prot = scm_i_symbol_ref (layout, i+1);
-	      if (SCM_LAYOUT_TAILP (prot))
-		{
-		  tailp = 1;
-		  prot = prot == 'R' ? 'r' : prot == 'W' ? 'w' : 'o';
-		  *mem++ = (scm_t_bits)n_tail;
-		  n_fields += n_tail - 1;
-		  if (n_fields == 0)
-		    break;
-		}
-	    }
+          i += 2;
+          prot = scm_i_symbol_ref (layout, i+1);
 	  switch (scm_i_symbol_ref (layout, i))
 	    {
 	    case 'u':
@@ -374,10 +313,6 @@ scm_struct_init (SCM handle, SCM layout, size_t n_tail,
 		}
 
 	      break;
-
-	    case 's':
-	      *mem = SCM_UNPACK (handle);
-	      break;
 	    }
 
 	  n_fields--;
@@ -455,26 +390,10 @@ scm_c_make_structv (SCM vtable, size_t n_tail, size_t n_init, scm_t_bits *init)
   layout = SCM_VTABLE_LAYOUT (vtable);
   basic_size = scm_i_symbol_length (layout) / 2;
 
-  if (n_tail != 0)
-    {
-      SCM layout_str, last_char;
-      
-      if (basic_size == 0)
-        {
-        bad_tail: 
-          SCM_MISC_ERROR ("tail array not allowed unless layout ends R, W, or O", SCM_EOL);
-        }
-
-      layout_str = scm_symbol_to_string (layout);
-      last_char = scm_string_ref (layout_str,
-                                  scm_from_size_t (2 * basic_size - 1));
-      if (! SCM_LAYOUT_TAILP (SCM_CHAR (last_char)))
-        goto bad_tail;
-    }
+  SCM_ASSERT (n_tail == 0, scm_from_size_t (n_tail), 2, FUNC_NAME);
 
-  obj = scm_i_alloc_struct (SCM_UNPACK (vtable), basic_size + n_tail);
-
-  scm_struct_init (obj, layout, n_tail, n_init, init);
+  obj = scm_i_alloc_struct (SCM_UNPACK (vtable), basic_size);
+  scm_struct_init (obj, layout, n_init, init);
 
   /* If we're making a vtable, validate its layout and inherit
      flags. However we allow for separation of allocation and
@@ -495,6 +414,8 @@ scm_c_make_struct (SCM vtable, size_t n_tail, size_t n_init, scm_t_bits init, ..
   scm_t_bits *v;
   size_t i;
 
+  SCM_ASSERT (n_tail == 0, scm_from_size_t (n_tail), 2, "scm_c_make_struct");
+
   v = alloca (sizeof (scm_t_bits) * n_init);
 
   va_start (foo, init);
@@ -505,7 +426,7 @@ scm_c_make_struct (SCM vtable, size_t n_tail, size_t n_init, scm_t_bits init, ..
     }
   va_end (foo);
 
-  return scm_c_make_structv (vtable, n_tail, n_init, v);
+  return scm_c_make_structv (vtable, 0, n_init, v);
 }
 
 SCM_DEFINE (scm_allocate_struct, "allocate-struct", 2, 0, 0,
@@ -538,7 +459,7 @@ SCM_DEFINE (scm_allocate_struct, "allocate-struct", 2, 0, 0,
         SCM_STRUCT_DATA_SET (ret, n, SCM_UNPACK (SCM_BOOL_F));
     }
   else
-    scm_struct_init (ret, SCM_VTABLE_LAYOUT (vtable), 0, 0, NULL);
+    scm_struct_init (ret, SCM_VTABLE_LAYOUT (vtable), 0, NULL);
 
   return ret;
 }
@@ -588,8 +509,7 @@ scm_i_make_vtable_vtable (SCM fields)
 #define FUNC_NAME "make-vtable-vtable"
 {
   SCM layout, obj;
-  size_t basic_size;
-  scm_t_bits v;
+  size_t n, nfields;
 
   SCM_VALIDATE_STRING (1, fields);
 
@@ -597,16 +517,26 @@ scm_i_make_vtable_vtable (SCM fields)
   if (!scm_is_valid_vtable_layout (layout))
     SCM_MISC_ERROR ("invalid user fields", scm_list_1 (fields));
 
-  basic_size = scm_i_symbol_length (layout) / 2;
+  nfields = scm_i_symbol_length (layout) / 2;
 
-  obj = scm_i_alloc_struct (0, basic_size);
+  obj = scm_i_alloc_struct (0, nfields);
   /* Make it so that the vtable of OBJ is itself.  */
   SCM_SET_CELL_WORD_0 (obj, SCM_UNPACK (obj) | scm_tc3_struct);
-
-  v = SCM_UNPACK (layout);
-  scm_struct_init (obj, layout, 0, 1, &v);
-  SCM_SET_VTABLE_FLAGS (obj,
-                        SCM_VTABLE_FLAG_VTABLE | SCM_VTABLE_FLAG_VALIDATED);
+  /* Manually initialize fields.  */
+  SCM_STRUCT_SLOT_SET (obj, scm_vtable_index_layout, layout);
+  SCM_STRUCT_DATA_SET (obj, scm_vtable_index_flags,
+                       SCM_VTABLE_FLAG_VTABLE | SCM_VTABLE_FLAG_VALIDATED);
+  SCM_STRUCT_DATA_SET (obj, scm_vtable_index_instance_finalize, 0);
+  SCM_STRUCT_SLOT_SET (obj, scm_vtable_index_instance_printer, SCM_BOOL_F);
+  SCM_STRUCT_SLOT_SET (obj, scm_vtable_index_name, SCM_BOOL_F);
+  SCM_STRUCT_DATA_SET (obj, scm_vtable_index_size, nfields);
+  SCM_STRUCT_DATA_SET (obj, scm_vtable_index_reserved_7, 0);
+
+  for (n = scm_vtable_offset_user; n < nfields; n++)
+    if (scm_i_symbol_ref (layout, n*2) == 'p')
+      SCM_STRUCT_SLOT_SET (obj, n, SCM_BOOL_F);
+    else
+      SCM_STRUCT_DATA_SET (obj, n, 0);
 
   return obj;
 }
@@ -672,8 +602,6 @@ scm_i_struct_equalp (SCM s1, SCM s2)
 	  return SCM_BOOL_F;
     }
 
-  /* FIXME: Tail elements should be tested for equality.  */
-
   return SCM_BOOL_T;
 }
 #undef FUNC_NAME
@@ -695,72 +623,38 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
 	    "word.")
 #define FUNC_NAME s_scm_struct_ref
 {
-  SCM vtable, answer = SCM_UNDEFINED;
-  scm_t_bits *data;
-  size_t p;
+  SCM vtable;
+  scm_t_bits data;
+  size_t nfields, p;
 
   SCM_VALIDATE_STRUCT (1, handle);
 
   vtable = SCM_STRUCT_VTABLE (handle);
-  data = SCM_STRUCT_DATA (handle);
+  nfields = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
   p = scm_to_size_t (pos);
 
-  if (SCM_LIKELY (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE)
-  		  && p < SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size)))
-    /* The fast path: HANDLE is a struct with only "p" fields.  */
-    answer = SCM_PACK (data[p]);
+  SCM_ASSERT_RANGE (2, pos, p < nfields);
+
+  data = SCM_STRUCT_DATA_REF (handle, p);
+
+  if (SCM_LIKELY (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE)))
+    /* The fast path: HANDLE is a struct with only readable "p"
+       fields.  */
+    return SCM_PACK (data);
   else
     {
       SCM layout;
-      size_t layout_len, n_fields;
-      scm_t_wchar field_type = 0;
+      scm_t_wchar field_type, protection;
 
       layout = SCM_STRUCT_LAYOUT (handle);
-      layout_len = scm_i_symbol_length (layout);
-      n_fields = layout_len / 2;
-
-      if (SCM_LAYOUT_TAILP (scm_i_symbol_ref (layout, layout_len - 1)))
-	n_fields += data[n_fields - 1];
-
-      SCM_ASSERT_RANGE (1, pos, p < n_fields);
-
-      if (p * 2 < layout_len)
-	{
-	  scm_t_wchar ref;
-	  field_type = scm_i_symbol_ref (layout, p * 2);
-	  ref = scm_i_symbol_ref (layout, p * 2 + 1);
-	  if ((ref != 'r') && (ref != 'w') && (ref != 'h'))
-	    {
-	      if ((ref == 'R') || (ref == 'W'))
-		field_type = 'u';
-	      else
-		SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
-	    }
-	}
-      else if (scm_i_symbol_ref (layout, layout_len - 1) != 'O')
-	field_type = scm_i_symbol_ref(layout, layout_len - 2);
-      else
-	SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
-
-      switch (field_type)
-	{
-	case 'u':
-	  answer = scm_from_ulong (data[p]);
-	  break;
-
-	case 's':
-	case 'p':
-	  answer = SCM_PACK (data[p]);
-	break;
+      field_type = scm_i_symbol_ref (layout, p * 2);
+      protection = scm_i_symbol_ref (layout, p * 2 + 1);
 
+      if (protection == 'o')
+        SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
 
-	default:
-	  SCM_MISC_ERROR ("unrecognized field type: ~S",
-			  scm_list_1 (SCM_MAKE_CHAR (field_type)));
-	}
+      return (field_type == 'p') ? SCM_PACK (data) : scm_from_uintptr_t (data);
     }
-
-  return answer;
 }
 #undef FUNC_NAME
 
@@ -773,65 +667,35 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
 #define FUNC_NAME s_scm_struct_set_x
 {
   SCM vtable;
-  scm_t_bits *data;
-  size_t p;
+  size_t nfields, p;
 
   SCM_VALIDATE_STRUCT (1, handle);
 
   vtable = SCM_STRUCT_VTABLE (handle);
-  data = SCM_STRUCT_DATA (handle);
+  nfields = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
   p = scm_to_size_t (pos);
 
-  if (SCM_LIKELY (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE)
-  		  && SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE_RW)
-  		  && p < SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size)))
-    /* The fast path: HANDLE is a struct with only "pw" fields.  */
-    data[p] = SCM_UNPACK (val);
+  SCM_ASSERT_RANGE (2, pos, p < nfields);
+
+  if (SCM_LIKELY (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE_RW)))
+    /* The fast path: HANDLE is a struct with only "p" fields.  */
+    SCM_STRUCT_SLOT_SET (handle, p, val);
   else
     {
       SCM layout;
-      size_t layout_len, n_fields;
-      scm_t_wchar field_type = 0;
+      scm_t_wchar field_type, protection;
 
       layout = SCM_STRUCT_LAYOUT (handle);
-      layout_len = scm_i_symbol_length (layout);
-      n_fields = layout_len / 2;
+      field_type = scm_i_symbol_ref (layout, p * 2);
+      protection = scm_i_symbol_ref (layout, p * 2 + 1);
 
-      if (SCM_LAYOUT_TAILP (scm_i_symbol_ref (layout, layout_len - 1)))
-	n_fields += data[n_fields - 1];
+      if (protection == 'o' || protection == 'r')
+        SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
 
-      SCM_ASSERT_RANGE (1, pos, p < n_fields);
-
-      if (p * 2 < layout_len)
-	{
-	  char set_x;
-	  field_type = scm_i_symbol_ref (layout, p * 2);
-	  set_x = scm_i_symbol_ref (layout, p * 2 + 1);
-	  if (set_x != 'w' && set_x != 'h')
-	    SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
-	}
-      else if (scm_i_symbol_ref (layout, layout_len - 1) == 'W')
-	field_type = scm_i_symbol_ref (layout, layout_len - 2);
+      if (field_type == 'p')
+        SCM_STRUCT_SLOT_SET (handle, p, val);
       else
-	SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
-
-      switch (field_type)
-	{
-	case 'u':
-	  data[p] = SCM_NUM2ULONG (3, val);
-	  break;
-
-	case 'p':
-	  data[p] = SCM_UNPACK (val);
-	  break;
-
-	case 's':
-	  SCM_MISC_ERROR ("self fields immutable", SCM_EOL);
-
-	default:
-	  SCM_MISC_ERROR ("unrecognized field type: ~S",
-			  scm_list_1 (SCM_MAKE_CHAR (field_type)));
-	}
+        SCM_STRUCT_DATA_SET (handle, p, scm_to_uintptr_t (val));
     }
 
   return val;