[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/02: Struct vtables store bitmask of unboxed fields
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 02/02: Struct vtables store bitmask of unboxed fields |
|
Date: |
Tue, 26 Sep 2017 16:03:46 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit 214e887dbdece2e7608b02dd1ce5b31e710266cc
Author: Andy Wingo <address@hidden>
Date: Tue Sep 26 21:56:31 2017 +0200
Struct vtables store bitmask of unboxed fields
* libguile/struct.h (scm_vtable_index_unboxed_fields): Allocate slot for
bitmask of which fields are unboxed.
(SCM_VTABLE_FLAG_SIMPLE, SCM_VTABLE_FLAG_SIMPLE_RW): Remove flags.
Renumber other flags.
(SCM_VTABLE_SIZE, SCM_STRUCT_SIZE): New helpers; long overdue.
(SCM_VTABLE_UNBOXED_FIELDS, SCM_VTABLE_FIELD_IS_UNBOXED):
(SCM_STRUCT_FIELD_IS_UNBOXED): New macros.
* libguile/struct.c (set_vtable_access_fields): Rename from
set_vtable_layout_flags, and initialize the unboxed flags bitmask
instead of computing vtable flags.
(scm_struct_init, scm_c_make_structv, scm_allocate_struct): Simplify.
(scm_i_make_vtable_vtable): Adapt.
(scm_i_struct_equalp, scm_struct_ref, scm_struct_set_x)
(scm_struct_ref_unboxed, scm_struct_set_x_unboxed): Simplify.
* libguile/vm-engine.c (VM_VALIDATE_BOXED_STRUCT_FIELD):
(VM_VALIDATE_UNBOXED_STRUCT_FIELD): Adapt definitions.
(struct-ref, struct-set!, struct-ref/immediate)
(struct-set!/immediate): Simplify definitions.
* libguile/hash.c (scm_i_struct_hash): Simplify.
* libguile/goops.c (scm_sys_clear_fields_x): Simplify.
* libguile/foreign-object.c (scm_make_foreign_object_n):
(scm_foreign_object_unsigned_ref, scm_foreign_object_unsigned_set_x):
Simplify.
---
libguile/foreign-object.c | 31 +++-----
libguile/goops.c | 8 +-
libguile/hash.c | 33 +++-----
libguile/struct.c | 187 ++++++++++++++--------------------------------
libguile/struct.h | 29 ++++---
libguile/vm-engine.c | 54 ++++++-------
6 files changed, 114 insertions(+), 228 deletions(-)
diff --git a/libguile/foreign-object.c b/libguile/foreign-object.c
index f074463..34b9f22 100644
--- a/libguile/foreign-object.c
+++ b/libguile/foreign-object.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2014 Free Software Foundation, Inc.
+/* Copyright (C) 2014, 2017 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -104,21 +104,16 @@ scm_make_foreign_object_n (SCM type, size_t n, void
*vals[])
#define FUNC_NAME "make-foreign-object"
{
SCM obj;
- SCM layout;
size_t i;
- const char *layout_chars;
SCM_VALIDATE_VTABLE (SCM_ARG1, type);
- layout = SCM_VTABLE_LAYOUT (type);
-
- if (scm_i_symbol_length (layout) / 2 < n)
+ if (SCM_VTABLE_SIZE (type) / 2 < n)
scm_out_of_range (FUNC_NAME, scm_from_size_t (n));
- layout_chars = scm_i_symbol_chars (layout);
for (i = 0; i < n; i++)
- if (layout_chars[i * 2] != 'u')
- scm_wrong_type_arg_msg (FUNC_NAME, 0, layout, "'u' field");
+ if (!SCM_VTABLE_FIELD_IS_UNBOXED (type, i))
+ scm_wrong_type_arg_msg (FUNC_NAME, 0, type, "foreign object type");
obj = scm_c_make_structv (type, 0, 0, NULL);
@@ -133,16 +128,13 @@ scm_t_bits
scm_foreign_object_unsigned_ref (SCM obj, size_t n)
#define FUNC_NAME "foreign-object-ref"
{
- SCM layout;
-
SCM_VALIDATE_STRUCT (SCM_ARG1, obj);
- layout = SCM_STRUCT_LAYOUT (obj);
- if (scm_i_symbol_length (layout) / 2 < n)
+ if (SCM_STRUCT_SIZE (obj) <= n)
scm_out_of_range (FUNC_NAME, scm_from_size_t (n));
- if (scm_i_symbol_ref (layout, n * 2) != 'u')
- scm_wrong_type_arg_msg (FUNC_NAME, 0, layout, "'u' field");
+ if (!SCM_STRUCT_FIELD_IS_UNBOXED (obj, n))
+ scm_wrong_type_arg_msg (FUNC_NAME, 0, scm_from_size_t (n), "unboxed
field");
return SCM_STRUCT_DATA_REF (obj, n);
}
@@ -152,16 +144,13 @@ void
scm_foreign_object_unsigned_set_x (SCM obj, size_t n, scm_t_bits val)
#define FUNC_NAME "foreign-object-set!"
{
- SCM layout;
-
SCM_VALIDATE_STRUCT (SCM_ARG1, obj);
- layout = SCM_STRUCT_LAYOUT (obj);
- if (scm_i_symbol_length (layout) / 2 < n)
+ if (SCM_STRUCT_SIZE (obj) <= n)
scm_out_of_range (FUNC_NAME, scm_from_size_t (n));
- if (scm_i_symbol_ref (layout, n * 2) != 'u')
- scm_wrong_type_arg_msg (FUNC_NAME, 0, layout, "'u' field");
+ if (!SCM_STRUCT_FIELD_IS_UNBOXED (obj, n))
+ scm_wrong_type_arg_msg (FUNC_NAME, 0, scm_from_size_t (n), "unboxed
field");
SCM_STRUCT_DATA_SET (obj, n, val);
}
diff --git a/libguile/goops.c b/libguile/goops.c
index e8ae001..40a93b1 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -475,17 +475,13 @@ SCM_DEFINE (scm_sys_clear_fields_x, "%clear-fields!", 2,
0, 0,
#define FUNC_NAME s_scm_sys_clear_fields_x
{
scm_t_signed_bits n, i;
- SCM vtable, layout;
SCM_VALIDATE_STRUCT (1, obj);
- vtable = SCM_STRUCT_VTABLE (obj);
-
- n = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
- layout = SCM_VTABLE_LAYOUT (vtable);
+ n = SCM_STRUCT_SIZE (obj);
/* Set all SCM-holding slots to the GOOPS unbound value. */
for (i = 0; i < n; i++)
- if (scm_i_symbol_ref (layout, i*2) == 'p')
+ if (!SCM_STRUCT_FIELD_IS_UNBOXED (obj, i))
SCM_STRUCT_SLOT_SET (obj, i, unbound);
return SCM_UNSPECIFIED;
diff --git a/libguile/hash.c b/libguile/hash.c
index 84285aa..93c6f7a 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -227,36 +227,21 @@ static unsigned long scm_raw_ihash (SCM obj, size_t
depth);
static unsigned long
scm_i_struct_hash (SCM obj, size_t depth)
{
- SCM layout;
- scm_t_bits *data;
size_t struct_size, field_num;
unsigned long hash;
- layout = SCM_STRUCT_LAYOUT (obj);
- struct_size = scm_i_symbol_length (layout) / 2;
- data = SCM_STRUCT_DATA (obj);
+ struct_size = SCM_STRUCT_SIZE (obj);
hash = scm_raw_ihashq (SCM_UNPACK (SCM_STRUCT_VTABLE (obj)));
if (depth > 0)
- for (field_num = 0; field_num < struct_size; field_num++)
- {
- int type;
- type = scm_i_symbol_ref (layout, field_num * 2);
- switch (type)
- {
- case 'p':
- hash ^= scm_raw_ihash (SCM_PACK (data[field_num]),
- depth / 2);
- break;
- case 'u':
- hash ^= scm_raw_ihashq (data[field_num]);
- break;
- default:
- abort ();
- }
- }
-
- /* FIXME: Tail elements should be taken into account. */
+ {
+ for (field_num = 0; field_num < struct_size; field_num++)
+ if (SCM_STRUCT_FIELD_IS_UNBOXED (obj, field_num))
+ hash ^= scm_raw_ihashq (SCM_STRUCT_DATA_REF (obj, field_num));
+ else
+ hash ^= scm_raw_ihash (SCM_STRUCT_SLOT_REF (obj, field_num),
+ depth / 2);
+ }
return hash;
}
diff --git a/libguile/struct.c b/libguile/struct.c
index 57195bc..e39f3c7 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -120,50 +120,35 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout",
1, 0, 0,
#undef FUNC_NAME
-/* Check whether VTABLE instances have a simple layout (i.e., either
- only "pr" or only "pw" fields) and update its flags accordingly. */
static void
-set_vtable_layout_flags (SCM vtable)
+set_vtable_access_fields (SCM vtable)
{
- size_t len, field;
+ size_t len, nfields, bitmask_size, field;
SCM layout;
const char *c_layout;
- scm_t_bits flags = SCM_VTABLE_FLAG_SIMPLE;
+ scm_t_uint32 *unboxed_fields;
layout = SCM_VTABLE_LAYOUT (vtable);
c_layout = scm_i_symbol_chars (layout);
len = scm_i_symbol_length (layout);
assert (len % 2 == 0);
+ nfields = len / 2;
- /* Update FLAGS according to LAYOUT. */
- for (field = 0;
- field < len && flags & SCM_VTABLE_FLAG_SIMPLE;
- field += 2)
- {
- if (c_layout[field] != 'p')
- flags = 0;
- else
- switch (c_layout[field + 1])
- {
- case 'w':
- case 'h':
- if (field == 0)
- flags |= SCM_VTABLE_FLAG_SIMPLE_RW;
- break;
-
- case 'r':
- flags &= ~SCM_VTABLE_FLAG_SIMPLE_RW;
- break;
+ bitmask_size = (nfields + 31U) / 32U;
+ unboxed_fields = scm_gc_malloc_pointerless (bitmask_size, "unboxed fields");
+ memset (unboxed_fields, 0, bitmask_size * sizeof(*unboxed_fields));
- default:
- abort ();
- }
- }
+ /* Update FLAGS according to LAYOUT. */
+ for (field = 0; field < nfields; field++)
+ if (c_layout[field*2] == 'u')
+ unboxed_fields[field/32U] |= 1U << (field%32U);
/* Record computed size of vtable's instances. */
- SCM_SET_VTABLE_FLAGS (vtable, flags);
+ SCM_SET_VTABLE_FLAGS (vtable, 0);
SCM_STRUCT_DATA_SET (vtable, scm_vtable_index_size, len / 2);
+ SCM_STRUCT_DATA_SET (vtable, scm_vtable_index_unboxed_fields,
+ (scm_t_uintptr) unboxed_fields);
}
static int
@@ -224,7 +209,7 @@ scm_i_struct_inherit_vtable_magic (SCM vtable, SCM obj)
SCM_MISC_ERROR ("invalid layout for new vtable: ~a",
scm_list_1 (SCM_VTABLE_LAYOUT (obj)));
- set_vtable_layout_flags (obj);
+ set_vtable_access_fields (obj);
/* If OBJ's vtable is compatible with the required vtable (class) layout, it
is a metaclass. */
@@ -271,56 +256,27 @@ scm_i_struct_inherit_vtable_magic (SCM vtable, SCM obj)
static void
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_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 i;
- size_t inits_idx = 0;
+ size_t n, n_fields, inits_idx = 0;
- i = -2;
- while (n_fields)
- {
- i += 2;
- prot = scm_i_symbol_ref (layout, i+1);
- switch (scm_i_symbol_ref (layout, i))
- {
- case 'u':
- if (prot == 'h' || inits_idx == n_inits)
- *mem = 0;
- else
- {
- *mem = scm_to_ulong (SCM_PACK (inits[inits_idx]));
- inits_idx++;
- }
- break;
-
- case 'p':
- if (prot == 'h' || inits_idx == n_inits)
- *mem = SCM_UNPACK (SCM_BOOL_F);
- else
- {
- *mem = inits[inits_idx];
- inits_idx++;
- }
-
- break;
- }
-
- n_fields--;
- mem++;
- }
+ n_fields = SCM_STRUCT_SIZE (handle);
+
+ for (n = 0; n < n_fields; n++)
+ {
+ if (inits_idx == n_inits || scm_i_symbol_ref (layout, n*2+1) == 'h')
+ {
+ if (SCM_STRUCT_FIELD_IS_UNBOXED (handle, n))
+ SCM_STRUCT_DATA_SET (handle, n, 0);
+ else
+ SCM_STRUCT_SLOT_SET (handle, n, SCM_BOOL_F);
+ }
+ else
+ {
+ SCM_STRUCT_DATA_SET (handle, n,
+ SCM_STRUCT_FIELD_IS_UNBOXED (handle, n)
+ ? scm_to_uintptr_t (SCM_PACK (inits[inits_idx]))
+ : inits[inits_idx]);
+ inits_idx++;
+ }
}
}
@@ -384,19 +340,17 @@ SCM
scm_c_make_structv (SCM vtable, size_t n_tail, size_t n_init, scm_t_bits *init)
#define FUNC_NAME "make-struct"
{
- SCM layout;
size_t basic_size;
SCM obj;
SCM_VALIDATE_VTABLE (1, vtable);
- layout = SCM_VTABLE_LAYOUT (vtable);
- basic_size = scm_i_symbol_length (layout) / 2;
+ basic_size = SCM_VTABLE_SIZE (vtable);
SCM_ASSERT (n_tail == 0, scm_from_size_t (n_tail), 2, FUNC_NAME);
obj = scm_i_alloc_struct (SCM_UNPACK (vtable), basic_size);
- scm_struct_init (obj, layout, n_init, init);
+ scm_struct_init (obj, SCM_VTABLE_LAYOUT (vtable), n_init, init);
/* If we're making a vtable, validate its layout and inherit
flags. However we allow for separation of allocation and
@@ -450,19 +404,10 @@ SCM_DEFINE (scm_allocate_struct, "allocate-struct", 2, 0,
0,
SCM_VALIDATE_VTABLE (1, vtable);
c_nfields = scm_to_size_t (nfields);
- SCM_ASSERT (SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size) == c_nfields,
- nfields, 2, FUNC_NAME);
+ SCM_ASSERT (SCM_VTABLE_SIZE (vtable) == c_nfields, nfields, 2, FUNC_NAME);
ret = scm_i_alloc_struct (SCM_UNPACK (vtable), c_nfields);
-
- if (SCM_LIKELY (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE)))
- {
- size_t n;
- for (n = 0; n < c_nfields; n++)
- SCM_STRUCT_DATA_SET (ret, n, SCM_UNPACK (SCM_BOOL_F));
- }
- else
- scm_struct_init (ret, SCM_VTABLE_LAYOUT (vtable), 0, NULL);
+ scm_struct_init (ret, SCM_VTABLE_LAYOUT (vtable), 0, NULL);
return ret;
}
@@ -526,19 +471,18 @@ scm_i_make_vtable_vtable (SCM fields)
SCM_SET_CELL_WORD_0 (obj, SCM_UNPACK (obj) | scm_tc3_struct);
/* 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);
+ set_vtable_access_fields (obj);
+ SCM_SET_VTABLE_FLAGS (obj, 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
+ if (SCM_STRUCT_FIELD_IS_UNBOXED (obj, n))
SCM_STRUCT_DATA_SET (obj, n, 0);
+ else
+ SCM_STRUCT_SLOT_SET (obj, n, SCM_BOOL_F);
return obj;
}
@@ -570,20 +514,15 @@ SCM
scm_i_struct_equalp (SCM s1, SCM s2)
#define FUNC_NAME "scm_i_struct_equalp"
{
- SCM vtable1, vtable2, layout;
size_t struct_size, field_num;
SCM_VALIDATE_STRUCT (1, s1);
SCM_VALIDATE_STRUCT (2, s2);
- vtable1 = SCM_STRUCT_VTABLE (s1);
- vtable2 = SCM_STRUCT_VTABLE (s2);
-
- if (!scm_is_eq (vtable1, vtable2))
+ if (!scm_is_eq (SCM_STRUCT_VTABLE (s1), SCM_STRUCT_VTABLE (s2)))
return SCM_BOOL_F;
- layout = SCM_STRUCT_LAYOUT (s1);
- struct_size = scm_i_symbol_length (layout) / 2;
+ struct_size = SCM_STRUCT_SIZE (s1);
for (field_num = 0; field_num < struct_size; field_num++)
{
@@ -593,7 +532,7 @@ scm_i_struct_equalp (SCM s1, SCM s2)
field2 = SCM_STRUCT_DATA_REF (s2, field_num);
if (field1 != field2) {
- if (scm_i_symbol_ref (layout, field_num * 2) == 'u')
+ if (SCM_STRUCT_FIELD_IS_UNBOXED (s1, field_num))
return SCM_BOOL_F;
/* Having a normal field point to the object itself is a bit
@@ -629,20 +568,16 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
"word.")
#define FUNC_NAME s_scm_struct_ref
{
- SCM vtable, layout;
size_t nfields, p;
SCM_VALIDATE_STRUCT (1, handle);
- vtable = SCM_STRUCT_VTABLE (handle);
- layout = SCM_VTABLE_LAYOUT (vtable);
- nfields = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
+ nfields = SCM_STRUCT_SIZE (handle);
p = scm_to_size_t (pos);
SCM_ASSERT_RANGE (2, pos, p < nfields);
- /* Only 'p' fields. */
- SCM_ASSERT (scm_i_symbol_ref (layout, p * 2) == 'p', layout, 0, FUNC_NAME);
+ SCM_ASSERT (!SCM_STRUCT_FIELD_IS_UNBOXED (handle, p), pos, 2, FUNC_NAME);
return SCM_STRUCT_SLOT_REF (handle, p);
}
@@ -656,20 +591,16 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
"to.")
#define FUNC_NAME s_scm_struct_set_x
{
- SCM vtable, layout;
size_t nfields, p;
SCM_VALIDATE_STRUCT (1, handle);
- vtable = SCM_STRUCT_VTABLE (handle);
- layout = SCM_VTABLE_LAYOUT (vtable);
- nfields = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
+ nfields = SCM_STRUCT_SIZE (handle);
p = scm_to_size_t (pos);
SCM_ASSERT_RANGE (2, pos, p < nfields);
- /* Only 'p' fields. */
- SCM_ASSERT (scm_i_symbol_ref (layout, p * 2) == 'p', layout, 0, FUNC_NAME);
+ SCM_ASSERT (!SCM_STRUCT_FIELD_IS_UNBOXED (handle, p), pos, 2, FUNC_NAME);
SCM_STRUCT_SLOT_SET (handle, p, val);
@@ -684,20 +615,16 @@ SCM_DEFINE (scm_struct_ref_unboxed, "struct-ref/unboxed",
2, 0, 0,
"@var{handle}. The field must be of type 'u'.")
#define FUNC_NAME s_scm_struct_ref_unboxed
{
- SCM vtable, layout;
size_t nfields, p;
SCM_VALIDATE_STRUCT (1, handle);
- vtable = SCM_STRUCT_VTABLE (handle);
- layout = SCM_VTABLE_LAYOUT (vtable);
- nfields = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
+ nfields = SCM_STRUCT_SIZE (handle);
p = scm_to_size_t (pos);
SCM_ASSERT_RANGE (2, pos, p < nfields);
- /* Only 'u' fields. */
- SCM_ASSERT (scm_i_symbol_ref (layout, p * 2) == 'u', layout, 0, FUNC_NAME);
+ SCM_ASSERT (SCM_STRUCT_FIELD_IS_UNBOXED (handle, p), pos, 2, FUNC_NAME);
return scm_from_uintptr_t (SCM_STRUCT_DATA_REF (handle, p));
}
@@ -711,20 +638,16 @@ SCM_DEFINE (scm_struct_set_x_unboxed,
"struct-set!/unboxed", 3, 0, 0,
"to.")
#define FUNC_NAME s_scm_struct_set_x_unboxed
{
- SCM vtable, layout;
size_t nfields, p;
SCM_VALIDATE_STRUCT (1, handle);
- vtable = SCM_STRUCT_VTABLE (handle);
- layout = SCM_VTABLE_LAYOUT (vtable);
- nfields = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
+ nfields = SCM_STRUCT_SIZE (handle);
p = scm_to_size_t (pos);
SCM_ASSERT_RANGE (2, pos, p < nfields);
- /* Only 'u' fields. */
- SCM_ASSERT (scm_i_symbol_ref (layout, p * 2) == 'u', layout, 0, FUNC_NAME);
+ SCM_ASSERT (SCM_STRUCT_FIELD_IS_UNBOXED (handle, p), pos, 2, FUNC_NAME);
SCM_STRUCT_DATA_SET (handle, p, scm_to_uintptr_t (val));
diff --git a/libguile/struct.h b/libguile/struct.h
index 66c1740..d88944c 100644
--- a/libguile/struct.h
+++ b/libguile/struct.h
@@ -61,7 +61,7 @@
"pw" /* printer */ \
"ph" /* name (hidden from make-struct for back-compat reasons) */ \
"uh" /* size */ \
- "uh" /* reserved */ \
+ "uh" /* unboxed fields */ \
"uh" /* reserved */
#define scm_vtable_index_layout 0 /* A symbol describing the
physical arrangement of this type. */
@@ -70,7 +70,7 @@
#define scm_vtable_index_instance_printer 3 /* A printer for this struct
type. */
#define scm_vtable_index_name 4 /* Name of this vtable. */
#define scm_vtable_index_size 5 /* Number of fields, for simple
structs. */
-#define scm_vtable_index_reserved_6 6
+#define scm_vtable_index_unboxed_fields 6 /* Raw scm_t_uint32* bitmask
indicating unboxed fields. */
#define scm_vtable_index_reserved_7 7
#define scm_vtable_offset_user 8 /* Where do user fields start in
the vtable? */
@@ -95,16 +95,16 @@
#define SCM_VTABLE_FLAG_APPLICABLE (1L << 3) /* instances of this vtable are
applicable? */
#define SCM_VTABLE_FLAG_SETTER_VTABLE (1L << 4) /* instances of this vtable
are applicable-with-setter vtables? */
#define SCM_VTABLE_FLAG_SETTER (1L << 5) /* instances of this vtable are
applicable-with-setters? */
-#define SCM_VTABLE_FLAG_SIMPLE (1L << 6) /* instances of this vtable have only
"p" fields and no tail array*/
-#define SCM_VTABLE_FLAG_SIMPLE_RW (1L << 7) /* instances of this vtable have
only "pw" fields and no tail array */
-#define SCM_VTABLE_FLAG_RESERVED_0 (1L << 8)
-#define SCM_VTABLE_FLAG_RESERVED_1 (1L << 9)
-#define SCM_VTABLE_FLAG_SMOB_0 (1L << 10)
-#define SCM_VTABLE_FLAG_GOOPS_0 (1L << 11)
-#define SCM_VTABLE_FLAG_GOOPS_1 (1L << 12)
-#define SCM_VTABLE_FLAG_GOOPS_2 (1L << 13)
-#define SCM_VTABLE_FLAG_GOOPS_3 (1L << 14)
-#define SCM_VTABLE_FLAG_GOOPS_4 (1L << 15)
+#define SCM_VTABLE_FLAG_RESERVED_0 (1L << 6)
+#define SCM_VTABLE_FLAG_RESERVED_1 (1L << 7)
+#define SCM_VTABLE_FLAG_SMOB_0 (1L << 8)
+#define SCM_VTABLE_FLAG_GOOPS_0 (1L << 9)
+#define SCM_VTABLE_FLAG_GOOPS_1 (1L << 10)
+#define SCM_VTABLE_FLAG_GOOPS_2 (1L << 11)
+#define SCM_VTABLE_FLAG_GOOPS_3 (1L << 12)
+#define SCM_VTABLE_FLAG_GOOPS_4 (1L << 13)
+#define SCM_VTABLE_FLAG_RESERVED_2 (1L << 14)
+#define SCM_VTABLE_FLAG_RESERVED_3 (1L << 15)
#define SCM_VTABLE_USER_FLAG_SHIFT 16
typedef void (*scm_t_struct_finalize) (SCM obj);
@@ -131,13 +131,18 @@ typedef void (*scm_t_struct_finalize) (SCM obj);
#define SCM_SET_VTABLE_INSTANCE_PRINTER(X,P) (SCM_STRUCT_SLOT_SET (X,
scm_vtable_index_instance_printer, (P)))
#define SCM_VTABLE_NAME(X) (SCM_STRUCT_SLOT_REF (X,
scm_vtable_index_name))
#define SCM_SET_VTABLE_NAME(X,V) (SCM_STRUCT_SLOT_SET (X,
scm_vtable_index_name, V))
+#define SCM_VTABLE_SIZE(X) (SCM_STRUCT_DATA_REF (X,
scm_vtable_index_size))
+#define SCM_VTABLE_UNBOXED_FIELDS(X) ((scm_t_uint32*) SCM_STRUCT_DATA_REF
(X, scm_vtable_index_unboxed_fields))
+#define SCM_VTABLE_FIELD_IS_UNBOXED(X,F) (SCM_VTABLE_UNBOXED_FIELDS
(X)[(F)>>5]&(1U<<((F)&31)))
#define SCM_STRUCT_VTABLE(X) (SCM_PACK (SCM_CELL_WORD_0 (X) -
scm_tc3_struct))
#define SCM_STRUCT_LAYOUT(X) (SCM_VTABLE_LAYOUT (SCM_STRUCT_VTABLE
(X)))
+#define SCM_STRUCT_SIZE(X) (SCM_VTABLE_SIZE (SCM_STRUCT_VTABLE
(X)))
#define SCM_STRUCT_PRINTER(X) (SCM_VTABLE_INSTANCE_PRINTER
(SCM_STRUCT_VTABLE (X)))
#define SCM_STRUCT_FINALIZER(X) (SCM_VTABLE_INSTANCE_FINALIZER
(SCM_STRUCT_VTABLE (X)))
#define SCM_STRUCT_VTABLE_FLAGS(X) (SCM_VTABLE_FLAGS (SCM_STRUCT_VTABLE
(X)))
#define SCM_STRUCT_VTABLE_FLAG_IS_SET(X,F) (SCM_VTABLE_FLAG_IS_SET
(SCM_STRUCT_VTABLE (X), (F)))
+#define SCM_STRUCT_FIELD_IS_UNBOXED(X,F) (SCM_VTABLE_FIELD_IS_UNBOXED
(SCM_STRUCT_VTABLE (X), (F)))
#define SCM_STRUCT_APPLICABLE_P(X) (SCM_STRUCT_VTABLE_FLAG_IS_SET ((X),
SCM_VTABLE_FLAG_APPLICABLE))
#define SCM_STRUCT_SETTER_P(X) (SCM_STRUCT_VTABLE_FLAG_IS_SET
((X), SCM_VTABLE_FLAG_SETTER))
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 6e0bfc5..94bf352 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -441,12 +441,12 @@
#define VM_VALIDATE_INDEX(u64, size, proc) \
VM_ASSERT (u64 < size, vm_error_out_of_range_uint64 (proc, u64))
-#define VM_VALIDATE_BOXED_STRUCT_FIELD(layout, i, proc) \
- VM_ASSERT (scm_i_symbol_ref (layout, i * 2) == 'p', \
+#define VM_VALIDATE_BOXED_STRUCT_FIELD(obj, i, proc) \
+ VM_ASSERT (!SCM_STRUCT_FIELD_IS_UNBOXED (obj, i), \
+ vm_error_boxed_struct_field (proc, i))
+#define VM_VALIDATE_UNBOXED_STRUCT_FIELD(obj, i, proc) \
+ VM_ASSERT (SCM_STRUCT_FIELD_IS_UNBOXED (obj, i), \
vm_error_boxed_struct_field (proc, i))
-#define VM_VALIDATE_UNBOXED_STRUCT_FIELD(layout, i, proc) \
- VM_ASSERT (scm_i_symbol_ref (layout, i * 2) == 'u', \
- vm_error_unboxed_struct_field (proc, i))
/* Return true (non-zero) if PTR has suitable alignment for TYPE. */
#define ALIGNED_P(ptr, type) \
@@ -2775,8 +2775,8 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
VM_DEFINE_OP (108, struct_ref, "struct-ref", OP1 (X8_S8_S8_S8) | OP_DST)
{
scm_t_uint8 dst, src, idx;
- SCM obj, vtable;
- scm_t_uint64 index, nfields;
+ SCM obj;
+ scm_t_uint64 index;
UNPACK_8_8_8 (op, dst, src, idx);
@@ -2784,11 +2784,8 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
index = SP_REF_U64 (idx);
VM_VALIDATE_STRUCT (obj, "struct-ref");
- vtable = SCM_STRUCT_VTABLE (obj);
- nfields = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
- VM_VALIDATE_INDEX (index, nfields, "struct-ref");
- VM_VALIDATE_BOXED_STRUCT_FIELD (SCM_VTABLE_LAYOUT (vtable),
- index, "struct-ref");
+ VM_VALIDATE_INDEX (index, SCM_STRUCT_SIZE (obj), "struct-ref");
+ VM_VALIDATE_BOXED_STRUCT_FIELD (obj, index, "struct-ref");
RETURN (SCM_STRUCT_SLOT_REF (obj, index));
}
@@ -2800,8 +2797,8 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
VM_DEFINE_OP (109, struct_set, "struct-set!", OP1 (X8_S8_S8_S8))
{
scm_t_uint8 dst, idx, src;
- SCM obj, vtable, val;
- scm_t_uint64 index, nfields;
+ SCM obj, val;
+ scm_t_uint64 index;
UNPACK_8_8_8 (op, dst, idx, src);
@@ -2810,11 +2807,8 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
index = SP_REF_U64 (idx);
VM_VALIDATE_STRUCT (obj, "struct-set!");
- vtable = SCM_STRUCT_VTABLE (obj);
- nfields = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
- VM_VALIDATE_INDEX (index, nfields, "struct-set!");
- VM_VALIDATE_BOXED_STRUCT_FIELD (SCM_VTABLE_LAYOUT (vtable),
- index, "struct-set!");
+ VM_VALIDATE_INDEX (index, SCM_STRUCT_SIZE (obj), "struct-set!");
+ VM_VALIDATE_BOXED_STRUCT_FIELD (obj, index, "struct-set!");
SCM_STRUCT_SLOT_SET (obj, index, val);
NEXT (1);
@@ -2848,8 +2842,8 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
VM_DEFINE_OP (111, struct_ref_immediate, "struct-ref/immediate", OP1
(X8_S8_S8_C8) | OP_DST)
{
scm_t_uint8 dst, src, idx;
- SCM obj, vtable;
- scm_t_uint64 index, nfields;
+ SCM obj;
+ scm_t_uint64 index;
UNPACK_8_8_8 (op, dst, src, idx);
@@ -2857,11 +2851,8 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
index = idx;
VM_VALIDATE_STRUCT (obj, "struct-ref");
- vtable = SCM_STRUCT_VTABLE (obj);
- nfields = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
- VM_VALIDATE_INDEX (index, nfields, "struct-ref");
- VM_VALIDATE_BOXED_STRUCT_FIELD (SCM_VTABLE_LAYOUT (vtable),
- index, "struct-ref");
+ VM_VALIDATE_INDEX (index, SCM_STRUCT_SIZE (obj), "struct-ref");
+ VM_VALIDATE_BOXED_STRUCT_FIELD (obj, index, "struct-ref");
RETURN (SCM_STRUCT_SLOT_REF (obj, index));
}
@@ -2874,8 +2865,8 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
VM_DEFINE_OP (112, struct_set_immediate, "struct-set!/immediate", OP1
(X8_S8_C8_S8))
{
scm_t_uint8 dst, idx, src;
- SCM obj, vtable, val;
- scm_t_uint64 index, nfields;
+ SCM obj, val;
+ scm_t_uint64 index;
UNPACK_8_8_8 (op, dst, idx, src);
@@ -2884,11 +2875,8 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
index = idx;
VM_VALIDATE_STRUCT (obj, "struct-set!");
- vtable = SCM_STRUCT_VTABLE (obj);
- nfields = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
- VM_VALIDATE_INDEX (index, nfields, "struct-set!");
- VM_VALIDATE_BOXED_STRUCT_FIELD (SCM_VTABLE_LAYOUT (vtable),
- index, "struct-set!");
+ VM_VALIDATE_INDEX (index, SCM_STRUCT_SIZE (obj), "struct-set!");
+ VM_VALIDATE_BOXED_STRUCT_FIELD (obj, index, "struct-set!");
SCM_STRUCT_SLOT_SET (obj, index, val);
NEXT (1);