mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-02 04:40:29 +02:00
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.
This commit is contained in:
parent
b21713128e
commit
14d102920f
3 changed files with 48 additions and 36 deletions
|
@ -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);
|
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_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
|
||||||
(SCM vtable, SCM tail_array_size, SCM init),
|
(SCM vtable, SCM tail_array_size, SCM init),
|
||||||
"Create a new structure.\n\n"
|
"Create a new structure.\n\n"
|
||||||
|
|
|
@ -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_make_struct_layout (SCM fields);
|
||||||
SCM_API SCM scm_struct_p (SCM x);
|
SCM_API SCM scm_struct_p (SCM x);
|
||||||
SCM_API SCM scm_struct_vtable_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_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_API SCM scm_c_make_struct (SCM vtable, size_t n_tail, size_t n_inits,
|
||||||
scm_t_bits init, ...);
|
scm_t_bits init, ...);
|
||||||
|
|
|
@ -3090,50 +3090,25 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
|
||||||
RETURN (SCM_STRUCT_VTABLE (obj));
|
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
|
* Allocate a new struct with VTABLE, and place it in DST. The struct
|
||||||
* will be constructed with N-INIT initializers, which are located in
|
* will be constructed with space for NFIELDS fields, which should
|
||||||
* the locals given by INIT0.... The format of INIT0... is as in the
|
* correspond to the field count of the VTABLE.
|
||||||
* "call" opcode: unsigned 24-bit values, with 0 in the high byte.
|
|
||||||
*/
|
*/
|
||||||
VM_DEFINE_OP (102, make_struct, "make-struct", OP2 (U8_U12_U12, X8_R24))
|
VM_DEFINE_OP (102, allocate_struct, "allocate-struct", OP1 (U8_U8_U8_U8) | OP_DST)
|
||||||
#if 0
|
|
||||||
{
|
{
|
||||||
scm_t_uint16 dst, vtable_r;
|
scm_t_uint8 dst, vtable, nfields;
|
||||||
scm_t_uint32 n_init, n;
|
SCM ret;
|
||||||
SCM vtable, ret;
|
|
||||||
|
|
||||||
SCM_UNPACK_RTL_12_12 (op, dst, vtable_r);
|
SCM_UNPACK_RTL_8_8_8 (op, dst, vtable, nfields);
|
||||||
vtable = LOCAL_REF (vtable_r);
|
|
||||||
SCM_UNPACK_RTL_24 (ip[1], n_init);
|
|
||||||
|
|
||||||
SYNC_IP ();
|
SYNC_IP ();
|
||||||
|
ret = scm_allocate_struct (LOCAL_REF (vtable), SCM_I_MAKINUM (nfields));
|
||||||
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);
|
|
||||||
|
|
||||||
LOCAL_SET (dst, ret);
|
LOCAL_SET (dst, ret);
|
||||||
NEXT (n_init + 1);
|
|
||||||
|
NEXT (1);
|
||||||
}
|
}
|
||||||
#else
|
|
||||||
abort ();
|
|
||||||
#endif
|
|
||||||
|
|
||||||
/* struct-ref dst:8 src:8 idx:8
|
/* struct-ref dst:8 src:8 idx:8
|
||||||
*
|
*
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue