mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-15 16:20:17 +02:00
Code Activity

Remove support for tail arrays and self slots

Browse source 
* 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>!
This commit is contained in:
Andy Wingo 2017-09-22 15:04:36 +02:00
parent 2f9ad7d9bc
commit d354962b68
2 changed files with 82 additions and 204 deletions
Download patch file Download diff file Expand all files Collapse all files

262
libguile/struct.c
View file

@ -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_vtable_fields = SCM_BOOL_F;
static SCM required_applicable_fields = SCM_BOOL_F; static SCM required_applicable_fields = SCM_BOOL_F;
static SCM required_applicable_with_setter_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 'u':
case 'p': case 'p':
case 's':
break; break;
default: default:
SCM_MISC_ERROR ("unrecognized field type: ~S", 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 'w':
case 'h': case 'h':
if (scm_i_string_ref (fields, x) == 's')
SCM_MISC_ERROR ("self fields not writable", SCM_EOL);
case 'r': case 'r':
case 'o': case 'o':
break; 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: default:
SCM_MISC_ERROR ("unrecognized ref specification: ~S", SCM_MISC_ERROR ("unrecognized ref specification: ~S",
scm_list_1 (SCM_MAKE_CHAR (c))); 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 /* 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 only "pr" or only "pw" fields) and update its flags accordingly. */
accordingly. */
static void static void
set_vtable_layout_flags (SCM vtable) set_vtable_layout_flags (SCM vtable)
{ {
@ -179,13 +162,9 @@ set_vtable_layout_flags (SCM vtable)
} }
} }
if (flags & SCM_VTABLE_FLAG_SIMPLE) /* Record computed size of vtable's instances. */
{
/* VTABLE is simple so update its flags and record the size of its
instances. */
SCM_SET_VTABLE_FLAGS (vtable, flags); SCM_SET_VTABLE_FLAGS (vtable, flags);
SCM_STRUCT_DATA_SET (vtable, scm_vtable_index_size, len / 2); SCM_STRUCT_DATA_SET (vtable, scm_vtable_index_size, len / 2);
}
} }
static int static int
@ -205,14 +184,8 @@ scm_is_valid_vtable_layout (SCM layout)
{ {
case 'u': case 'u':
case 'p': case 'p':
case 's':
switch (c_layout[n+1]) switch (c_layout[n+1])
{ {
case 'W':
case 'R':
case 'O':
if (n + 2 != len)
return 0;
case 'w': case 'w':
case 'h': case 'h':
case 'r': case 'r':
@ -228,23 +201,6 @@ scm_is_valid_vtable_layout (SCM layout)
return 1; 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 /* Have OBJ, a newly created vtable, inherit flags from VTABLE. VTABLE is a
vtable-vtable and OBJ is an instance of VTABLE. */ vtable-vtable and OBJ is an instance of VTABLE. */
void void
@ -304,54 +260,37 @@ scm_i_struct_inherit_vtable_magic (SCM vtable, SCM obj)
SCM_SET_VTABLE_FLAGS (obj, SCM_VTABLE_FLAG_APPLICABLE); 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); SCM_SET_VTABLE_FLAGS (obj, SCM_VTABLE_FLAG_VALIDATED);
} }
#undef FUNC_NAME #undef FUNC_NAME
static void static void
scm_struct_init (SCM handle, SCM layout, size_t n_tail, scm_struct_init (SCM handle, SCM layout, size_t n_inits, scm_t_bits *inits)
size_t n_inits, scm_t_bits *inits)
{ {
SCM vtable; SCM vtable;
scm_t_bits *mem; scm_t_bits *mem;
size_t n_fields;
vtable = SCM_STRUCT_VTABLE (handle); vtable = SCM_STRUCT_VTABLE (handle);
n_fields = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
mem = SCM_STRUCT_DATA (handle); mem = SCM_STRUCT_DATA (handle);
if (SCM_UNPACK (vtable) != 0 if (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE)
&& SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE) && n_inits == n_fields)
&& n_tail == 0
&& n_inits == SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size))
/* The fast path: HANDLE has N_INITS "p" fields. */ /* The fast path: HANDLE has N_INITS "p" fields. */
memcpy (mem, inits, n_inits * sizeof (SCM)); memcpy (mem, inits, n_inits * sizeof (SCM));
else else
{ {
scm_t_wchar prot = 0; scm_t_wchar prot = 0;
int n_fields = scm_i_symbol_length (layout) / 2;
int tailp = 0;
int i; int i;
size_t inits_idx = 0; size_t inits_idx = 0;
i = -2; i = -2;
while (n_fields) while (n_fields)
{
if (!tailp)
{ {
i += 2; i += 2;
prot = scm_i_symbol_ref (layout, i+1); 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;
}
}
switch (scm_i_symbol_ref (layout, i)) switch (scm_i_symbol_ref (layout, i))
{ {
case 'u': case 'u':
@ -374,10 +313,6 @@ scm_struct_init (SCM handle, SCM layout, size_t n_tail,
} }
break; break;
case 's':
*mem = SCM_UNPACK (handle);
break;
} }
n_fields--; 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); layout = SCM_VTABLE_LAYOUT (vtable);
basic_size = scm_i_symbol_length (layout) / 2; basic_size = scm_i_symbol_length (layout) / 2;
if (n_tail != 0) SCM_ASSERT (n_tail == 0, scm_from_size_t (n_tail), 2, FUNC_NAME);
{
SCM layout_str, last_char;
if (basic_size == 0) obj = scm_i_alloc_struct (SCM_UNPACK (vtable), basic_size);
{ scm_struct_init (obj, layout, n_init, init);
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;
}
obj = scm_i_alloc_struct (SCM_UNPACK (vtable), basic_size + n_tail);
scm_struct_init (obj, layout, n_tail, n_init, init);
/* If we're making a vtable, validate its layout and inherit /* If we're making a vtable, validate its layout and inherit
flags. However we allow for separation of allocation and 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; scm_t_bits *v;
size_t i; 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); v = alloca (sizeof (scm_t_bits) * n_init);
va_start (foo, 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); 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, 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)); SCM_STRUCT_DATA_SET (ret, n, SCM_UNPACK (SCM_BOOL_F));
} }
else else
scm_struct_init (ret, SCM_VTABLE_LAYOUT (vtable), 0, 0, NULL); scm_struct_init (ret, SCM_VTABLE_LAYOUT (vtable), 0, NULL);
return ret; return ret;
} }
@ -588,8 +509,7 @@ scm_i_make_vtable_vtable (SCM fields)
#define FUNC_NAME "make-vtable-vtable" #define FUNC_NAME "make-vtable-vtable"
{ {
SCM layout, obj; SCM layout, obj;
size_t basic_size; size_t n, nfields;
scm_t_bits v;
SCM_VALIDATE_STRING (1, fields); SCM_VALIDATE_STRING (1, fields);
@ -597,16 +517,26 @@ scm_i_make_vtable_vtable (SCM fields)
if (!scm_is_valid_vtable_layout (layout)) if (!scm_is_valid_vtable_layout (layout))
SCM_MISC_ERROR ("invalid user fields", scm_list_1 (fields)); 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. */ /* Make it so that the vtable of OBJ is itself. */
SCM_SET_CELL_WORD_0 (obj, SCM_UNPACK (obj) | scm_tc3_struct); SCM_SET_CELL_WORD_0 (obj, SCM_UNPACK (obj) | scm_tc3_struct);
/* Manually initialize fields. */
v = SCM_UNPACK (layout); SCM_STRUCT_SLOT_SET (obj, scm_vtable_index_layout, layout);
scm_struct_init (obj, layout, 0, 1, &v); SCM_STRUCT_DATA_SET (obj, scm_vtable_index_flags,
SCM_SET_VTABLE_FLAGS (obj,
SCM_VTABLE_FLAG_VTABLE | SCM_VTABLE_FLAG_VALIDATED); 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; return obj;
} }
@ -672,8 +602,6 @@ scm_i_struct_equalp (SCM s1, SCM s2)
return SCM_BOOL_F; return SCM_BOOL_F;
} }
/* FIXME: Tail elements should be tested for equality. */
return SCM_BOOL_T; return SCM_BOOL_T;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -695,72 +623,38 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
"word.") "word.")
#define FUNC_NAME s_scm_struct_ref #define FUNC_NAME s_scm_struct_ref
{ {
SCM vtable, answer = SCM_UNDEFINED; SCM vtable;
scm_t_bits *data; scm_t_bits data;
size_t p; size_t nfields, p;
SCM_VALIDATE_STRUCT (1, handle); SCM_VALIDATE_STRUCT (1, handle);
vtable = SCM_STRUCT_VTABLE (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); p = scm_to_size_t (pos);
if (SCM_LIKELY (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE) SCM_ASSERT_RANGE (2, pos, p < nfields);
&& p < SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size)))
/* The fast path: HANDLE is a struct with only "p" fields. */ data = SCM_STRUCT_DATA_REF (handle, p);
answer = SCM_PACK (data[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 else
{ {
SCM layout; SCM layout;
size_t layout_len, n_fields; scm_t_wchar field_type, protection;
scm_t_wchar field_type = 0;
layout = SCM_STRUCT_LAYOUT (handle); 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); field_type = scm_i_symbol_ref (layout, p * 2);
ref = scm_i_symbol_ref (layout, p * 2 + 1); protection = scm_i_symbol_ref (layout, p * 2 + 1);
if ((ref != 'r') && (ref != 'w') && (ref != 'h'))
{ if (protection == 'o')
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)); SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
switch (field_type) return (field_type == 'p') ? SCM_PACK (data) : scm_from_uintptr_t (data);
{
case 'u':
answer = scm_from_ulong (data[p]);
break;
case 's':
case 'p':
answer = SCM_PACK (data[p]);
break;
default:
SCM_MISC_ERROR ("unrecognized field type: ~S",
scm_list_1 (SCM_MAKE_CHAR (field_type)));
} }
}
return answer;
} }
#undef FUNC_NAME #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 #define FUNC_NAME s_scm_struct_set_x
{ {
SCM vtable; SCM vtable;
scm_t_bits *data; size_t nfields, p;
size_t p;
SCM_VALIDATE_STRUCT (1, handle); SCM_VALIDATE_STRUCT (1, handle);
vtable = SCM_STRUCT_VTABLE (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); p = scm_to_size_t (pos);
if (SCM_LIKELY (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE) SCM_ASSERT_RANGE (2, pos, p < nfields);
&& SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE_RW)
&& p < SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size))) if (SCM_LIKELY (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE_RW)))
/* The fast path: HANDLE is a struct with only "pw" fields. */ /* The fast path: HANDLE is a struct with only "p" fields. */
data[p] = SCM_UNPACK (val); SCM_STRUCT_SLOT_SET (handle, p, val);
else else
{ {
SCM layout; SCM layout;
size_t layout_len, n_fields; scm_t_wchar field_type, protection;
scm_t_wchar field_type = 0;
layout = SCM_STRUCT_LAYOUT (handle); 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)
{
char set_x;
field_type = scm_i_symbol_ref (layout, p * 2); field_type = scm_i_symbol_ref (layout, p * 2);
set_x = scm_i_symbol_ref (layout, p * 2 + 1); protection = scm_i_symbol_ref (layout, p * 2 + 1);
if (set_x != 'w' && set_x != 'h')
if (protection == 'o' || protection == 'r')
SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos)); SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
}
else if (scm_i_symbol_ref (layout, layout_len - 1) == 'W') if (field_type == 'p')
field_type = scm_i_symbol_ref (layout, layout_len - 2); SCM_STRUCT_SLOT_SET (handle, p, val);
else else
SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos)); SCM_STRUCT_DATA_SET (handle, p, scm_to_uintptr_t (val));
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)));
}
} }
return val; return val;

14
module/oop/goops.scm
View file

@ -911,6 +911,20 @@ slots as we go."
(compute-direct-slot-definition class initargs))) (compute-direct-slot-definition class initargs)))
(struct-set! class class-index-direct-slots (struct-set! class class-index-direct-slots
(map make-direct-slot-definition specs)))) (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) (define (initialize-slots! class)
(let ((slots (build-slots-list (class-direct-slots class) (let ((slots (build-slots-list (class-direct-slots class)
(class-precedence-list class)))) (class-precedence-list class))))