guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 02/03: Remove support for tail arrays and self slots


From: Andy Wingo
Subject: [Guile-commits] 02/03: Remove support for tail arrays and self slots
Date: Fri, 22 Sep 2017 10:07:19 -0400 (EDT)

wingo pushed a commit to branch master
in repository guile.

commit d354962b687d20252de7a647d8d501623d9f6bda
Author: Andy Wingo <address@hidden>
Date:   Fri Sep 22 15:04:36 2017 +0200

    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>!
---
 libguile/struct.c    | 274 +++++++++++++--------------------------------------
 module/oop/goops.scm |  14 +++
 2 files changed, 83 insertions(+), 205 deletions(-)

diff --git a/libguile/struct.c b/libguile/struct.c
index 53bf3f3..7d5139b 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;
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 917367b..c883320 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -911,6 +911,20 @@ slots as we go."
           (compute-direct-slot-definition class initargs)))
       (struct-set! class class-index-direct-slots
                    (map make-direct-slot-definition specs))))
+  ;; Boot definition that avoids munging nfields.
+  (define (allocate-slots class slots)
+    (define (make-effective-slot-definition slot index)
+      (let* ((slot (compute-effective-slot-definition class slot)))
+        (struct-set! slot slot-index-slot-ref/raw (standard-get index))
+        (struct-set! slot slot-index-slot-ref
+                     (if (slot-definition-init-thunk slot)
+                         (struct-ref slot slot-index-slot-ref/raw)
+                         (bound-check-get index)))
+        (struct-set! slot slot-index-slot-set! (standard-set index))
+        (struct-set! slot slot-index-index index)
+        (struct-set! slot slot-index-size 1)
+        slot))
+    (map make-effective-slot-definition slots (iota (length slots))))
   (define (initialize-slots! class)
     (let ((slots (build-slots-list (class-direct-slots class)
                                    (class-precedence-list class))))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]