From f2ad6525e65f92d230a43bbc9e3dd9c2e3d2fe16 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 20 Jun 2025 11:40:01 +0200 Subject: [PATCH] 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 +#include /* * 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; \