wingo pushed a commit to branch wip-whippet
in repository guile.
commit 8623e252bf65c60fedf0e2001cc79fab846bcc81
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Thu Jul 3 10:10:20 2025 +0200
Separate tagged and untagged pointerless allocations
Tagged allocations can move; untagged allocations cannot.
* libguile/gc-inline.h:
* libguile/gc-malloc.c:
* libguile/gc.h: Split scm_allocate_pointerless into tagged and untagged
variants.
* libguile/bitvectors.c:
* libguile/bytevectors.c:
* libguile/foreign.c:
* libguile/fports.c:
* libguile/integers.c:
* libguile/intrinsics.c:
* libguile/load.c:
* libguile/loader.c:
* libguile/numbers.c:
* libguile/programs.h:
* libguile/random.c:
* libguile/read.c:
* libguile/regex-posix.c:
* libguile/smob.c:
* libguile/strings.c:
* libguile/vm.c: Use the new functions.
---
libguile/bitvectors.c | 6 +++---
libguile/bytevectors.c | 4 ++--
libguile/foreign.c | 5 +++--
libguile/fports.c | 4 ++--
libguile/gc-inline.h | 15 +++++++++++----
libguile/gc-malloc.c | 22 ++++++++++++++--------
libguile/gc.h | 3 ++-
libguile/integers.c | 3 ++-
libguile/intrinsics.c | 4 ++--
libguile/load.c | 4 ++--
libguile/loader.c | 6 +++---
libguile/numbers.c | 26 +++++++++++---------------
libguile/programs.h | 3 +--
libguile/random.c | 12 ++++++------
libguile/read.c | 9 +++++----
libguile/regex-posix.c | 3 +--
libguile/smob.c | 4 ++--
libguile/strings.c | 10 ++++++----
libguile/vm.c | 2 +-
19 files changed, 79 insertions(+), 66 deletions(-)
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
index bad5ce429..c5c609ff4 100644
--- a/libguile/bitvectors.c
+++ b/libguile/bitvectors.c
@@ -109,9 +109,9 @@ make_bitvector (size_t len, int fill)
size_t word_len = bit_count_to_word_count (len);
struct scm_bitvector *bv;
- bv = scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
- sizeof (struct scm_bitvector)
- + sizeof (scm_t_bits) * word_len);
+ bv = scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD,
+ sizeof (struct scm_bitvector)
+ + sizeof (scm_t_bits) * word_len);
bv->tag_and_flags = scm_tc7_bitvector;
bv->length = len;
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index 82132193c..616f200ac 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -233,8 +233,8 @@ make_bytevector (size_t len, scm_t_array_element_type
element_type)
size_t c_len = len * bytes_per_elt;
struct scm_bytevector *bv =
- scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
- sizeof (struct scm_bytevector) + c_len);
+ scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD,
+ sizeof (struct scm_bytevector) + c_len);
scm_t_bits flags = SCM_F_BYTEVECTOR_CONTIGUOUS;
bv->tag_flags_and_element_type = make_bytevector_tag (flags, element_type);
diff --git a/libguile/foreign.c b/libguile/foreign.c
index 4a288d02c..3002ed1e8 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -817,7 +817,7 @@ make_cif (SCM return_type, SCM arg_types, const char
*caller)
cif_len = (ROUND_UP (cif_len, alignof_type (ffi_type))
+ (nargs + n_struct_elts + 1)*sizeof(ffi_type));
- mem = scm_allocate_pointerless (SCM_I_CURRENT_THREAD, cif_len);
+ mem = scm_allocate_untagged_pointerless (SCM_I_CURRENT_THREAD, cif_len);
/* ensure all the memory is initialized, even the holes */
memset (mem, 0, cif_len);
cif = (ffi_cif *) mem;
@@ -1133,7 +1133,8 @@ pack (const ffi_type * type, const void *loc, int
return_value_p)
case FFI_TYPE_STRUCT:
{
- void *mem = scm_allocate_pointerless (SCM_I_CURRENT_THREAD, type->size);
+ void *mem =
+ scm_allocate_untagged_pointerless (SCM_I_CURRENT_THREAD, type->size);
memcpy (mem, loc, type->size);
return scm_from_pointer (mem, NULL);
}
diff --git a/libguile/fports.c b/libguile/fports.c
index 9f11cce9a..b51f3b219 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -455,8 +455,8 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name,
unsigned options)
}
}
- fp = (scm_t_fport *) scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
- sizeof (scm_t_fport));
+ fp = (scm_t_fport *) scm_allocate_untagged_pointerless (SCM_I_CURRENT_THREAD,
+ sizeof
(scm_t_fport));
fp->fdes = fdes;
fp->options = options;
fp->revealed = 0;
diff --git a/libguile/gc-inline.h b/libguile/gc-inline.h
index 5b53a67f6..26f5126a7 100644
--- a/libguile/gc-inline.h
+++ b/libguile/gc-inline.h
@@ -46,17 +46,24 @@
static inline void *
-scm_inline_allocate_pointerless (scm_thread *thread, size_t bytes)
+scm_inline_allocate_tagged (scm_thread *thread, size_t bytes)
{
return gc_allocate (thread->mutator, bytes,
- GC_ALLOCATION_UNTAGGED_POINTERLESS);
+ GC_ALLOCATION_TAGGED);
}
static inline void *
-scm_inline_allocate_tagged (scm_thread *thread, size_t bytes)
+scm_inline_allocate_tagged_pointerless (scm_thread *thread, size_t bytes)
{
return gc_allocate (thread->mutator, bytes,
- GC_ALLOCATION_TAGGED);
+ GC_ALLOCATION_TAGGED_POINTERLESS);
+}
+
+static inline void *
+scm_inline_allocate_untagged_pointerless (scm_thread *thread, size_t bytes)
+{
+ return gc_allocate (thread->mutator, bytes,
+ GC_ALLOCATION_UNTAGGED_POINTERLESS);
}
static inline void *
diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c
index 229e2c98d..ed1910951 100644
--- a/libguile/gc-malloc.c
+++ b/libguile/gc-malloc.c
@@ -150,17 +150,24 @@ scm_gc_unregister_collectable_memory (void *mem, size_t
size, const char *what)
}
void *
-scm_allocate_pointerless (struct scm_thread *thr, size_t size)
+scm_allocate_tagged (struct scm_thread *thr, size_t size)
{
if (!size) abort();
- return scm_inline_allocate_pointerless (thr, size);
+ return scm_inline_allocate_tagged (thr, size);
}
void *
-scm_allocate_tagged (struct scm_thread *thr, size_t size)
+scm_allocate_tagged_pointerless (struct scm_thread *thr, size_t size)
{
if (!size) abort();
- return scm_inline_allocate_tagged (thr, size);
+ return scm_inline_allocate_tagged_pointerless (thr, size);
+}
+
+void *
+scm_allocate_untagged_pointerless (struct scm_thread *thr, size_t size)
+{
+ if (!size) abort();
+ return scm_inline_allocate_untagged_pointerless (thr, size);
}
void *
@@ -171,13 +178,12 @@ scm_allocate_sloppy (struct scm_thread *thr, size_t size)
}
/* Allocate SIZE bytes of memory whose contents should not be scanned
- for pointers (useful, e.g., for strings). Note though that this
- memory is *not* cleared; be sure to initialize it to prevent
- information leaks. */
+ for pointers (useful, e.g., for strings). The memory is cleared. */
void *
scm_gc_malloc_pointerless (size_t size, const char *what)
{
- return scm_allocate_pointerless (SCM_I_CURRENT_THREAD, size ? size : 1);
+ return scm_allocate_untagged_pointerless (SCM_I_CURRENT_THREAD,
+ size ? size : 1);
}
void *
diff --git a/libguile/gc.h b/libguile/gc.h
index f545c2aa6..1c6b549c7 100644
--- a/libguile/gc.h
+++ b/libguile/gc.h
@@ -112,8 +112,9 @@ SCM_API void scm_gc_register_collectable_memory (void *mem,
size_t size,
SCM_API void scm_gc_unregister_collectable_memory (void *mem, size_t size,
const char *what);
-SCM_API void *scm_allocate_pointerless (struct scm_thread *thr, size_t size);
SCM_API void *scm_allocate_tagged (struct scm_thread *thr, size_t size);
+SCM_API void *scm_allocate_tagged_pointerless (struct scm_thread *thr, size_t
size);
+SCM_API void *scm_allocate_untagged_pointerless (struct scm_thread *thr,
size_t size);
SCM_API void *scm_allocate_sloppy (struct scm_thread *thr, size_t size);
SCM_API void scm_gc_pin_object (struct scm_thread *thr, SCM x);
diff --git a/libguile/integers.c b/libguile/integers.c
index 39867e774..71059e372 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -139,7 +139,8 @@ allocate_bignum (size_t nlimbs)
ASSERT (nlimbs <= NLIMBS_MAX);
size_t size = sizeof (struct scm_bignum) + nlimbs * sizeof(mp_limb_t);
- struct scm_bignum *z = scm_allocate_pointerless (SCM_I_CURRENT_THREAD, size);
+ struct scm_bignum *z =
+ scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD, size);
z->tag = scm_tc16_big;
z->size = nlimbs;
diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c
index d686964e8..3aa7b5d06 100644
--- a/libguile/intrinsics.c
+++ b/libguile/intrinsics.c
@@ -469,8 +469,8 @@ allocate_words (scm_thread *thread, size_t n)
static SCM
allocate_pointerless_words (scm_thread *thread, size_t n)
{
- return SCM_PACK_POINTER (scm_inline_allocate_pointerless (thread,
- n * sizeof (SCM)));
+ return SCM_PACK_POINTER
+ (scm_inline_allocate_untagged_pointerless (thread, n * sizeof (SCM)));
}
static SCM
diff --git a/libguile/load.c b/libguile/load.c
index 1939eb98b..bfd00c2a0 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -430,8 +430,8 @@ stringbuf_grow (struct stringbuf *buf)
ptroff = buf->ptr - buf->buf;
buf->buf_len *= 2;
- buf->buf = scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
- buf->buf_len);
+ buf->buf = scm_allocate_untagged_pointerless (SCM_I_CURRENT_THREAD,
+ buf->buf_len);
memcpy (buf->buf, prev_buf, prev_len);
buf->ptr = buf->buf + ptroff;
}
diff --git a/libguile/loader.c b/libguile/loader.c
index f4c0533fc..2740699ee 100644
--- a/libguile/loader.c
+++ b/libguile/loader.c
@@ -698,9 +698,9 @@ register_elf (char *data, size_t len, char *frame_maps)
prev = mapped_elf_images;
mapped_elf_images =
- scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
- sizeof (*mapped_elf_images)
- * mapped_elf_images_allocated);
+ scm_allocate_untagged_pointerless (SCM_I_CURRENT_THREAD,
+ sizeof (*mapped_elf_images)
+ * mapped_elf_images_allocated);
for (n = 0; n < mapped_elf_images_count; n++)
{
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 0c497655b..d660aa8f6 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -422,15 +422,13 @@ scm_i_fraction2double (SCM z)
static SCM
scm_i_from_double (double val)
{
- SCM z;
+ struct scm_t_double *z =
+ scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD, sizeof (*z));
- z = SCM_PACK_POINTER
- (scm_allocate_pointerless (SCM_I_CURRENT_THREAD, sizeof (scm_t_double)));
+ z->type = scm_tc16_real;
+ z->real = val;
- SCM_SET_CELL_TYPE (z, scm_tc16_real);
- SCM_REAL_VALUE (z) = val;
-
- return z;
+ return SCM_PACK_POINTER (z);
}
SCM_PRIMITIVE_GENERIC (scm_exact_p, "exact?", 1, 0, 0,
@@ -6074,14 +6072,12 @@ SCM_PRIMITIVE_GENERIC (scm_sys_atanh, "atanh", 1, 0, 0,
SCM
scm_c_make_rectangular (double re, double im)
{
- SCM z;
-
- z = SCM_PACK_POINTER
- (scm_allocate_pointerless (SCM_I_CURRENT_THREAD, sizeof (scm_t_complex)));
- SCM_SET_CELL_TYPE (z, scm_tc16_complex);
- SCM_COMPLEX_REAL (z) = re;
- SCM_COMPLEX_IMAG (z) = im;
- return z;
+ struct scm_t_complex *z =
+ scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD, sizeof (*z));
+ z->type = scm_tc16_complex;
+ z->real = re;
+ z->imag = im;
+ return SCM_PACK_POINTER (z);
}
SCM_DEFINE (scm_make_rectangular, "make-rectangular", 2, 0, 0,
diff --git a/libguile/programs.h b/libguile/programs.h
index 7fcf41672..8f7bab084 100644
--- a/libguile/programs.h
+++ b/libguile/programs.h
@@ -127,8 +127,7 @@ static inline SCM
scm_i_make_program (const uint32_t *code)
{
struct scm_program *ret =
- scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
- sizeof (struct scm_program));
+ scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD, sizeof (*ret));
ret->tag_flags_and_free_variable_count = scm_tc7_program;
ret->code = code;
return scm_from_program (ret);
diff --git a/libguile/random.c b/libguile/random.c
index 09c7ab6cf..1e663d4da 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -137,8 +137,8 @@ scm_i_copy_rstate (scm_t_rstate *state)
{
scm_t_rstate *new_state;
- new_state = scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
- state->rng->rstate_size);
+ new_state = scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD,
+ state->rng->rstate_size);
return memcpy (new_state, state, state->rng->rstate_size);
}
@@ -183,8 +183,8 @@ scm_c_make_rstate (const char *seed, int n)
{
scm_t_rstate *state;
- state = scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
- scm_the_rng.rstate_size);
+ state = scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD,
+ scm_the_rng.rstate_size);
state->tag = scm_tc16_random_state;
state->rng = &scm_the_rng;
state->normal_next = 0.0;
@@ -197,8 +197,8 @@ scm_c_rstate_from_datum (SCM datum)
{
scm_t_rstate *state;
- state = scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
- scm_the_rng.rstate_size);
+ state = scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD,
+ scm_the_rng.rstate_size);
state->tag = scm_tc16_random_state;
state->rng = &scm_the_rng;
state->normal_next = 0.0;
diff --git a/libguile/read.c b/libguile/read.c
index b64984c89..95a57c82b 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -234,16 +234,17 @@ read_complete_token (SCM port, char *buffer, size_t
buffer_size, size_t *read)
{
if (overflow_size == 0)
{
- overflow_buffer = scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
- bytes_read);
+ overflow_buffer =
+ scm_allocate_untagged_pointerless (SCM_I_CURRENT_THREAD,
+ bytes_read);
memcpy (overflow_buffer, buffer, bytes_read);
overflow_size = bytes_read;
}
else
{
char *new_buf =
- scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
- overflow_size + bytes_read);
+ scm_allocate_untagged_pointerless (SCM_I_CURRENT_THREAD,
+ overflow_size + bytes_read);
memcpy (new_buf, overflow_buffer, overflow_size);
memcpy (new_buf + overflow_size, buffer, bytes_read);
diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c
index 98cee5315..06db4e2b4 100644
--- a/libguile/regex-posix.c
+++ b/libguile/regex-posix.c
@@ -153,8 +153,7 @@ SCM_DEFINE_STATIC (make_regexp, "make-regexp", 1, 0, 1,
flag = SCM_CDR (flag);
}
- rx = scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
- sizeof (*rx));
+ rx = scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD, sizeof (*rx));
rx->tag = scm_tc16_regexp;
c_pat = scm_to_locale_string (pat);
status = regcomp (&rx->regex, c_pat,
diff --git a/libguile/smob.c b/libguile/smob.c
index e1f895491..ad9a68ae7 100644
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -308,7 +308,7 @@ scm_new_smob (scm_t_bits tc, scm_t_bits data)
uint32_t all_fields_unmanaged = -1;
all_fields_unmanaged >>= 32 - desc->field_count;
if (desc->unmanaged_fields == all_fields_unmanaged)
- ret = scm_allocate_pointerless (thr, sz);
+ ret = scm_allocate_tagged_pointerless (thr, sz);
else
ret = scm_allocate_tagged (thr, sz);
}
@@ -345,7 +345,7 @@ scm_new_double_smob (scm_t_bits tc, scm_t_bits data1,
uint32_t all_fields_unmanaged = -1;
all_fields_unmanaged >>= 32 - desc->field_count;
if (desc->unmanaged_fields == all_fields_unmanaged)
- ret = scm_allocate_pointerless (thr, sz);
+ ret = scm_allocate_tagged_pointerless (thr, sz);
else
ret = scm_allocate_tagged (thr, sz);
}
diff --git a/libguile/strings.c b/libguile/strings.c
index ef2dfef37..f83d986c1 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -199,7 +199,8 @@ make_narrow_stringbuf (size_t len)
return (struct scm_narrow_stringbuf *) &null_stringbuf;
struct scm_narrow_stringbuf *buf =
- scm_allocate_pointerless (SCM_I_CURRENT_THREAD, sizeof (*buf) + len + 1);
+ scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD,
+ sizeof (*buf) + len + 1);
buf->header.tag_and_flags = scm_tc7_stringbuf;
buf->header.length = len;
@@ -222,8 +223,9 @@ make_wide_stringbuf (size_t len)
scm_out_of_range ("make_stringbuf", scm_from_size_t (len));
struct scm_wide_stringbuf *buf =
- scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
- sizeof (*buf) + (len + 1) * sizeof
(scm_t_wchar));
+ scm_allocate_tagged_pointerless (SCM_I_CURRENT_THREAD,
+ sizeof (*buf)
+ + (len + 1) * sizeof (scm_t_wchar));
buf->header.tag_and_flags = scm_tc7_stringbuf | SCM_I_STRINGBUF_F_WIDE;
buf->header.length = len;
@@ -1513,7 +1515,7 @@ decoding_error (const char *func_name, int errno_save,
SCM bv;
signed char *buf;
- buf = scm_allocate_pointerless (SCM_I_CURRENT_THREAD, len);
+ buf = scm_allocate_untagged_pointerless (SCM_I_CURRENT_THREAD, len);
memcpy (buf, str, len);
bv = scm_c_take_gc_bytevector (buf, len, SCM_BOOL_F);
diff --git a/libguile/vm.c b/libguile/vm.c
index 16867a2a8..3820310ac 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -480,7 +480,7 @@ define_vm_builtins (void)
size_t sz = sizeof (builtin##_code); \
vm_builtin_##builtin##_code = instrumented_code (builtin##_code, sz); \
struct scm_program *p = \
- scm_allocate_pointerless (thr, sizeof (struct scm_program)); \
+ scm_allocate_tagged_pointerless (thr, sizeof (*p)); \
scm_t_bits tag = scm_tc7_program | SCM_F_PROGRAM_IS_PRIMITIVE; \
p->tag_flags_and_free_variable_count = tag; \
p->code = vm_builtin_##builtin##_code; \
