wingo pushed a commit to branch wip-whippet
in repository guile.
commit f2ad6525e65f92d230a43bbc9e3dd9c2e3d2fe16
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Fri Jun 20 11:40:01 2025 +0200
Convert scm_gc_malloc* calls to scm_allocate*
* libguile/arrays.c:
* libguile/bitvectors.c:
* libguile/bytevectors.c:
* libguile/chooks.c:
* libguile/continuations.c:
* libguile/control.c:
* libguile/dynstack.c:
* libguile/ephemerons.c:
* libguile/filesys.c:
* libguile/foreign.c:
* libguile/fports.c:
* libguile/frames.c:
* libguile/gsubr.c:
* libguile/hashtab.c:
* libguile/i18n.c:
* libguile/integers.c:
* libguile/intrinsics.c:
* libguile/load.c:
* libguile/loader.c:
* libguile/macros.c:
* libguile/numbers.c:
* libguile/options.c:
* libguile/ports.c:
* libguile/programs.h:
* libguile/random.c:
* libguile/read.c:
* libguile/regex-posix.c:
* libguile/smob.c:
* libguile/srfi-14.c:
* libguile/strings.c:
* libguile/struct.c:
* libguile/threads.c:
* libguile/threads.h:
* libguile/values.c:
* libguile/vm.c: Convert all calls to scm_gc_malloc_pointerless to
scm_allocate_pointerless. Convert scm_gc_malloc to either
scm_allocate_tagged or scm_allocate_sloppy, depending on whether the
value can be precisely traced or not.
---
libguile/arrays.c | 7 ++++---
libguile/bitvectors.c | 7 ++++---
libguile/bytevectors.c | 13 ++++++++-----
libguile/chooks.c | 9 ++++-----
libguile/continuations.c | 14 +++++++-------
libguile/control.c | 4 ++--
libguile/dynstack.c | 3 ++-
libguile/ephemerons.c | 3 ++-
libguile/filesys.c | 3 ++-
libguile/foreign.c | 8 ++++----
libguile/fports.c | 4 ++--
libguile/frames.c | 4 ++--
libguile/gsubr.c | 2 +-
libguile/hashtab.c | 2 +-
libguile/i18n.c | 6 ++++--
libguile/integers.c | 3 ++-
libguile/intrinsics.c | 5 +++--
libguile/load.c | 6 ++++--
libguile/loader.c | 6 +++---
libguile/macros.c | 9 +++++----
libguile/numbers.c | 8 +++++---
libguile/options.c | 5 +++--
libguile/ports.c | 2 +-
libguile/programs.h | 6 +++++-
libguile/random.c | 13 +++++++------
libguile/read.c | 11 +++++++----
libguile/regex-posix.c | 3 ++-
libguile/smob.c | 4 +++-
libguile/srfi-14.c | 5 +++--
libguile/strings.c | 12 +++++++-----
libguile/struct.c | 4 ++--
libguile/threads.c | 4 ++--
libguile/threads.h | 13 -------------
libguile/values.c | 13 +++++++++----
libguile/vm.c | 7 ++++---
35 files changed, 126 insertions(+), 102 deletions(-)
diff --git a/libguile/arrays.c b/libguile/arrays.c
index fb65c8f5b..6eb692c4e 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -486,9 +486,10 @@ SCM_DEFINE (scm_shared_array_increments,
"shared-array-increments", 1, 0, 0,
struct scm_array *
scm_i_make_array (SCM v, size_t base, int ndim)
{
- struct scm_array *array = scm_gc_malloc (sizeof (struct scm_array)
- + ndim * sizeof (scm_t_array_dim),
- "array");
+ struct scm_array *array =
+ scm_allocate_tagged (SCM_I_CURRENT_THREAD,
+ sizeof (struct scm_array)
+ + ndim * sizeof (scm_t_array_dim));
/* FIXME: Shift ndim by something more reasonable instead. */
array->tag_and_ndims = scm_tc7_array | (ndim << 16);
array->vector = v;
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
index ade3c85b9..3a90fb9b9 100644
--- a/libguile/bitvectors.c
+++ b/libguile/bitvectors.c
@@ -37,6 +37,7 @@
#include "pairs.h"
#include "ports.h"
#include "srfi-4.h"
+#include "threads.h"
#include "bitvectors.h"
@@ -199,9 +200,9 @@ make_bitvector (size_t len, int fill)
size_t word_len = bit_count_to_word_count (len);
struct scm_bitvector *bv;
- bv = scm_gc_malloc_pointerless (sizeof (struct scm_bitvector)
- + sizeof (scm_t_bits) * word_len,
- "bitvector");
+ bv = scm_allocate_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 50812d3bc..2ddf6da8a 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -56,6 +56,7 @@
#include "srfi-4.h"
#include "strings.h"
#include "symbols.h"
+#include "threads.h"
#include "uniform.h"
#include "version.h"
@@ -232,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_gc_malloc_pointerless (sizeof (struct scm_bytevector) + c_len,
- "bytevector");
+ scm_allocate_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);
@@ -258,7 +259,8 @@ make_bytevector_from_buffer (size_t len, void *contents,
size_t bytes_per_elt = scm_i_array_element_type_sizes[element_type]/8;
size_t c_len = len * bytes_per_elt;
struct scm_bytevector *bv =
- scm_gc_malloc (sizeof (struct scm_bytevector), "bytevector");
+ scm_allocate_tagged (SCM_I_CURRENT_THREAD,
+ sizeof (struct scm_bytevector));
scm_t_bits flags = is_immutable ? SCM_F_BYTEVECTOR_IMMUTABLE : 0;
bv->tag_flags_and_element_type = make_bytevector_tag (flags, element_type);
@@ -286,11 +288,12 @@ scm_i_make_typed_bytevector (size_t len,
scm_t_array_element_type element_type)
/* Return a bytevector of size LEN made up of CONTENTS. The area
pointed to by CONTENTS must be protected from GC somehow: either
- because it was allocated using `scm_gc_malloc ()', or because it is
- part of PARENT. */
+ because it is itself GC-managed, or because it is part of PARENT. */
SCM
scm_c_take_gc_bytevector (signed char *contents, size_t len, SCM parent)
{
+ /* FIXME: If contents is an interior pointer to a GC-managed object,
+ we should gc_pin_object() on that parent object! */
return scm_from_bytevector
(make_bytevector_from_buffer (len, contents, SCM_ARRAY_ELEMENT_TYPE_VU8,
parent, 0));
diff --git a/libguile/chooks.c b/libguile/chooks.c
index 3f50c4034..a4301d3a3 100644
--- a/libguile/chooks.c
+++ b/libguile/chooks.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-1996,1998-2001,2003,2006,2008-2009,2011,2018
+/* Copyright 1995-1996,1998-2001,2003,2006,2008-2009,2011,2018,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -28,6 +28,7 @@
#include "gc.h"
#include "chooks.h"
+#include "threads.h"
@@ -35,9 +36,6 @@
*
*/
-/* Hint for `scm_gc_malloc ()' and friends. */
-static const char hook_entry_gc_hint[] = "hook entry";
-
void
scm_c_hook_init (scm_t_c_hook *hook, void *hook_data, scm_t_c_hook_type type)
{
@@ -55,7 +53,8 @@ scm_c_hook_add (scm_t_c_hook *hook,
scm_t_c_hook_entry *entry;
scm_t_c_hook_entry **loc = &hook->first;
- entry = scm_gc_malloc (sizeof (scm_t_c_hook_entry), hook_entry_gc_hint);
+ entry = scm_allocate_sloppy (SCM_I_CURRENT_THREAD,
+ sizeof (scm_t_c_hook_entry));
if (appendp)
while (*loc)
loc = &(*loc)->next;
diff --git a/libguile/continuations.c b/libguile/continuations.c
index 1a04dfb7d..cce06b3a4 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -91,8 +91,8 @@ make_continuation_trampoline (struct scm_continuation *cont)
scm_t_bits tag = scm_tc7_program | (nfree << 16) | flags;
struct scm_program *ret =
- scm_gc_malloc (sizeof (struct scm_program) + nfree * sizeof(SCM),
- "foreign procedure");
+ scm_allocate_tagged (SCM_I_CURRENT_THREAD,
+ sizeof (struct scm_program) + nfree * sizeof(SCM));
ret->tag_flags_and_free_variable_count = tag;
ret->code = goto_continuation_code.code;
ret->free_variables[0] = scm_from_continuation (cont);
@@ -173,8 +173,8 @@ capture_auxiliary_stack (scm_thread *thread, struct
scm_continuation *continuati
continuation->auxiliary_stack_size =
top - (char *) thread->auxiliary_stack_base;
continuation->auxiliary_stack =
- scm_gc_malloc (continuation->auxiliary_stack_size,
- "continuation auxiliary stack");
+ scm_allocate_sloppy (SCM_I_CURRENT_THREAD,
+ continuation->auxiliary_stack_size);
memcpy (continuation->auxiliary_stack, thread->auxiliary_stack_base,
continuation->auxiliary_stack_size);
@@ -199,9 +199,9 @@ scm_i_make_continuation (scm_thread *thread, struct
scm_vm_cont *vm_cont)
SCM_FLUSH_REGISTER_WINDOWS;
long stack_size = scm_stack_size (thread->continuation_base);
struct scm_continuation *continuation =
- scm_gc_malloc (sizeof (struct scm_continuation)
- + stack_size * sizeof (SCM_STACKITEM),
- "continuation");
+ scm_allocate_tagged (SCM_I_CURRENT_THREAD,
+ sizeof (struct scm_continuation)
+ + stack_size * sizeof (SCM_STACKITEM));
continuation->tag = scm_tc16_continuation;
memcpy (continuation->jmpbuf, thread->vm.registers, sizeof (jmp_buf));
pin_conservative_roots (thread, continuation->jmpbuf, sizeof (jmp_buf));
diff --git a/libguile/control.c b/libguile/control.c
index a128a3973..a38b78e4f 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -98,8 +98,8 @@ scm_i_make_composable_continuation (SCM vmcont)
scm_t_bits tag = scm_tc7_program | (nfree << 16) | flags;
struct scm_program *ret =
- scm_gc_malloc (sizeof (struct scm_program) + nfree * sizeof(SCM),
- "foreign procedure");
+ scm_allocate_tagged (SCM_I_CURRENT_THREAD,
+ sizeof (struct scm_program) + nfree * sizeof(SCM));
ret->tag_flags_and_free_variable_count = tag;
ret->code = compose_continuation_code.code;
ret->free_variables[0] = vmcont;
diff --git a/libguile/dynstack.c b/libguile/dynstack.c
index a5b659271..d2d181d46 100644
--- a/libguile/dynstack.c
+++ b/libguile/dynstack.c
@@ -384,7 +384,8 @@ scm_dynstack_capture (scm_t_dynstack *dynstack, scm_t_bits
*item)
assert (item <= dynstack->top);
len = dynstack->top - item + SCM_DYNSTACK_HEADER_LEN;
- ret = scm_gc_malloc (sizeof (*ret) + len * sizeof(scm_t_bits), "dynstack");
+ ret = scm_allocate_tagged (SCM_I_CURRENT_THREAD,
+ sizeof (*ret) + len * sizeof(scm_t_bits));
ret->tag = scm_tc16_dynstack_slice;
ret->base = ret->inline_storage;
ret->limit = ret->base + len;
diff --git a/libguile/ephemerons.c b/libguile/ephemerons.c
index f30ebdf49..29ee615b4 100644
--- a/libguile/ephemerons.c
+++ b/libguile/ephemerons.c
@@ -257,7 +257,8 @@ scm_c_make_ephemeron_table (size_t size)
{
size_t byte_size = sizeof (struct scm_ephemeron_table);
byte_size += sizeof (struct gc_ephemeron*) * size;
- struct scm_ephemeron_table *table = scm_gc_malloc (byte_size, NULL);
+ struct scm_ephemeron_table *table = scm_allocate_tagged
(SCM_I_CURRENT_THREAD,
+ byte_size);
table->tag = scm_tc7_ephemeron_table;
table->size = size;
return table;
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 395ec8792..ef5526cfb 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -2236,7 +2236,8 @@ SCM_DEFINE (scm_opendir, "opendir", 1, 0, 0,
"stream.")
#define FUNC_NAME s_scm_opendir
{
- struct scm_directory *d = scm_gc_malloc (sizeof (*d), "directory stream");
+ struct scm_directory *d = scm_allocate_tagged (SCM_I_CURRENT_THREAD,
+ sizeof (*d));
d->tag_and_flags = scm_tc16_directory | SCM_DIR_FLAG_OPEN;
STRING_SYSCALL (dirname, c_dirname, d->ds = opendir (c_dirname));
diff --git a/libguile/foreign.c b/libguile/foreign.c
index d029fbc95..37b1756b8 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -820,7 +820,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_gc_malloc_pointerless (cif_len, "foreign");
+ mem = scm_allocate_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;
@@ -952,8 +952,8 @@ cif_to_procedure (SCM cif, SCM func_ptr, int with_errno)
c_cif = (ffi_cif *) SCM_POINTER_VALUE (cif);
struct scm_program *ret =
- scm_gc_malloc (sizeof (struct scm_program) + nfree * sizeof(SCM),
- "foreign procedure");
+ scm_allocate_tagged (SCM_I_CURRENT_THREAD,
+ sizeof (struct scm_program) + nfree * sizeof(SCM));
ret->tag_flags_and_free_variable_count = tag;
ret->code = get_foreign_stub_code (c_cif->nargs, with_errno);
ret->free_variables[0] = cif;
@@ -1136,7 +1136,7 @@ pack (const ffi_type * type, const void *loc, int
return_value_p)
case FFI_TYPE_STRUCT:
{
- void *mem = scm_gc_malloc_pointerless (type->size, "foreign");
+ void *mem = scm_allocate_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 97a7db50a..b6bccdaaf 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -454,8 +454,8 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name,
unsigned options)
}
}
- fp = (scm_t_fport *) scm_gc_malloc_pointerless (sizeof (scm_t_fport),
- "file port");
+ fp = (scm_t_fport *) scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+ sizeof (scm_t_fport));
fp->fdes = fdes;
fp->options = options;
fp->revealed = 0;
diff --git a/libguile/frames.c b/libguile/frames.c
index ae9452f6f..8f98b1846 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -46,8 +46,8 @@
SCM
scm_c_make_frame (enum scm_vm_frame_kind kind, const struct scm_frame *frame)
{
- struct scm_vm_frame *p = scm_gc_malloc (sizeof (struct scm_vm_frame),
- "vmframe");
+ struct scm_vm_frame *p = scm_allocate_tagged (SCM_I_CURRENT_THREAD,
+ sizeof (struct scm_vm_frame));
p->tag_and_flags = scm_tc7_frame | (kind << 8);
p->frame.stack_holder = frame->stack_holder;
p->frame.fp_offset = frame->fp_offset;
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index 855107a01..36e30115a 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -344,7 +344,7 @@ scm_make_subr_from_code (struct scm_thread *thread, const
uint32_t *code,
scm_t_bits program_flags, size_t nfree)
{
size_t bytes = sizeof(struct scm_program) + nfree * sizeof (SCM);
- struct scm_program *proc = scm_inline_gc_malloc (thread, bytes);
+ struct scm_program *proc = scm_allocate_tagged (thread, bytes);
proc->tag_flags_and_free_variable_count =
scm_tc7_program | program_flags | (nfree << 16);
proc->code = code;
diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index c96961c2e..d24d7dcd4 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -507,7 +507,7 @@ make_hash_table (unsigned long k, const char *func_name)
vector = scm_c_make_vector (n, SCM_EOL);
- t = scm_gc_malloc_pointerless (sizeof (*t), s_hashtable);
+ t = scm_allocate_pointerless (SCM_I_CURRENT_THREAD, sizeof (*t));
t->min_size_index = t->size_index = i;
t->n_items = 0;
t->lower = 0;
diff --git a/libguile/i18n.c b/libguile/i18n.c
index 153225911..b0f5baa71 100644
--- a/libguile/i18n.c
+++ b/libguile/i18n.c
@@ -339,7 +339,8 @@ SCM_DEFINE (scm_make_locale, "make-locale", 2, 1, 0,
scm_locale_error (FUNC_NAME, errno);
}
- struct scm_locale *locale = scm_gc_malloc (sizeof (*locale), "locale");
+ struct scm_locale *locale = scm_allocate_tagged (SCM_I_CURRENT_THREAD,
+ sizeof (*locale));
locale->tag = scm_tc16_locale;
locale->locale = c_locale;
scm_i_add_locale_finalizer (SCM_I_CURRENT_THREAD, scm_from_locale (locale));
@@ -1479,7 +1480,8 @@ scm_init_i18n ()
/* XXX: We don't define it as `LC_GLOBAL_LOCALE' because of bugs as of
glibc <= 2.11 not (yet) worked around by Gnulib. See
http://sourceware.org/bugzilla/show_bug.cgi?id=11009 for details. */
- struct scm_locale *locale = scm_gc_malloc (sizeof (*locale), "locale");
+ struct scm_locale *locale = scm_allocate_tagged (SCM_I_CURRENT_THREAD,
+ sizeof (*locale));
locale->tag = scm_tc16_locale;
locale->locale = NULL;
SCM_VARIABLE_SET (scm_global_locale, scm_from_locale (locale));
diff --git a/libguile/integers.c b/libguile/integers.c
index ddff1cb01..6c10d6ce4 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -33,6 +33,7 @@
#include "boolean.h"
#include "numbers.h"
#include "strings.h"
+#include "threads.h"
#include "integers.h"
@@ -138,7 +139,7 @@ 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_gc_malloc_pointerless (size, "bignum");
+ struct scm_bignum *z = scm_allocate_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 b2b823c81..e3a6ba5ce 100644
--- a/libguile/intrinsics.c
+++ b/libguile/intrinsics.c
@@ -463,13 +463,14 @@ error_wrong_number_of_values (uint32_t expected)
static SCM
allocate_words (scm_thread *thread, size_t n)
{
- return SCM_PACK_POINTER (scm_inline_gc_malloc_words (thread, n));
+ return SCM_PACK_POINTER (scm_inline_allocate_tagged (thread, n *
sizeof(SCM)));
}
static SCM
allocate_pointerless_words (scm_thread *thread, size_t n)
{
- return SCM_PACK_POINTER (scm_inline_gc_malloc_pointerless_words (thread, n));
+ return SCM_PACK_POINTER (scm_inline_allocate_pointerless (thread,
+ n * sizeof (SCM)));
}
static SCM
diff --git a/libguile/load.c b/libguile/load.c
index 35613077b..5fc56903a 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-1996,1998-2001,2004,2006,2008-2019,2022
+/* Copyright 1995-1996,1998-2001,2004,2006,2008-2019,2022,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -58,6 +58,7 @@
#include "strings.h"
#include "strports.h"
#include "symbols.h"
+#include "threads.h"
#include "throw.h"
#include "variable.h"
#include "version.h"
@@ -429,7 +430,8 @@ stringbuf_grow (struct stringbuf *buf)
ptroff = buf->ptr - buf->buf;
buf->buf_len *= 2;
- buf->buf = scm_gc_malloc_pointerless (buf->buf_len, "search-path");
+ buf->buf = scm_allocate_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 699931eec..e9360b119 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_gc_malloc_pointerless (sizeof (*mapped_elf_images)
- * mapped_elf_images_allocated,
- "mapped elf images");
+ scm_allocate_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/macros.c b/libguile/macros.c
index 6f81c75e9..a086ff8a0 100644
--- a/libguile/macros.c
+++ b/libguile/macros.c
@@ -32,6 +32,7 @@
#include "procs.h"
#include "random.h"
#include "symbols.h"
+#include "threads.h"
#include "variable.h"
#include "macros.h"
@@ -92,8 +93,8 @@ SCM
scm_i_make_primitive_syntax_transformer (const char *name,
scm_t_macro_primitive fn)
{
- struct scm_syntax_transformer *tx = scm_gc_malloc (sizeof (*tx),
- "syntax transformer");
+ struct scm_syntax_transformer *tx =
+ scm_allocate_tagged (SCM_I_CURRENT_THREAD, sizeof (*tx));
tx->tag = scm_tc16_syntax_transformer;
tx->primitive = fn;
tx->name = scm_from_utf8_symbol (name);
@@ -122,8 +123,8 @@ SCM_DEFINE (scm_make_syntax_transformer,
"make-syntax-transformer", 3, 0, 0,
SCM_VALIDATE_SYMBOL (2, type);
- struct scm_syntax_transformer *tx = scm_gc_malloc (sizeof (*tx),
- "syntax transformer");
+ struct scm_syntax_transformer *tx = scm_allocate_tagged
(SCM_I_CURRENT_THREAD,
+ sizeof (*tx));
tx->tag = scm_tc16_syntax_transformer;
tx->primitive = NULL;
tx->name = name;
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 2b7a30716..1d9a86f78 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -71,6 +71,7 @@
#include "ports.h"
#include "simpos.h"
#include "strings.h"
+#include "threads.h"
#include "values.h"
#include "numbers.h"
@@ -420,7 +421,8 @@ scm_i_from_double (double val)
{
SCM z;
- z = SCM_PACK_POINTER (scm_gc_malloc_pointerless (sizeof (scm_t_double),
"real"));
+ z = SCM_PACK_POINTER
+ (scm_allocate_pointerless (SCM_I_CURRENT_THREAD, sizeof (scm_t_double)));
SCM_SET_CELL_TYPE (z, scm_tc16_real);
SCM_REAL_VALUE (z) = val;
@@ -6072,8 +6074,8 @@ scm_c_make_rectangular (double re, double im)
{
SCM z;
- z = SCM_PACK_POINTER (scm_gc_malloc_pointerless (sizeof (scm_t_complex),
- "complex"));
+ 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;
diff --git a/libguile/options.c b/libguile/options.c
index 32db66054..5c43a1d5d 100644
--- a/libguile/options.c
+++ b/libguile/options.c
@@ -28,6 +28,7 @@
#include "pairs.h"
#include "strings.h"
#include "symbols.h"
+#include "threads.h"
#include "options.h"
@@ -183,8 +184,8 @@ change_option_setting (SCM args, scm_t_option options[],
const char *s,
unsigned int i;
scm_t_bits *new_vals;
- new_vals = scm_gc_malloc (options_length (options) * sizeof (scm_t_bits),
- "new-options");
+ new_vals = scm_allocate_sloppy (SCM_I_CURRENT_THREAD,
+ options_length (options) * sizeof
(scm_t_bits));
for (i = 0; options[i].name; ++i)
{
diff --git a/libguile/ports.c b/libguile/ports.c
index e79ee48ff..b29ae9710 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -249,7 +249,7 @@ scm_make_port_type (char *name,
{
scm_t_port_type *desc;
- desc = scm_gc_malloc_pointerless (sizeof (*desc), "port-type");
+ desc = scm_allocate_pointerless (SCM_I_CURRENT_THREAD, sizeof (*desc));
memset (desc, 0, sizeof (*desc));
desc->name = name;
diff --git a/libguile/programs.h b/libguile/programs.h
index 8554f7d69..667daa86d 100644
--- a/libguile/programs.h
+++ b/libguile/programs.h
@@ -21,6 +21,7 @@
#define _SCM_PROGRAMS_H_
#include <libguile/gc.h>
+#include <libguile/threads.h>
/*
* Programs
@@ -122,11 +123,14 @@ scm_program_free_variable_set_x (struct scm_program
*program, size_t idx, SCM v)
program->free_variables[idx] = v;
}
+#include "threads.h"
+
static inline SCM
scm_i_make_program (const uint32_t *code)
{
struct scm_program *ret =
- scm_gc_malloc_pointerless (sizeof (struct scm_program), "program");
+ scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+ sizeof (struct scm_program));
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 58b0496ec..4c61f2043 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -50,6 +50,7 @@
#include "stime.h"
#include "strings.h"
#include "symbols.h"
+#include "threads.h"
#include "variable.h"
#include "vectors.h"
@@ -136,8 +137,8 @@ scm_i_copy_rstate (scm_t_rstate *state)
{
scm_t_rstate *new_state;
- new_state = scm_gc_malloc_pointerless (state->rng->rstate_size,
- "random-state");
+ new_state = scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+ state->rng->rstate_size);
return memcpy (new_state, state, state->rng->rstate_size);
}
@@ -182,8 +183,8 @@ scm_c_make_rstate (const char *seed, int n)
{
scm_t_rstate *state;
- state = scm_gc_malloc_pointerless (scm_the_rng.rstate_size,
- "random-state");
+ state = scm_allocate_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;
@@ -196,8 +197,8 @@ scm_c_rstate_from_datum (SCM datum)
{
scm_t_rstate *state;
- state = scm_gc_malloc_pointerless (scm_the_rng.rstate_size,
- "random-state");
+ state = scm_allocate_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 506fd2e21..7f69e0164 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -59,6 +59,7 @@
#include "strings.h"
#include "strports.h"
#include "symbols.h"
+#include "threads.h"
#include "variable.h"
#include "vectors.h"
@@ -233,14 +234,16 @@ read_complete_token (SCM port, char *buffer, size_t
buffer_size, size_t *read)
{
if (overflow_size == 0)
{
- overflow_buffer = scm_gc_malloc_pointerless (bytes_read, "read");
+ overflow_buffer = scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+ bytes_read);
memcpy (overflow_buffer, buffer, bytes_read);
overflow_size = bytes_read;
}
else
{
char *new_buf =
- scm_gc_malloc_pointerless (overflow_size + bytes_read, "read");
+ scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+ overflow_size + bytes_read);
memcpy (new_buf, overflow_buffer, overflow_size);
memcpy (new_buf + overflow_size, buffer, bytes_read);
@@ -1677,8 +1680,8 @@ is_encoding_char (char c)
/* Search the SCM_ENCODING_SEARCH_SIZE bytes of a file for an Emacs-like
- coding declaration. Returns either NULL or a string whose storage
- has been allocated with `scm_gc_malloc'. */
+ coding declaration. Returns the encoding as a GC-managed pointer, or
+ NULL. */
char *
scm_i_scan_for_encoding (SCM port)
{
diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c
index b064c2b65..d480a5309 100644
--- a/libguile/regex-posix.c
+++ b/libguile/regex-posix.c
@@ -182,7 +182,8 @@ SCM_DEFINE_STATIC (make_regexp, "make-regexp", 1, 0, 1,
flag = SCM_CDR (flag);
}
- rx = scm_gc_malloc_pointerless (sizeof (*rx), "regex");
+ rx = scm_allocate_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 e7e75cf14..601e33e6b 100644
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -37,6 +37,7 @@
#include "numbers.h"
#include "ports.h"
#include "programs.h"
+#include "threads.h"
#include "smob.h"
@@ -244,7 +245,8 @@ scm_make_smob (scm_t_bits tc)
scm_t_bits n = SCM_TC2SMOBNUM (tc);
size_t size = scm_smobs[n].size;
scm_t_bits data = (size > 0
- ? (scm_t_bits) scm_gc_malloc (size, SCM_SMOBNAME (n))
+ ? (scm_t_bits) scm_allocate_sloppy (SCM_I_CURRENT_THREAD,
+ size)
: 0);
SCM_RETURN_NEWSMOB (tc, data);
diff --git a/libguile/srfi-14.c b/libguile/srfi-14.c
index 833e1ceb4..e9e2af991 100644
--- a/libguile/srfi-14.c
+++ b/libguile/srfi-14.c
@@ -39,6 +39,7 @@
#include "procs.h"
#include "strings.h"
#include "symbols.h"
+#include "threads.h"
#include "values.h"
#include "version.h"
@@ -164,8 +165,8 @@ static struct scm_bytevector *empty_charset_ranges;
static struct scm_charset *
make_charset (struct scm_bytevector *ranges)
{
- struct scm_charset *p = scm_gc_malloc (sizeof (struct scm_charset),
- "charset");
+ struct scm_charset *p = scm_allocate_tagged (SCM_I_CURRENT_THREAD,
+ sizeof (struct scm_charset));
p->tag_and_flags = scm_tc16_charset;
p->ranges = ranges;
return p;
diff --git a/libguile/strings.c b/libguile/strings.c
index dd4103f16..728af4ec4 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -137,8 +137,9 @@ make_stringbuf (size_t len)
if (INT_ADD_OVERFLOW (len, STRINGBUF_HEADER_BYTES + 32))
scm_num_overflow ("make_stringbuf");
- buf = SCM_PACK_POINTER (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES +
len + 1,
- "string"));
+ buf = SCM_PACK_POINTER
+ (scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+ STRINGBUF_HEADER_BYTES + len + 1));
SCM_SET_CELL_TYPE (buf, STRINGBUF_TAG);
SCM_SET_CELL_WORD_1 (buf, (scm_t_bits) len);
@@ -171,8 +172,9 @@ make_wide_stringbuf (size_t len)
scm_num_overflow ("make_wide_stringbuf");
raw_len = (len + 1) * sizeof (scm_t_wchar);
- buf = SCM_PACK_POINTER (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES +
raw_len,
- "string"));
+ buf = SCM_PACK_POINTER
+ (scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+ STRINGBUF_HEADER_BYTES + raw_len));
SCM_SET_CELL_TYPE (buf, STRINGBUF_TAG | STRINGBUF_F_WIDE);
SCM_SET_CELL_WORD_1 (buf, (scm_t_bits) len);
@@ -1499,7 +1501,7 @@ decoding_error (const char *func_name, int errno_save,
SCM bv;
signed char *buf;
- buf = scm_gc_malloc_pointerless (len, "bytevector");
+ buf = scm_allocate_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/struct.c b/libguile/struct.c
index 7ba242a23..1af406bc7 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -141,8 +141,8 @@ set_vtable_access_fields (SCM vtable)
{
size_t bitmask_size = (nfields + 31U) / 32U;
unboxed_fields =
- scm_gc_malloc_pointerless (bitmask_size * sizeof (*unboxed_fields),
- "unboxed fields");
+ scm_allocate_pointerless (SCM_I_CURRENT_THREAD,
+ bitmask_size * sizeof (*unboxed_fields));
memset (unboxed_fields, 0, bitmask_size * sizeof (*unboxed_fields));
for (size_t field = 0; field < nfields; field++)
if (c_layout[field*2] == 'u')
diff --git a/libguile/threads.c b/libguile/threads.c
index a147126ea..3b0af1abd 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -1017,7 +1017,7 @@ SCM_DEFINE (scm_make_mutex_with_kind, "make-mutex", 0, 1,
0,
SCM_MISC_ERROR ("unsupported mutex kind: ~a", scm_list_1 (kind));
}
- m = scm_gc_malloc (sizeof (struct scm_mutex), "mutex");
+ m = scm_allocate_tagged (SCM_I_CURRENT_THREAD, sizeof (struct scm_mutex));
m->tag_and_flags = scm_tc16_mutex | (mkind << 16);
m->owner = SCM_BOOL_F;
m->waiting = make_queue ();
@@ -1353,7 +1353,7 @@ SCM_DEFINE (scm_make_condition_variable,
"make-condition-variable", 0, 0, 0,
#define FUNC_NAME s_scm_make_condition_variable
{
struct scm_cond *c =
- scm_gc_malloc (sizeof (struct scm_cond), "condition variable");
+ scm_allocate_tagged (SCM_I_CURRENT_THREAD, sizeof (struct scm_cond));
c->tag = scm_tc16_condition_variable;
c->waiting = make_queue ();
return scm_from_condvar (c);
diff --git a/libguile/threads.h b/libguile/threads.h
index c23683935..286a91713 100644
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -38,19 +38,6 @@
-#define SCM_INLINE_GC_GRANULE_WORDS 2
-#define SCM_INLINE_GC_GRANULE_BYTES \
- (sizeof(void *) * SCM_INLINE_GC_GRANULE_WORDS)
-
-/* A freelist set contains SCM_INLINE_GC_FREELIST_COUNT pointers to
- singly linked lists of objects of different sizes, the ith one
- containing objects i + 1 granules in size. This setting of
- SCM_INLINE_GC_FREELIST_COUNT will hold freelists for allocations of
- up to 256 bytes. */
-#define SCM_INLINE_GC_FREELIST_COUNT (256U / SCM_INLINE_GC_GRANULE_BYTES)
-
-
-
struct scm_thread_wake_data;
struct gc_mutator;
diff --git a/libguile/values.c b/libguile/values.c
index 50d24f1e4..4aca740c7 100644
--- a/libguile/values.c
+++ b/libguile/values.c
@@ -27,6 +27,7 @@
#include "list.h"
#include "numbers.h"
#include "pairs.h"
+#include "threads.h"
#include "values.h"
@@ -101,7 +102,8 @@ SCM_DEFINE (scm_values, "values", 0, 0, 1,
SCM_EOL, SCM_EOL);
struct scm_values *values =
- scm_gc_malloc (sizeof (struct scm_values) + n * sizeof (SCM), "values");
+ scm_allocate_tagged (SCM_I_CURRENT_THREAD,
+ sizeof (struct scm_values) + n * sizeof (SCM));
values->tag_and_count = scm_tc7_values | (n << 8);
for (i = 0; i < n; i++, args = SCM_CDR (args))
values->values[i] = SCM_CAR (args);
@@ -123,7 +125,8 @@ scm_c_values (SCM *base, size_t nvalues)
SCM_EOL, SCM_EOL);
struct scm_values *values =
- scm_gc_malloc (sizeof (struct scm_values) + nvalues * sizeof (SCM),
"values");
+ scm_allocate_tagged (SCM_I_CURRENT_THREAD,
+ sizeof (struct scm_values) + nvalues * sizeof (SCM));
values->tag_and_count = scm_tc7_values | (nvalues << 8);
@@ -137,7 +140,8 @@ SCM
scm_values_2 (SCM a, SCM b)
{
struct scm_values *values =
- scm_gc_malloc (sizeof (struct scm_values) + 2 * sizeof (SCM), "values");
+ scm_allocate_tagged (SCM_I_CURRENT_THREAD,
+ sizeof (struct scm_values) + 2 * sizeof (SCM));
values->tag_and_count = scm_tc7_values | (2 << 8);
values->values[0] = a;
@@ -150,7 +154,8 @@ SCM
scm_values_3 (SCM a, SCM b, SCM c)
{
struct scm_values *values =
- scm_gc_malloc (sizeof (struct scm_values) + 3 * sizeof (SCM), "values");
+ scm_allocate_tagged (SCM_I_CURRENT_THREAD,
+ sizeof (struct scm_values) + 3 * sizeof (SCM));
values->tag_and_count = scm_tc7_values | (3 << 8);
values->values[0] = a;
diff --git a/libguile/vm.c b/libguile/vm.c
index cad695471..96a5b883d 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -171,8 +171,8 @@ capture_stack (scm_thread *thread,
stack_size = stack_top - sp;
- p = scm_gc_malloc (sizeof (*p) + stack_size * sizeof (p->stack_slice[0]),
- "capture_vm_cont");
+ p = scm_allocate_tagged (SCM_I_CURRENT_THREAD,
+ sizeof (*p) + stack_size * sizeof
(p->stack_slice[0]));
p->tag_and_flags = scm_tc7_vm_cont | flags;
p->dynstack = dynstack;
p->vra = vra;
@@ -480,12 +480,13 @@ define_vm_builtins (void)
SCM_PACK_OP_24 (return_from_interrupt, 0)
};
+ struct scm_thread *thr = SCM_I_CURRENT_THREAD;
#define DEFINE_BUILTIN(builtin, BUILTIN, req, opt, rest) \
{ \
size_t sz = sizeof (builtin##_code); \
vm_builtin_##builtin##_code = instrumented_code (builtin##_code, sz); \
struct scm_program *p = \
- scm_gc_malloc_pointerless (sizeof (struct scm_program), "builtin"); \
+ scm_allocate_pointerless (thr, sizeof (struct scm_program)); \
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; \
