wingo pushed a commit to branch wip-whippet
in repository guile.
commit ce2f7847e8c8c116f470cf504891dd0aa5895805
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Fri Jun 20 09:27:47 2025 +0200
Avoid untagged traced allocation in make-struct/no-tail
* libguile/struct.c (scm_struct_init_1_default):
(scm_struct_init_1): New helpers.
(scm_struct_init_array): Use new helpers.
(scm_struct_init_list): New function.
(scm_make_struct_no_tail): Use scm_struct_init_list instead of mallocing.
---
libguile/struct.c | 82 +++++++++++++++++++++++++++++++++----------------------
1 file changed, 50 insertions(+), 32 deletions(-)
diff --git a/libguile/struct.c b/libguile/struct.c
index cdbe8f47f..7ba242a23 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -255,7 +255,25 @@ 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_struct_init_1_default (SCM handle, size_t idx)
+{
+ SCM_STRUCT_DATA_SET (handle, idx,
+ SCM_STRUCT_FIELD_IS_UNBOXED (handle, idx)
+ ? 0
+ : SCM_UNPACK (SCM_BOOL_F));
+}
+
+static void
+scm_struct_init_1 (SCM handle, size_t idx, scm_t_bits val)
+{
+ SCM_STRUCT_DATA_SET (handle, idx,
+ SCM_STRUCT_FIELD_IS_UNBOXED (handle, idx)
+ ? scm_to_uintptr_t (SCM_PACK (val))
+ : val);
+}
+
+static void
+scm_struct_init_array (SCM handle, SCM layout, size_t n_inits, scm_t_bits
*inits)
{
size_t n, n_fields, inits_idx = 0;
@@ -264,24 +282,29 @@ scm_struct_init (SCM handle, SCM layout, size_t n_inits,
scm_t_bits *inits)
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);
- }
+ scm_struct_init_1_default (handle, n);
+ else
+ scm_struct_init_1 (handle, n, inits[inits_idx++]);
+ }
+}
+
+static void
+scm_struct_init_list (SCM handle, SCM layout, SCM inits)
+{
+ size_t n_fields = SCM_STRUCT_SIZE (handle);
+
+ for (size_t n = 0; n < n_fields; n++)
+ {
+ if (scm_is_null (inits) || scm_i_symbol_ref (layout, n*2+1) == 'h')
+ scm_struct_init_1_default (handle, n);
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++;
+ scm_struct_init_1 (handle, n, SCM_UNPACK (scm_car (inits)));
+ inits = scm_cdr (inits);
}
}
}
-
SCM_DEFINE (scm_struct_p, "struct?", 1, 0, 0,
(SCM x),
"Return @code{#t} iff @var{x} is a structure object, else\n"
@@ -350,7 +373,7 @@ scm_c_make_structv (SCM vtable, size_t n_tail, size_t
n_init, scm_t_bits *init)
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, SCM_VTABLE_LAYOUT (vtable), n_init, init);
+ scm_struct_init_array (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
@@ -407,7 +430,7 @@ SCM_DEFINE (scm_allocate_struct, "allocate-struct", 2, 0, 0,
SCM_ASSERT (SCM_VTABLE_SIZE (vtable) == c_nfields, nfields, 2, FUNC_NAME);
ret = scm_i_alloc_struct (SCM_UNPACK (vtable), c_nfields);
- scm_struct_init (ret, SCM_VTABLE_LAYOUT (vtable), 0, NULL);
+ scm_struct_init_array (ret, SCM_VTABLE_LAYOUT (vtable), 0, NULL);
return ret;
}
@@ -464,28 +487,23 @@ SCM_DEFINE (scm_make_struct_no_tail,
"make-struct/no-tail", 1, 0, 1,
"initialized to 0.")
#define FUNC_NAME s_scm_make_struct_no_tail
{
- size_t i, n_init;
- long ilen;
- scm_t_bits *v;
-
SCM_VALIDATE_VTABLE (1, vtable);
- ilen = scm_ilength (init);
- if (ilen < 0)
+
+ if (scm_ilength (init) < 0)
SCM_MISC_ERROR ("Rest arguments do not form a proper list.", SCM_EOL);
- n_init = (size_t)ilen;
-
- /* best to use alloca, but init could be big, so hack to avoid a possible
- stack overflow */
- if (n_init < 64)
- v = alloca (n_init * sizeof(scm_t_bits));
- else
- v = scm_gc_malloc (n_init * sizeof(scm_t_bits), "struct");
+ SCM obj = scm_i_alloc_struct (SCM_UNPACK (vtable), SCM_VTABLE_SIZE (vtable));
+ scm_struct_init_list (obj, SCM_VTABLE_LAYOUT (vtable), init);
- for (i = 0; i < n_init; i++, init = SCM_CDR (init))
- v[i] = SCM_UNPACK (SCM_CAR (init));
+ /* If we're making a vtable, validate its layout and inherit
+ flags. However we allow for separation of allocation and
+ initialization, to humor GOOPS, so only validate if the layout was
+ passed as an initarg. */
+ if (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_VTABLE)
+ && scm_is_true (SCM_VTABLE_LAYOUT (obj)))
+ scm_i_struct_inherit_vtable_magic (vtable, obj);
- return scm_c_make_structv (vtable, 0, n_init, v);
+ return obj;
}
#undef FUNC_NAME
