From 214e887dbdece2e7608b02dd1ce5b31e710266cc Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 26 Sep 2017 21:56:31 +0200 Subject: 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 ++++++++++--------------------- 1 file changed, 10 insertions(+), 21 deletions(-) (limited to 'libguile/foreign-object.c') diff --git a/libguile/foreign-object.c b/libguile/foreign-object.c index f074463a1..34b9f22ca 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); } -- cgit v1.2.3