From 14d102920fea11039cdae7fe05a2dc56f7e1264a Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 21 Jul 2013 16:17:59 +0200 Subject: [PATCH] add allocate-struct primitive and rtl opcode * libguile/struct.h: * libguile/struct.c (scm_allocate_struct): New interface: allocates a struct. * libguile/vm-engine.c (allocate_struct): Instead of make-struct with a rest arg, separate allocation from initialization. --- libguile/struct.c | 36 +++++++++++++++++++++++++++++++++ libguile/struct.h | 1 + libguile/vm-engine.c | 47 +++++++++++--------------------------------- 3 files changed, 48 insertions(+), 36 deletions(-) diff --git a/libguile/struct.c b/libguile/struct.c index c7f410b63..1b61aa4af 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -517,6 +517,42 @@ scm_c_make_struct (SCM vtable, size_t n_tail, size_t n_init, scm_t_bits init, .. return scm_c_make_structv (vtable, n_tail, n_init, v); } +SCM_DEFINE (scm_allocate_struct, "allocate-struct", 2, 0, 0, + (SCM vtable, SCM nfields), + "Allocate a new structure with space for @var{nfields} fields.\n\n" + "@var{vtable} must be a vtable structure (@pxref{Vtables}).\n\n" + "@var{nfields} must be a non-negative integer. Strictly speaking\n" + "@var{nfields} is redundant, as the vtable carries the size\n" + "for its instances. However passing it is useful as a sanity\n" + "check, given that one module can inline a constructor in\n" + "another.\n\n" + "Fields will be initialized with their default values.") +#define FUNC_NAME s_scm_allocate_struct +{ + SCM ret; + size_t c_nfields; + + 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); + + ret = scm_i_alloc_struct (SCM_STRUCT_DATA (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, 0, NULL); + + return ret; +} +#undef FUNC_NAME + SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1, (SCM vtable, SCM tail_array_size, SCM init), "Create a new structure.\n\n" diff --git a/libguile/struct.h b/libguile/struct.h index 0aecfb979..f1f6c4768 100644 --- a/libguile/struct.h +++ b/libguile/struct.h @@ -174,6 +174,7 @@ SCM_API SCM scm_applicable_struct_with_setter_vtable_vtable; SCM_API SCM scm_make_struct_layout (SCM fields); SCM_API SCM scm_struct_p (SCM x); SCM_API SCM scm_struct_vtable_p (SCM x); +SCM_INTERNAL SCM scm_allocate_struct (SCM vtable, SCM n_words); SCM_API SCM scm_make_struct (SCM vtable, SCM tail_array_size, SCM init); SCM_API SCM scm_c_make_struct (SCM vtable, size_t n_tail, size_t n_inits, scm_t_bits init, ...); diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 822280962..1300a1e5b 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -3090,50 +3090,25 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) RETURN (SCM_STRUCT_VTABLE (obj)); } - /* make-struct dst:12 vtable:12 _:8 n-init:24 init0:24 0:8 ... + /* allocate-struct dst:8 vtable:8 nfields:8 * - * Make a new struct with VTABLE, and place it in DST. The struct - * will be constructed with N-INIT initializers, which are located in - * the locals given by INIT0.... The format of INIT0... is as in the - * "call" opcode: unsigned 24-bit values, with 0 in the high byte. + * Allocate a new struct with VTABLE, and place it in DST. The struct + * will be constructed with space for NFIELDS fields, which should + * correspond to the field count of the VTABLE. */ - VM_DEFINE_OP (102, make_struct, "make-struct", OP2 (U8_U12_U12, X8_R24)) -#if 0 + VM_DEFINE_OP (102, allocate_struct, "allocate-struct", OP1 (U8_U8_U8_U8) | OP_DST) { - scm_t_uint16 dst, vtable_r; - scm_t_uint32 n_init, n; - SCM vtable, ret; + scm_t_uint8 dst, vtable, nfields; + SCM ret; - SCM_UNPACK_RTL_12_12 (op, dst, vtable_r); - vtable = LOCAL_REF (vtable_r); - SCM_UNPACK_RTL_24 (ip[1], n_init); + SCM_UNPACK_RTL_8_8_8 (op, dst, vtable, nfields); SYNC_IP (); - - if (SCM_LIKELY (SCM_STRUCTP (vtable) - && SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE) - && (SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size) - == n_init) - && !SCM_VTABLE_INSTANCE_FINALIZER (vtable))) - { - /* Verily, we are making a simple struct with the right number of - initializers, and no finalizer. */ - ret = scm_words ((scm_t_bits)SCM_STRUCT_DATA (vtable) | scm_tc3_struct, - n_init + 2); - SCM_SET_CELL_WORD_1 (ret, (scm_t_bits)SCM_CELL_OBJECT_LOC (ret, 2)); - - for (n = 0; n < n_init; n++) - SCM_STRUCT_DATA (ret)[n] = SCM_UNPACK (LOCAL_REF (ip[n + 1])); - } - else - ret = scm_c_make_structvs (vtable, fp, &ip[1], n_init); - + ret = scm_allocate_struct (LOCAL_REF (vtable), SCM_I_MAKINUM (nfields)); LOCAL_SET (dst, ret); - NEXT (n_init + 1); + + NEXT (1); } -#else - abort (); -#endif /* struct-ref dst:8 src:8 idx:8 * -- 2.20.1