From 4c9419ac31f8364db51ccf25f7f9d5d31dd412e7 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Mon, 11 Feb 2002 18:06:50 +0000 Subject: [PATCH] * gc.h, gc.c (scm_gc_sweep): Issue deprecation warning when non-zero is returned from a port or smob free function. (scm_malloc, scm_realloc, scm_strndup, scm_strdup, scm_gc_register_collectable_memory, scm_gc_unregister_collectable_memory, scm_gc_malloc, scm_gc_realloc, scm_gc_free, scm_gc_strndup, scm_gc_strdup): New. * backtrace.c, continuations.c, convert.i.c, coop-threads.c, debug-malloc.c, dynl.c, environments.c, environments.h, extensions.c, filesys.c, fports.c, gc.c, gc.h, gh_data.c, goops.c, guardians.c, hooks.c, init.c, keywords.c, load.c, numbers.c, ports.c, posix.c, procs.c, rdelim.c, regex-posix.c, root.c, smob.c, stime.c, strings.c, struct.c, struct.h, symbols.c, unif.c, vectors.c, weaks.c: Use scm_gc_malloc/scm_malloc and scm_gc_free/free instead of scm_must_malloc and scm_must_free, as appropriate. Return zero from smob and port free functions. * debug-malloc.c (scm_malloc_reregister): Handle "old == NULL". * fports.c (scm_setvbuf): Reset read buffer to saved values when it is pointing to the putback buffer. --- libguile/backtrace.c | 5 +- libguile/continuations.c | 17 ++-- libguile/convert.i.c | 6 +- libguile/coop-threads.c | 16 +-- libguile/debug-malloc.c | 47 +++++---- libguile/dynl.c | 11 +- libguile/environments.c | 39 ++++---- libguile/environments.h | 2 +- libguile/extensions.c | 7 +- libguile/filesys.c | 16 +-- libguile/fports.c | 26 +++-- libguile/gc.c | 211 +++++++++++++++++++++++++++++++++++---- libguile/gc.h | 16 +++ libguile/gh_data.c | 12 +-- libguile/goops.c | 21 ++-- libguile/guardians.c | 6 +- libguile/hooks.c | 5 +- libguile/init.c | 2 +- libguile/keywords.c | 5 +- libguile/load.c | 5 +- libguile/numbers.c | 11 +- libguile/ports.c | 32 +++--- libguile/posix.c | 18 ++-- libguile/procs.c | 12 +-- libguile/rdelim.c | 14 ++- libguile/regex-posix.c | 10 +- libguile/root.c | 8 +- libguile/smob.c | 9 +- libguile/stime.c | 26 ++--- libguile/strings.c | 4 +- libguile/struct.c | 29 +++--- libguile/struct.h | 13 +-- libguile/symbols.c | 10 +- libguile/unif.c | 18 ++-- libguile/vectors.c | 2 +- libguile/weaks.c | 2 +- 36 files changed, 439 insertions(+), 254 deletions(-) diff --git a/libguile/backtrace.c b/libguile/backtrace.c index baa0e6e1a..feed5a12f 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -312,10 +312,9 @@ SCM_DEFINE (scm_set_print_params_x, "set-print-params!", 1, 0, 0, params, SCM_ARG2, s_scm_set_print_params_x); - new_params = scm_must_malloc (n * sizeof (print_params_t), - FUNC_NAME); + new_params = scm_malloc (n * sizeof (print_params_t)); if (print_params != default_print_params) - scm_must_free (print_params); + free (print_params); print_params = new_params; for (i = 0; i < n; ++i) { diff --git a/libguile/continuations.c b/libguile/continuations.c index cd89110fa..efc96de28 100644 --- a/libguile/continuations.c +++ b/libguile/continuations.c @@ -94,11 +94,11 @@ continuation_free (SCM obj) + extra_items * sizeof (SCM_STACKITEM); #ifdef __ia64__ - bytes_free += continuation->backing_store_size; - scm_must_free (continuation->backing_store); + scm_gc_free (continuation->backing_store, continuation->backing_store_size, + "continuation backing store"); #endif /* __ia64__ */ - scm_must_free (continuation); - return bytes_free; + scm_gc_free (continuation, bytes_free, "continuation"); + return 0; } static int @@ -146,9 +146,9 @@ scm_make_continuation (int *first) SCM_ENTER_A_SECTION; SCM_FLUSH_REGISTER_WINDOWS; stack_size = scm_stack_size (rootcont->base); - continuation = scm_must_malloc (sizeof (scm_t_contregs) - + (stack_size - 1) * sizeof (SCM_STACKITEM), - FUNC_NAME); + continuation = scm_gc_malloc (sizeof (scm_t_contregs) + + (stack_size - 1) * sizeof (SCM_STACKITEM), + "continuation"); continuation->num_stack_items = stack_size; continuation->dynenv = scm_dynwinds; continuation->throw_value = SCM_EOL; @@ -174,7 +174,8 @@ scm_make_continuation (int *first) (unsigned long) __libc_ia64_register_backing_store_base; continuation->backing_store = NULL; continuation->backing_store = - scm_must_malloc (continuation->backing_store_size, FUNC_NAME); + scm_gc_malloc (continuation->backing_store_size, + "continuation backing store"); memcpy (continuation->backing_store, (void *) __libc_ia64_register_backing_store_base, continuation->backing_store_size); diff --git a/libguile/convert.i.c b/libguile/convert.i.c index 118182943..7ab0eae25 100644 --- a/libguile/convert.i.c +++ b/libguile/convert.i.c @@ -152,8 +152,7 @@ CTYPES2UVECT (const CTYPE *data, long n) SCM_ASSERT_RANGE (SCM_ARG2, scm_long2num (n), n > 0 && n <= SCM_UVECTOR_MAX_LENGTH); - if ((v = (char *) SCM_MUST_MALLOC_TYPE_NUM (CTYPE, n)) == NULL) - return SCM_UNDEFINED; + v = scm_gc_malloc (sizeof (CTYPE) * n, "vector"); memcpy (v, data, n * sizeof (CTYPE)); return scm_alloc_cell (SCM_MAKE_UVECTOR_TAG (n, UVECTTYPE), (scm_t_bits) v); } @@ -168,8 +167,7 @@ CTYPES2UVECT2 (const unsigned CTYPE *data, long n) SCM_ASSERT_RANGE (SCM_ARG2, scm_long2num (n), n > 0 && n <= SCM_UVECTOR_MAX_LENGTH); - if ((v = (char *) SCM_MUST_MALLOC_TYPE_NUM (unsigned CTYPE, n)) == NULL) - return SCM_UNDEFINED; + v = scm_gc_malloc (sizeof (unsigned CTYPE) * n, "vector"); memcpy (v, data, n * sizeof (unsigned CTYPE)); return scm_alloc_cell (SCM_MAKE_UVECTOR_TAG (n, UVECTTYPE2), (scm_t_bits) v); } diff --git a/libguile/coop-threads.c b/libguile/coop-threads.c index 659264fc7..95498b310 100644 --- a/libguile/coop-threads.c +++ b/libguile/coop-threads.c @@ -324,7 +324,7 @@ c_launch_thread (void *p) data, (SCM_STACKITEM *) &thread); scm_thread_count--; - scm_must_free ((char *) data); + free ((char *) data); } SCM @@ -334,8 +334,7 @@ scm_spawn_thread (scm_t_catch_body body, void *body_data, SCM thread; coop_t *t; SCM root, old_winds; - c_launch_data *data = (c_launch_data *) scm_must_malloc (sizeof (*data), - "scm_spawn_thread"); + c_launch_data *data = (c_launch_data *) scm_malloc (sizeof (*data)); /* Unwind wind chain. */ old_winds = scm_dynwinds; @@ -414,11 +413,8 @@ scm_single_thread_p (void) SCM scm_make_mutex (void) { - SCM m; - coop_m *data = (coop_m *) scm_must_malloc (sizeof (coop_m), "mutex"); - - SCM_NEWSMOB (m, scm_tc16_mutex, (scm_t_bits) data); - coop_mutex_init (data); + SCM m = scm_make_smob (scm_tc16_mutex); + coop_mutex_init (SCM_MUTEX_DATA (m)); return m; } @@ -446,9 +442,7 @@ scm_unlock_mutex (SCM m) SCM scm_make_condition_variable (void) { - SCM c; - coop_c *data = (coop_c *) scm_must_malloc (sizeof (coop_c), "condvar"); - SCM_NEWSMOB (c, scm_tc16_condvar, (scm_t_bits) data); + SCM c = scm_make_smob (scm_tc16_condvar); coop_condition_variable_init (SCM_CONDVAR_DATA (c)); return c; } diff --git a/libguile/debug-malloc.c b/libguile/debug-malloc.c index b3c5133d0..e85423dd1 100644 --- a/libguile/debug-malloc.c +++ b/libguile/debug-malloc.c @@ -183,7 +183,7 @@ scm_malloc_unregister (void *obj) if (type == 0) { fprintf (stderr, - "scm_must_free called on object not allocated with scm_must_malloc\n"); + "scm_gc_free called on object not allocated with scm_gc_malloc\n"); abort (); } type->data = (void *) ((int) type->data - 1); @@ -194,29 +194,36 @@ void scm_malloc_reregister (void *old, void *new, const char *newwhat) { hash_entry_t *object, *type; - GET_CREATE_HASH_ENTRY (object, object, old, l1); - type = (hash_entry_t *) object->data; - if (type == 0) - { - fprintf (stderr, - "scm_must_realloc called on object not allocated with scm_must_malloc\n"); - abort (); - } - if (strcmp ((char *) type->key, newwhat) != 0) + + if (old == NULL) + scm_malloc_register (new, newwhat); + else { - if (strcmp (newwhat, "vector-set-length!") != 0) + GET_CREATE_HASH_ENTRY (object, object, old, l1); + type = (hash_entry_t *) object->data; + if (type == 0) { fprintf (stderr, - "scm_must_realloc called with arg %s, was %s\n", - newwhat, - (char *) type->key); + "scm_gc_realloc called on object not allocated " + "with scm_gc_malloc\n"); abort (); } - } - if (new != old) - { - object->key = 0; - CREATE_HASH_ENTRY (object, new, type, l2); + if (strcmp ((char *) type->key, newwhat) != 0) + { + if (strcmp (newwhat, "vector-set-length!") != 0) + { + fprintf (stderr, + "scm_gc_realloc called with arg %s, was %s\n", + newwhat, + (char *) type->key); + abort (); + } + } + if (new != old) + { + object->key = 0; + CREATE_HASH_ENTRY (object, new, type, l2); + } } } @@ -224,7 +231,7 @@ SCM_DEFINE (scm_malloc_stats, "malloc-stats", 0, 0, 0, (), "Return an alist ((@var{what} . @var{n}) ...) describing number\n" "of malloced objects.\n" - "@var{what} is the second argument to @code{scm_must_malloc},\n" + "@var{what} is the second argument to @code{scm_gc_malloc},\n" "@var{n} is the number of objects of that type currently\n" "allocated.") #define FUNC_NAME s_scm_malloc_stats diff --git a/libguile/dynl.c b/libguile/dynl.c index d920b2d7a..c3861cf71 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -89,7 +89,8 @@ maybe_drag_in_eprintf () (Dirk: IMO strings.c is not the right place.) */ static char ** -scm_make_argv_from_stringlist (SCM args,int *argcp,const char *subr,int argn) +scm_make_argv_from_stringlist (SCM args, int *argcp, const char *subr, + int argn) { char **argv; int argc; @@ -97,7 +98,7 @@ scm_make_argv_from_stringlist (SCM args,int *argcp,const char *subr,int argn) argc = scm_ilength (args); SCM_ASSERT (argc >= 0, args, argn, subr); - argv = (char **) scm_must_malloc ((argc + 1) * sizeof (char *), subr); + argv = (char **) scm_malloc ((argc + 1) * sizeof (char *)); for (i = 0; !SCM_NULL_OR_NIL_P (args); args = SCM_CDR (args), ++i) { SCM arg = SCM_CAR (args); size_t len; @@ -107,7 +108,7 @@ scm_make_argv_from_stringlist (SCM args,int *argcp,const char *subr,int argn) SCM_ASSERT (SCM_STRINGP (arg), args, argn, subr); len = SCM_STRING_LENGTH (arg); src = SCM_STRING_CHARS (arg); - dst = (char *) scm_must_malloc (len + 1, subr); + dst = (char *) scm_malloc (len + 1); memcpy (dst, src, len); dst[len] = 0; argv[i] = dst; @@ -120,7 +121,7 @@ scm_make_argv_from_stringlist (SCM args,int *argcp,const char *subr,int argn) } static void -scm_must_free_argv(char **argv) +scm_free_argv (char **argv) { char **av = argv; while (*av) @@ -398,7 +399,7 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0, SCM_DEFER_INTS; argv = scm_make_argv_from_stringlist (args, &argc, FUNC_NAME, SCM_ARG3); result = (*fptr) (argc, argv); - scm_must_free_argv (argv); + scm_free_argv (argv); SCM_ALLOW_INTS; return SCM_MAKINUM (0L + result); diff --git a/libguile/environments.c b/libguile/environments.c index 237c8b28e..3db13b036 100644 --- a/libguile/environments.c +++ b/libguile/environments.c @@ -476,7 +476,8 @@ environment_mark (SCM env) static size_t environment_free (SCM env) { - return (*(SCM_ENVIRONMENT_FUNCS (env)->free)) (env); + (*(SCM_ENVIRONMENT_FUNCS (env)->free)) (env); + return 0; } @@ -984,13 +985,12 @@ leaf_environment_mark (SCM env) } -static size_t +static void leaf_environment_free (SCM env) { core_environments_finalize (env); - - free (LEAF_ENVIRONMENT (env)); - return sizeof (struct leaf_environment); + scm_gc_free (LEAF_ENVIRONMENT (env), sizeof (struct leaf_environment), + "leaf environment"); } @@ -1034,7 +1034,7 @@ SCM_DEFINE (scm_make_leaf_environment, "make-leaf-environment", 0, 0, 0, #define FUNC_NAME s_scm_make_leaf_environment { size_t size = sizeof (struct leaf_environment); - struct leaf_environment *body = scm_must_malloc (size, FUNC_NAME); + struct leaf_environment *body = scm_gc_malloc (size, "leaf environment"); SCM env; core_environments_preinit (&body->base); @@ -1345,13 +1345,12 @@ eval_environment_mark (SCM env) } -static size_t +static void eval_environment_free (SCM env) { core_environments_finalize (env); - - free (EVAL_ENVIRONMENT (env)); - return sizeof (struct eval_environment); + scm_gc_free (EVAL_ENVIRONMENT (env), sizeof (struct eval_environment), + "eval environment"); } @@ -1428,7 +1427,7 @@ SCM_DEFINE (scm_make_eval_environment, "make-eval-environment", 2, 0, 0, SCM_ASSERT (SCM_ENVIRONMENT_P (local), local, SCM_ARG1, FUNC_NAME); SCM_ASSERT (SCM_ENVIRONMENT_P (imported), imported, SCM_ARG2, FUNC_NAME); - body = scm_must_malloc (sizeof (struct eval_environment), FUNC_NAME); + body = scm_gc_malloc (sizeof (struct eval_environment), "eval environment"); core_environments_preinit (&body->base); body->obarray = SCM_BOOL_F; @@ -1764,13 +1763,12 @@ import_environment_mark (SCM env) } -static size_t +static void import_environment_free (SCM env) { core_environments_finalize (env); - - free (IMPORT_ENVIRONMENT (env)); - return sizeof (struct import_environment); + scm_gc_free (IMPORT_ENVIRONMENT (env), sizeof (struct import_environment), + "import environment"); } @@ -1844,7 +1842,7 @@ SCM_DEFINE (scm_make_import_environment, "make-import-environment", 2, 0, 0, #define FUNC_NAME s_scm_make_import_environment { size_t size = sizeof (struct import_environment); - struct import_environment *body = scm_must_malloc (size, FUNC_NAME); + struct import_environment *body = scm_gc_malloc (size, "import environment"); SCM env; core_environments_preinit (&body->base); @@ -2070,13 +2068,12 @@ export_environment_mark (SCM env) } -static size_t +static void export_environment_free (SCM env) { core_environments_finalize (env); - - free (EXPORT_ENVIRONMENT (env)); - return sizeof (struct export_environment); + scm_gc_free (EXPORT_ENVIRONMENT (env), sizeof (struct export_environment), + "export environment"); } @@ -2171,7 +2168,7 @@ SCM_DEFINE (scm_make_export_environment, "make-export-environment", 2, 0, 0, SCM_ASSERT (SCM_ENVIRONMENT_P (private), private, SCM_ARG1, FUNC_NAME); size = sizeof (struct export_environment); - body = scm_must_malloc (size, FUNC_NAME); + body = scm_gc_malloc (size, "export environment"); core_environments_preinit (&body->base); body->private = SCM_BOOL_F; diff --git a/libguile/environments.h b/libguile/environments.h index 5488adba6..bb6ee8a47 100644 --- a/libguile/environments.h +++ b/libguile/environments.h @@ -76,7 +76,7 @@ struct scm_environment_funcs { void (*unobserve) (SCM self, SCM token); SCM (*mark) (SCM self); - size_t (*free) (SCM self); + void (*free) (SCM self); int (*print) (SCM self, SCM port, scm_print_state *pstate); }; diff --git a/libguile/extensions.c b/libguile/extensions.c index 5200eb440..83bcee2a1 100644 --- a/libguile/extensions.c +++ b/libguile/extensions.c @@ -74,13 +74,12 @@ void scm_c_register_extension (const char *lib, const char *init, void (*func) (void *), void *data) { - extension_t *ext = scm_must_malloc (sizeof(extension_t), - "scm_register_extension"); + extension_t *ext = scm_malloc (sizeof(extension_t)); if (lib) - ext->lib = scm_must_strdup (lib); + ext->lib = scm_strdup (lib); else ext->lib = NULL; - ext->init = scm_must_strdup (init); + ext->init = scm_strdup (init); ext->func = func; ext->data = data; diff --git a/libguile/filesys.c b/libguile/filesys.c index 862579c10..15593b4e8 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -942,17 +942,17 @@ SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0, char *wd; SCM result; - wd = scm_must_malloc (size, FUNC_NAME); + wd = scm_malloc (size); while ((rv = getcwd (wd, size)) == 0 && errno == ERANGE) { - scm_must_free (wd); + free (wd); size *= 2; - wd = scm_must_malloc (size, FUNC_NAME); + wd = scm_malloc (size); } if (rv == 0) SCM_SYSERROR; result = scm_mem2string (wd, strlen (wd)); - scm_must_free (wd); + free (wd); return result; } #undef FUNC_NAME @@ -1367,17 +1367,17 @@ SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0, char *buf; SCM result; SCM_VALIDATE_STRING (1, path); - buf = scm_must_malloc (size, FUNC_NAME); + buf = scm_malloc (size); while ((rv = readlink (SCM_STRING_CHARS (path), buf, size)) == size) { - scm_must_free (buf); + free (buf); size *= 2; - buf = scm_must_malloc (size, FUNC_NAME); + buf = scm_malloc (size); } if (rv == -1) SCM_SYSERROR; result = scm_mem2string (buf, rv); - scm_must_free (buf); + free (buf); return result; } #undef FUNC_NAME diff --git a/libguile/fports.c b/libguile/fports.c index 2ce9c4a0d..e4e34700f 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -111,7 +111,7 @@ scm_fport_buffer_add (SCM port, long read_size, int write_size) if (SCM_INPUT_PORT_P (port) && read_size > 0) { - pt->read_buf = scm_must_malloc (read_size, FUNC_NAME); + pt->read_buf = scm_gc_malloc (read_size, "port buffer"); pt->read_pos = pt->read_end = pt->read_buf; pt->read_buf_size = read_size; } @@ -123,7 +123,7 @@ scm_fport_buffer_add (SCM port, long read_size, int write_size) if (SCM_OUTPUT_PORT_P (port) && write_size > 0) { - pt->write_buf = scm_must_malloc (write_size, FUNC_NAME); + pt->write_buf = scm_gc_malloc (write_size, "port buffer"); pt->write_pos = pt->write_buf; pt->write_buf_size = write_size; } @@ -192,11 +192,18 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, pt = SCM_PTAB_ENTRY (port); - /* silently discards buffered chars. */ + /* silently discards buffered and put-back chars. */ + if (pt->read_buf == pt->putback_buf) + { + pt->read_buf = pt->saved_read_buf; + pt->read_pos = pt->saved_read_pos; + pt->read_end = pt->saved_read_end; + pt->read_buf_size = pt->saved_read_buf_size; + } if (pt->read_buf != &pt->shortbuf) - scm_must_free (pt->read_buf); + scm_gc_free (pt->read_buf, pt->read_buf_size, "port buffer"); if (pt->write_buf != &pt->shortbuf) - scm_must_free (pt->write_buf); + scm_gc_free (pt->write_buf, pt->write_buf_size, "port buffer"); scm_fport_buffer_add (port, csize, csize); return SCM_UNSPECIFIED; @@ -436,8 +443,7 @@ scm_fdes_to_port (int fdes, char *mode, SCM name) { scm_t_fport *fp - = (scm_t_fport *) scm_must_malloc (sizeof (scm_t_fport), - FUNC_NAME); + = (scm_t_fport *) scm_gc_malloc (sizeof (scm_t_fport), "file port"); fp->fdes = fdes; pt->rw_random = SCM_FDES_RANDOM_P (fdes); @@ -820,10 +826,10 @@ fport_close (SCM port) if (pt->read_buf == pt->putback_buf) pt->read_buf = pt->saved_read_buf; if (pt->read_buf != &pt->shortbuf) - scm_must_free (pt->read_buf); + scm_gc_free (pt->read_buf, pt->read_buf_size, "port buffer"); if (pt->write_buf != &pt->shortbuf) - scm_must_free (pt->write_buf); - scm_must_free ((char *) fp); + scm_gc_free (pt->write_buf, pt->write_buf_size, "port buffer"); + scm_gc_free (fp, sizeof (*fp), "file port"); return rv; } diff --git a/libguile/gc.c b/libguile/gc.c index 8abe7f5e0..86a1a918d 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -241,8 +241,8 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0, * INIT_MALLOC_LIMIT is the initial amount of malloc usage which will * trigger a GC. * - * SCM_MTRIGGER_HYSTERESIS is the amount of malloc storage that must be - * reclaimed by a GC triggered by must_malloc. If less than this is + * SCM_MTRIGGER_HYSTERESIS is the amount of malloc storage that must + * be reclaimed by a GC triggered by a malloc. If less than this is * reclaimed, the trigger threshold is raised. [I don't know what a * good value is. I arbitrarily chose 1/10 of the INIT_MALLOC_LIMIT to * work around a oscillation that caused almost constant GC.] @@ -1635,15 +1635,17 @@ scm_gc_sweep () unsigned long int length = SCM_VECTOR_LENGTH (scmptr); if (length > 0) { - m += length * sizeof (scm_t_bits); - scm_must_free (SCM_VECTOR_BASE (scmptr)); + scm_gc_free (SCM_VECTOR_BASE (scmptr), + length * sizeof (scm_t_bits), + "vector"); } break; } #ifdef CCLO case scm_tc7_cclo: - m += (SCM_CCLO_LENGTH (scmptr) * sizeof (SCM)); - scm_must_free (SCM_CCLO_BASE (scmptr)); + scm_gc_free (SCM_CCLO_BASE (scmptr), + SCM_CCLO_LENGTH (scmptr) * sizeof (SCM), + "compiled closure"); break; #endif #ifdef HAVE_ARRAYS @@ -1652,8 +1654,10 @@ scm_gc_sweep () unsigned long int length = SCM_BITVECTOR_LENGTH (scmptr); if (length > 0) { - m += sizeof (long) * ((length + SCM_LONG_BIT - 1) / SCM_LONG_BIT); - scm_must_free (SCM_BITVECTOR_BASE (scmptr)); + scm_gc_free (SCM_BITVECTOR_BASE (scmptr), + (sizeof (long) + * ((length+SCM_LONG_BIT-1) / SCM_LONG_BIT)), + "vector"); } } break; @@ -1667,17 +1671,19 @@ scm_gc_sweep () case scm_tc7_fvect: case scm_tc7_dvect: case scm_tc7_cvect: - m += SCM_UVECTOR_LENGTH (scmptr) * scm_uniform_element_size (scmptr); - scm_must_free (SCM_UVECTOR_BASE (scmptr)); + scm_gc_free (SCM_UVECTOR_BASE (scmptr), + (SCM_UVECTOR_LENGTH (scmptr) + * scm_uniform_element_size (scmptr)), + "vector"); break; #endif case scm_tc7_string: - m += SCM_STRING_LENGTH (scmptr) + 1; - scm_must_free (SCM_STRING_CHARS (scmptr)); + scm_gc_free (SCM_STRING_CHARS (scmptr), + SCM_STRING_LENGTH (scmptr) + 1, "string"); break; case scm_tc7_symbol: - m += SCM_SYMBOL_LENGTH (scmptr) + 1; - scm_must_free (SCM_SYMBOL_CHARS (scmptr)); + scm_gc_free (SCM_SYMBOL_CHARS (scmptr), + SCM_SYMBOL_LENGTH (scmptr) + 1, "symbol"); break; case scm_tc7_variable: break; @@ -1688,6 +1694,7 @@ scm_gc_sweep () if SCM_OPENP (scmptr) { int k = SCM_PTOBNUM (scmptr); + size_t mm; #if (SCM_DEBUG_CELL_ACCESSES == 1) || (defined (GUILE_DEBUG_FREELIST)) if (!(k < scm_numptob)) SCM_MISC_ERROR ("undefined port type", SCM_EOL); @@ -1698,7 +1705,19 @@ scm_gc_sweep () /* Yes, I really do mean scm_ptobs[k].free */ /* rather than ftobs[k].close. .close */ /* is for explicit CLOSE-PORT by user */ - m += (scm_ptobs[k].free) (scmptr); + mm = scm_ptobs[k].free (scmptr); + + if (mm != 0) + { + scm_c_issue_deprecation_warning + ("Returning non-0 from a port free function is " + "deprecated. Use scm_gc_free et al instead."); + scm_c_issue_deprecation_warning_fmt + ("(You just returned non-0 while freeing a %s.)", + SCM_PTOBNAME (k)); + m += mm; + } + SCM_SETSTREAM (scmptr, 0); scm_remove_from_port_table (scmptr); scm_gc_ports_collected++; @@ -1713,13 +1732,14 @@ scm_gc_sweep () break; #ifdef SCM_BIGDIG case scm_tc16_big: - m += (SCM_NUMDIGS (scmptr) * SCM_BITSPERDIG / SCM_CHAR_BIT); - scm_must_free (SCM_BDIGITS (scmptr)); + scm_gc_free (SCM_BDIGITS (scmptr), + ((SCM_NUMDIGS (scmptr) * SCM_BITSPERDIG + / SCM_CHAR_BIT)), "bignum"); break; #endif /* def SCM_BIGDIG */ case scm_tc16_complex: - m += sizeof (scm_t_complex); - scm_must_free (SCM_COMPLEX_MEM (scmptr)); + scm_gc_free (SCM_COMPLEX_MEM (scmptr), 2*sizeof (double), + "complex"); break; default: { @@ -1730,7 +1750,20 @@ scm_gc_sweep () SCM_MISC_ERROR ("undefined smob type", SCM_EOL); #endif if (scm_smobs[k].free) - m += (scm_smobs[k].free) (scmptr); + { + size_t mm; + mm = scm_smobs[k].free (scmptr); + if (mm != 0) + { + scm_c_issue_deprecation_warning + ("Returning non-0 from a smob free function is " + "deprecated. Use scm_gc_free et al instead."); + scm_c_issue_deprecation_warning_fmt + ("(You just returned non-0 while freeing a %s.)", + SCM_SMOBNAME (k)); + m += mm; + } + } break; } } @@ -1814,7 +1847,141 @@ scm_gc_sweep () -/* {Front end to malloc} +/* Function for non-cell memory management. + */ + +void * +scm_malloc (size_t size) +{ + void *ptr; + + if (size == 0) + return NULL; + + SCM_SYSCALL (ptr = malloc (size)); + if (ptr) + return ptr; + + scm_igc ("malloc"); + SCM_SYSCALL (ptr = malloc (size)); + if (ptr) + return ptr; + + scm_memory_error ("malloc"); +} + +void * +scm_realloc (void *mem, size_t size) +{ + void *ptr; + + SCM_SYSCALL (ptr = realloc (mem, size)); + if (ptr) + return ptr; + + scm_igc ("realloc"); + SCM_SYSCALL (ptr = realloc (mem, size)); + if (ptr) + return ptr; + + scm_memory_error ("realloc"); +} + +char * +scm_strndup (const char *str, size_t n) +{ + char *dst = scm_malloc (n+1); + memcpy (dst, str, n); + dst[n] = 0; + return dst; +} + +char * +scm_strdup (const char *str) +{ + return scm_strndup (str, strlen (str)); +} + +void +scm_gc_register_collectable_memory (void *mem, size_t size, const char *what) +{ + scm_mallocated += size; + + if (scm_mallocated > scm_mtrigger) + { + scm_igc (what); + if (scm_mallocated > scm_mtrigger - SCM_MTRIGGER_HYSTERESIS) + { + if (scm_mallocated > scm_mtrigger) + scm_mtrigger = scm_mallocated + scm_mallocated / 2; + else + scm_mtrigger += scm_mtrigger / 2; + } + } + +#ifdef GUILE_DEBUG_MALLOC + scm_malloc_register (mem, what); +#endif +} + +void +scm_gc_unregister_collectable_memory (void *mem, size_t size, const char *what) +{ + scm_mallocated -= size; + +#ifdef GUILE_DEBUG_MALLOC + scm_malloc_unregister (mem); +#endif +} + +void * +scm_gc_malloc (size_t size, const char *what) +{ + /* XXX - The straightforward implementation below has the problem + that it might call the GC twice, once in scm_malloc and then + again in scm_gc_register_collectable_memory. We don't really + want the second GC. + */ + + void *ptr = scm_malloc (size); + scm_gc_register_collectable_memory (ptr, size, what); + return ptr; +} + +void * +scm_gc_realloc (void *mem, size_t old_size, size_t new_size, const char *what) +{ + /* XXX - see scm_gc_malloc. */ + + void *ptr = scm_realloc (mem, new_size); + scm_gc_unregister_collectable_memory (mem, old_size, what); + scm_gc_register_collectable_memory (ptr, new_size, what); + return ptr; +} + +void +scm_gc_free (void *mem, size_t size, const char *what) +{ + scm_gc_unregister_collectable_memory (mem, size, what); + free (mem); +} + +char * +scm_gc_strndup (const char *str, size_t n, const char *what) +{ + char *dst = scm_gc_malloc (n+1, what); + memcpy (dst, str, n); + dst[n] = 0; + return dst; +} + +char * +scm_gc_strdup (const char *str, const char *what) +{ + return scm_gc_strndup (str, strlen (str), what); +} + +/* {Deprecated front end to malloc} * * scm_must_malloc, scm_must_realloc, scm_must_free, scm_done_malloc, * scm_done_free @@ -2660,7 +2827,7 @@ scm_init_storage () j = SCM_HEAP_SEG_SIZE; scm_mtrigger = SCM_INIT_MALLOC_LIMIT; scm_heap_table = ((scm_t_heap_seg_data *) - scm_must_malloc (sizeof (scm_t_heap_seg_data) * 2, "hplims")); + scm_malloc (sizeof (scm_t_heap_seg_data) * 2)); heap_segment_table_size = 2; mark_space_ptr = &mark_space_head; diff --git a/libguile/gc.h b/libguile/gc.h index 7cfc996f5..48a8d8d31 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -326,6 +326,22 @@ SCM_API void scm_gc_mark_dependencies (SCM p); SCM_API void scm_mark_locations (SCM_STACKITEM x[], unsigned long n); SCM_API int scm_cellp (SCM value); SCM_API void scm_gc_sweep (void); + +SCM_API void *scm_malloc (size_t size); +SCM_API void *scm_realloc (void *mem, size_t size); +SCM_API char *scm_strdup (const char *str); +SCM_API char *scm_strndup (const char *str, size_t n); +SCM_API void scm_gc_register_collectable_memory (void *mem, size_t size, + const char *what); +SCM_API void scm_gc_unregister_collectable_memory (void *mem, size_t size, + const char *what); +SCM_API void *scm_gc_malloc (size_t size, const char *what); +SCM_API void *scm_gc_realloc (void *mem, size_t old_size, + size_t new_size, const char *what); +SCM_API void scm_gc_free (void *mem, size_t size, const char *what); +SCM_API char *scm_gc_strdup (const char *str, const char *what); +SCM_API char *scm_gc_strndup (const char *str, size_t n, const char *what); + SCM_API void * scm_must_malloc (size_t len, const char *what); SCM_API void * scm_must_realloc (void *where, size_t olen, size_t len, diff --git a/libguile/gh_data.c b/libguile/gh_data.c index 738eeb687..ceef34db0 100644 --- a/libguile/gh_data.c +++ b/libguile/gh_data.c @@ -155,7 +155,7 @@ makvect (char *m, size_t len, int type) SCM gh_chars2byvect (const char *d, long n) { - char *m = scm_must_malloc (n * sizeof (char), "vector"); + char *m = scm_gc_malloc (n * sizeof (char), "vector"); memcpy (m, d, n * sizeof (char)); return makvect (m, n, scm_tc7_byvect); } @@ -163,7 +163,7 @@ gh_chars2byvect (const char *d, long n) SCM gh_shorts2svect (const short *d, long n) { - char *m = scm_must_malloc (n * sizeof (short), "vector"); + char *m = scm_gc_malloc (n * sizeof (short), "vector"); memcpy (m, d, n * sizeof (short)); return makvect (m, n, scm_tc7_svect); } @@ -171,7 +171,7 @@ gh_shorts2svect (const short *d, long n) SCM gh_longs2ivect (const long *d, long n) { - char *m = scm_must_malloc (n * sizeof (long), "vector"); + char *m = scm_gc_malloc (n * sizeof (long), "vector"); memcpy (m, d, n * sizeof (long)); return makvect (m, n, scm_tc7_ivect); } @@ -179,7 +179,7 @@ gh_longs2ivect (const long *d, long n) SCM gh_ulongs2uvect (const unsigned long *d, long n) { - char *m = scm_must_malloc (n * sizeof (unsigned long), "vector"); + char *m = scm_gc_malloc (n * sizeof (unsigned long), "vector"); memcpy (m, d, n * sizeof (unsigned long)); return makvect (m, n, scm_tc7_uvect); } @@ -187,7 +187,7 @@ gh_ulongs2uvect (const unsigned long *d, long n) SCM gh_floats2fvect (const float *d, long n) { - char *m = scm_must_malloc (n * sizeof (float), "vector"); + char *m = scm_gc_malloc (n * sizeof (float), "vector"); memcpy (m, d, n * sizeof (float)); return makvect (m, n, scm_tc7_fvect); } @@ -195,7 +195,7 @@ gh_floats2fvect (const float *d, long n) SCM gh_doubles2dvect (const double *d, long n) { - char *m = scm_must_malloc (n * sizeof (double), "vector"); + char *m = scm_gc_malloc (n * sizeof (double), "vector"); memcpy (m, d, n * sizeof (double)); return makvect (m, n, scm_tc7_dvect); } diff --git a/libguile/goops.c b/libguile/goops.c index a3b179c72..5c9e0f99b 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -495,7 +495,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0, SCM_MISC_ERROR ("class object doesn't have enough fields: ~S", scm_list_1 (nfields)); - s = n > 0 ? scm_must_malloc (n, FUNC_NAME) : 0; + s = n > 0 ? scm_malloc (n) : 0; for (i = 0; i < n; i += 2) { long len; @@ -544,7 +544,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0, } SCM_SET_SLOT (class, scm_si_layout, scm_mem2symbol (s, n)); if (s) - scm_must_free (s); + free (s); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -577,7 +577,7 @@ SCM_DEFINE (scm_sys_inherit_magic_x, "%inherit-magic!", 2, 0, 0, long n = SCM_INUM (SCM_SLOT (class, scm_si_nfields)); #if 0 /* - * We could avoid calling scm_must_malloc in the allocation code + * We could avoid calling scm_gc_malloc in the allocation code * (in which case the following two lines are needed). Instead * we make 0-slot instances non-light, so that the light case * can be handled without special cases. @@ -1326,7 +1326,7 @@ SCM_DEFINE (scm_sys_allocate_instance, "%allocate-instance", 2, 0, 0, if (SCM_CLASS_FLAGS (class) & SCM_STRUCTF_LIGHT) { n = SCM_INUM (SCM_SLOT (class, scm_si_nfields)); - m = (SCM *) scm_must_malloc (n * sizeof (SCM), "instance"); + m = (SCM *) scm_gc_malloc (n * sizeof (SCM), "struct"); return wrap_init (class, m, n); } @@ -1339,9 +1339,8 @@ SCM_DEFINE (scm_sys_allocate_instance, "%allocate-instance", 2, 0, 0, /* Entities */ if (SCM_CLASS_FLAGS (class) & SCM_CLASSF_ENTITY) { - m = (SCM *) scm_alloc_struct (n, - scm_struct_entity_n_extra_words, - "entity"); + m = (SCM *) scm_alloc_struct (n, scm_struct_entity_n_extra_words, + "entity struct"); m[scm_struct_i_setter] = SCM_BOOL_F; m[scm_struct_i_procedure] = SCM_BOOL_F; /* Generic functions */ @@ -1377,9 +1376,7 @@ SCM_DEFINE (scm_sys_allocate_instance, "%allocate-instance", 2, 0, 0, /* Non-light instances */ { - m = (SCM *) scm_alloc_struct (n, - scm_struct_n_extra_words, - "heavy instance"); + m = (SCM *) scm_alloc_struct (n, scm_struct_n_extra_words, "heavy struct"); return wrap_init (class, m, n); } } @@ -1504,7 +1501,7 @@ go_to_hell (void *o) if (n_hell == hell_size) { long new_size = 2 * hell_size; - hell = scm_must_realloc (hell, hell_size, new_size, "hell"); + hell = scm_realloc (hell, new_size); hell_size = new_size; } hell[n_hell++] = SCM_STRUCT_DATA (obj); @@ -2683,7 +2680,7 @@ scm_init_goops_builtins (void) list_of_no_method = scm_permanent_object (scm_list_1 (sym_no_method)); - hell = scm_must_malloc (hell_size, "hell"); + hell = scm_malloc (hell_size); #ifdef USE_THREADS scm_mutex_init (&hell_mutex); #endif diff --git a/libguile/guardians.c b/libguile/guardians.c index d9eb5f003..88a6a4593 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -175,8 +175,8 @@ guardian_mark (SCM ptr) static size_t guardian_free (SCM ptr) { - scm_must_free (GUARDIAN_DATA (ptr)); - return sizeof (t_guardian); + scm_gc_free (GUARDIAN_DATA (ptr), sizeof (t_guardian), "guardian"); + return 0; } @@ -330,7 +330,7 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 1, 0, "paper still (mostly) accurately describes the interface).") #define FUNC_NAME s_scm_make_guardian { - t_guardian *g = SCM_MUST_MALLOC_TYPE (t_guardian); + t_guardian *g = scm_gc_malloc (sizeof (t_guardian), "guardian"); SCM z1 = scm_cons (SCM_BOOL_F, SCM_EOL); SCM z2 = scm_cons (SCM_BOOL_F, SCM_EOL); SCM z; diff --git a/libguile/hooks.c b/libguile/hooks.c index 3fd45960e..02bd96d56 100644 --- a/libguile/hooks.c +++ b/libguile/hooks.c @@ -77,8 +77,7 @@ scm_c_hook_add (scm_t_c_hook *hook, void *func_data, int appendp) { - scm_t_c_hook_entry *entry = scm_must_malloc (sizeof (scm_t_c_hook_entry), - "C level hook entry"); + scm_t_c_hook_entry *entry = scm_malloc (sizeof (scm_t_c_hook_entry)); scm_t_c_hook_entry **loc = &hook->first; if (appendp) while (*loc) @@ -101,7 +100,7 @@ scm_c_hook_remove (scm_t_c_hook *hook, { scm_t_c_hook_entry *entry = *loc; *loc = (*loc)->next; - scm_must_free (entry); + free (entry); return; } loc = &(*loc)->next; diff --git a/libguile/init.c b/libguile/init.c index b732165b4..71d737e45 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -180,7 +180,7 @@ start_stack (void *base) /* Create an object to hold the root continuation. */ { - scm_t_contregs *contregs = scm_must_malloc (sizeof (scm_t_contregs), + scm_t_contregs *contregs = scm_gc_malloc (sizeof (scm_t_contregs), "continuation"); contregs->num_stack_items = 0; contregs->seq = 0; diff --git a/libguile/keywords.c b/libguile/keywords.c index e2eb11437..05a50676f 100644 --- a/libguile/keywords.c +++ b/libguile/keywords.c @@ -95,14 +95,13 @@ SCM_DEFINE (scm_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol", SCM scm_c_make_keyword (char *s) { - char *buf = scm_must_malloc (strlen (s) + 2, "keyword"); + char *buf = scm_malloc (strlen (s) + 2); SCM symbol; buf[0] = '-'; strcpy (buf + 1, s); symbol = scm_str2symbol (buf); - scm_must_free (buf); - scm_done_free (strlen (s) + 2); + free (buf); return scm_make_keyword_from_dash_symbol (symbol); } diff --git a/libguile/load.c b/libguile/load.c index 0c8011534..83b85fef6 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -354,7 +354,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0, { /* scope */ SCM result = SCM_BOOL_F; size_t buf_size = max_path_len + 1 + filename_len + max_ext_len + 1; - char *buf = SCM_MUST_MALLOC (buf_size); + char *buf = scm_malloc (buf_size); /* This simplifies the loop below a bit. */ if (SCM_NULL_OR_NIL_P (extensions)) @@ -400,8 +400,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0, } end: - scm_must_free (buf); - scm_done_free (buf_size); + free (buf); SCM_ALLOW_INTS; return result; } diff --git a/libguile/numbers.c b/libguile/numbers.c index daf8d5da7..bdb6f4ca3 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -1388,7 +1388,7 @@ scm_i_mkbig (size_t nlen, int sign) if (((nlen << SCM_BIGSIZEFIELD) >> SCM_BIGSIZEFIELD) != nlen) scm_memory_error (s_bignum); - base = scm_must_malloc (nlen * sizeof (SCM_BIGDIG), s_bignum); + base = scm_gc_malloc (nlen * sizeof (SCM_BIGDIG), s_bignum); v = scm_alloc_cell (SCM_MAKE_BIGNUM_TAG (nlen, sign), (scm_t_bits) base); return v; @@ -1424,9 +1424,9 @@ scm_i_adjbig (SCM b, size_t nlen) { SCM_BIGDIG *digits = ((SCM_BIGDIG *) - scm_must_realloc ((char *) SCM_BDIGITS (b), - (long) (SCM_NUMDIGS (b) * sizeof (SCM_BIGDIG)), - (long) (nsiz * sizeof (SCM_BIGDIG)), s_bignum)); + scm_gc_realloc (SCM_BDIGITS (b), + SCM_NUMDIGS (b) * sizeof (SCM_BIGDIG), + nsiz * sizeof (SCM_BIGDIG), s_bignum)); SCM_SET_BIGNUM_BASE (b, digits); SCM_SETNUMDIGS (b, nsiz, SCM_BIGSIGN (b)); @@ -2840,7 +2840,8 @@ scm_make_complex (double x, double y) return scm_make_real (x); } else { SCM z; - SCM_NEWSMOB (z, scm_tc16_complex, scm_must_malloc (2L * sizeof (double), "complex")); + SCM_NEWSMOB (z, scm_tc16_complex, scm_gc_malloc (2*sizeof (double), + "complex")); SCM_COMPLEX_REAL (z) = x; SCM_COMPLEX_IMAG (z) = y; return z; diff --git a/libguile/ports.c b/libguile/ports.c index efeb4cf46..33c6cab89 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -124,6 +124,12 @@ end_input_default (SCM port SCM_UNUSED, int offset SCM_UNUSED) { } +static size_t +scm_port_free0 (SCM port) +{ + return 0; +} + scm_t_bits scm_make_port_type (char *name, int (*fill_input) (SCM port), @@ -142,7 +148,7 @@ scm_make_port_type (char *name, scm_ptobs[scm_numptob].name = name; scm_ptobs[scm_numptob].mark = 0; - scm_ptobs[scm_numptob].free = scm_free0; + scm_ptobs[scm_numptob].free = scm_port_free0; scm_ptobs[scm_numptob].print = scm_port_print; scm_ptobs[scm_numptob].equalp = 0; scm_ptobs[scm_numptob].close = 0; @@ -455,17 +461,15 @@ scm_add_to_port_table (SCM port) if (scm_port_table_size == scm_port_table_room) { - /* initial malloc is in gc.c. this doesn't use scm_must_malloc etc., + /* initial malloc is in gc.c. this doesn't use scm_gc_malloc etc., since it can never be freed during gc. */ - void *newt = realloc ((char *) scm_port_table, - (size_t) (sizeof (scm_t_port *) - * scm_port_table_room * 2)); - if (newt == NULL) - scm_memory_error ("scm_add_to_port_table"); + void *newt = scm_realloc ((char *) scm_port_table, + (size_t) (sizeof (scm_t_port *) + * scm_port_table_room * 2)); scm_port_table = (scm_t_port **) newt; scm_port_table_room *= 2; } - entry = (scm_t_port *) scm_must_malloc (sizeof (scm_t_port), FUNC_NAME); + entry = (scm_t_port *) scm_gc_malloc (sizeof (scm_t_port), "port"); entry->port = port; entry->entry = scm_port_table_size; @@ -498,8 +502,8 @@ scm_remove_from_port_table (SCM port) if (i >= scm_port_table_size) SCM_MISC_ERROR ("Port not in table: ~S", scm_list_1 (port)); if (p->putback_buf) - scm_must_free (p->putback_buf); - scm_must_free (p); + scm_gc_free (p->putback_buf, p->putback_buf_size, "putback buffer"); + scm_gc_free (p, sizeof (scm_t_port), "port"); /* Since we have just freed slot i we can shrink the table by moving the last entry to that slot... */ if (i < scm_port_table_size - 1) @@ -1098,8 +1102,8 @@ scm_ungetc (int c, SCM port) { size_t new_size = pt->read_buf_size * 2; unsigned char *tmp = (unsigned char *) - scm_must_realloc (pt->putback_buf, pt->read_buf_size, new_size, - FUNC_NAME); + scm_gc_realloc (pt->putback_buf, pt->read_buf_size, new_size, + "putback buffer"); pt->read_pos = pt->read_buf = pt->putback_buf = tmp; pt->read_end = pt->read_buf + pt->read_buf_size; @@ -1125,8 +1129,8 @@ scm_ungetc (int c, SCM port) if (pt->putback_buf == NULL) { pt->putback_buf - = (unsigned char *) scm_must_malloc (SCM_INITIAL_PUTBACK_BUF_SIZE, - FUNC_NAME); + = (unsigned char *) scm_gc_malloc (SCM_INITIAL_PUTBACK_BUF_SIZE, + "putback buffer"); pt->putback_buf_size = SCM_INITIAL_PUTBACK_BUF_SIZE; } diff --git a/libguile/posix.c b/libguile/posix.c index 1ef46d1db..6e3caa587 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -232,16 +232,14 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0, SCM_SYSERROR; size = ngroups * sizeof (GETGROUPS_T); - groups = scm_must_malloc (size, FUNC_NAME); + groups = scm_malloc (size); getgroups (ngroups, groups); ans = scm_c_make_vector (ngroups, SCM_UNDEFINED); while (--ngroups >= 0) SCM_VELTS (ans) [ngroups] = SCM_MAKINUM (groups [ngroups]); - scm_must_free (groups); - scm_done_free (size); - + free (groups); return ans; } #undef FUNC_NAME @@ -842,7 +840,7 @@ scm_convert_exec_args (SCM args, int argn, const char *subr) argc = scm_ilength (args); SCM_ASSERT (argc >= 0, args, argn, subr); - argv = (char **) scm_must_malloc ((argc + 1) * sizeof (char *), subr); + argv = (char **) scm_malloc ((argc + 1) * sizeof (char *)); for (i = 0; !SCM_NULLP (args); args = SCM_CDR (args), ++i) { SCM arg = SCM_CAR (args); @@ -853,7 +851,7 @@ scm_convert_exec_args (SCM args, int argn, const char *subr) SCM_ASSERT (SCM_STRINGP (arg), args, argn, subr); len = SCM_STRING_LENGTH (arg); src = SCM_STRING_CHARS (arg); - dst = (char *) scm_must_malloc (len + 1, subr); + dst = (char *) scm_malloc (len + 1); memcpy (dst, src, len); dst[len] = 0; argv[i] = dst; @@ -1635,23 +1633,23 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0, /* 256 is for Solaris, under Linux ENAMETOOLONG is returned if not large enough. */ int len = 256, res; - char *p = scm_must_malloc (len, "gethostname"); + char *p = scm_malloc (len); SCM name; res = gethostname (p, len); while (res == -1 && errno == ENAMETOOLONG) { - p = scm_must_realloc (p, len, len * 2, "gethostname"); + p = scm_realloc (p, len * 2); len *= 2; res = gethostname (p, len); } if (res == -1) { - scm_must_free (p); + free (p); SCM_SYSERROR; } name = scm_makfrom0str (p); - scm_must_free (p); + free (p); return name; } #undef FUNC_NAME diff --git a/libguile/procs.c b/libguile/procs.c index 04db7708a..afc81cd23 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -78,10 +78,8 @@ scm_c_make_subr (const char *name, long type, SCM (*fcn) ()) { long new_size = scm_subr_table_room * 3 / 2; void *new_table - = scm_must_realloc ((char *) scm_subr_table, - sizeof (scm_t_subr_entry) * scm_subr_table_room, - sizeof (scm_t_subr_entry) * new_size, - "scm_subr_table"); + = scm_realloc ((char *) scm_subr_table, + sizeof (scm_t_subr_entry) * new_size); scm_subr_table = new_table; scm_subr_table_room = new_size; } @@ -154,7 +152,8 @@ scm_mark_subr_table () SCM scm_makcclo (SCM proc, size_t len) { - scm_t_bits *base = scm_must_malloc (len * sizeof (scm_t_bits), "compiled-closure"); + scm_t_bits *base = scm_gc_malloc (len * sizeof (scm_t_bits), + "compiled closure"); unsigned long i; SCM s; @@ -376,8 +375,7 @@ scm_init_subr_table () { scm_subr_table = ((scm_t_subr_entry *) - scm_must_malloc (sizeof (scm_t_subr_entry) * scm_subr_table_room, - "scm_subr_table")); + scm_malloc (sizeof (scm_t_subr_entry) * scm_subr_table_room)); } void diff --git a/libguile/rdelim.c b/libguile/rdelim.c index 6f5b9ed11..caa4eac47 100644 --- a/libguile/rdelim.c +++ b/libguile/rdelim.c @@ -136,7 +136,7 @@ scm_do_read_line (SCM port, size_t *len_p) { size_t buf_len = (end + 1) - pt->read_pos; /* Allocate a buffer of the perfect size. */ - unsigned char *buf = scm_must_malloc (buf_len + 1, "%read-line"); + unsigned char *buf = scm_malloc (buf_len + 1); memcpy (buf, pt->read_pos, buf_len); pt->read_pos += buf_len; @@ -155,7 +155,7 @@ scm_do_read_line (SCM port, size_t *len_p) size_t buf_size = (len < 50) ? 60 : len * 2; /* Invariant: buf always has buf_size + 1 characters allocated; the `+ 1' is for the final '\0'. */ - unsigned char *buf = scm_must_malloc (buf_size + 1, "%read-line"); + unsigned char *buf = scm_malloc (buf_size + 1); size_t buf_len = 0; for (;;) @@ -163,8 +163,7 @@ scm_do_read_line (SCM port, size_t *len_p) if (buf_len + len > buf_size) { size_t new_size = (buf_len + len) * 2; - buf = scm_must_realloc (buf, buf_size + 1, new_size + 1, - "%read-line"); + buf = scm_realloc (buf, new_size + 1); buf_size = new_size; } @@ -197,12 +196,12 @@ scm_do_read_line (SCM port, size_t *len_p) } /* I wonder how expensive this realloc is. */ - buf = scm_must_realloc (buf, buf_size + 1, buf_len + 1, "%read-line"); + buf = scm_realloc (buf, buf_len + 1); buf[buf_len] = '\0'; *len_p = buf_len; return buf; } -} +} /* @@ -247,7 +246,6 @@ SCM_DEFINE (scm_read_line, "%read-line", 0, 1, 0, term = SCM_MAKE_CHAR ('\n'); s[slen-1] = '\0'; line = scm_take_str (s, slen-1); - scm_done_free (1); SCM_INCLINE (port); } else @@ -256,7 +254,7 @@ SCM_DEFINE (scm_read_line, "%read-line", 0, 1, 0, term = SCM_EOF_VAL; line = scm_take_str (s, slen); SCM_COL (port) += slen; - } + } } if (pt->rw_random) diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c index 3d1ef561d..3eef85454 100644 --- a/libguile/regex-posix.c +++ b/libguile/regex-posix.c @@ -95,8 +95,8 @@ static size_t regex_free (SCM obj) { regfree (SCM_RGX (obj)); - free (SCM_RGX (obj)); - return sizeof(regex_t); + scm_gc_free (SCM_RGX (obj), sizeof(regex_t), "regex"); + return 0; } @@ -202,7 +202,7 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1, flag = SCM_CDR (flag); } - rx = SCM_MUST_MALLOC_TYPE (regex_t); + rx = scm_gc_malloc (sizeof(regex_t), "regex"); status = regcomp (rx, SCM_STRING_CHARS (pat), /* Make sure they're not passing REG_NOSUB; regexp-exec assumes we're getting match data. */ @@ -260,7 +260,7 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0, nmatches = SCM_RGX(rx)->re_nsub + 1; SCM_DEFER_INTS; - matches = SCM_MUST_MALLOC_TYPE_NUM (regmatch_t,nmatches); + matches = scm_malloc (sizeof (regmatch_t) * nmatches); status = regexec (SCM_RGX (rx), SCM_STRING_CHARS (str) + offset, nmatches, matches, SCM_INUM (flags)); @@ -279,7 +279,7 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0, = scm_cons (scm_long2num (matches[i].rm_so + offset), scm_long2num (matches[i].rm_eo + offset)); } - scm_must_free ((char *) matches); + free (matches); SCM_ALLOW_INTS; if (status != 0 && status != REG_NOMATCH) diff --git a/libguile/root.c b/libguile/root.c index e55c393a1..389c2247b 100644 --- a/libguile/root.c +++ b/libguile/root.c @@ -105,8 +105,8 @@ scm_make_root (SCM parent) SCM root; scm_root_state *root_state; - root_state = (scm_root_state *) scm_must_malloc (sizeof (scm_root_state), - "scm_make_root"); + root_state = (scm_root_state *) scm_gc_malloc (sizeof (scm_root_state), + "root state"); if (SCM_ROOTP (parent)) { memcpy (root_state, SCM_ROOT_STATE (parent), sizeof (scm_root_state)); @@ -247,8 +247,8 @@ scm_internal_cwdr (scm_t_catch_body body, void *body_data, SCM_REDEFER_INTS; { - scm_t_contregs *contregs = scm_must_malloc (sizeof (scm_t_contregs), - "inferior root continuation"); + scm_t_contregs *contregs = scm_gc_malloc (sizeof (scm_t_contregs), + "continuation"); contregs->num_stack_items = 0; contregs->dynenv = SCM_EOL; diff --git a/libguile/smob.c b/libguile/smob.c index 788e6a8fd..94133a797 100644 --- a/libguile/smob.c +++ b/libguile/smob.c @@ -107,8 +107,11 @@ scm_free0 (SCM ptr SCM_UNUSED) size_t scm_smob_free (SCM obj) { - scm_must_free ((char *) SCM_CELL_WORD_1 (obj)); - return scm_smobs[SCM_SMOBNUM (obj)].size; + long n = SCM_SMOBNUM (obj); + if (scm_smobs[n].size > 0) + scm_gc_free ((void *) SCM_CELL_WORD_1 (obj), + scm_smobs[n].size, SCM_SMOBNAME (n)); + return 0; } /* {Print} @@ -457,7 +460,7 @@ scm_make_smob (scm_t_bits tc) long n = SCM_TC2SMOBNUM (tc); size_t size = scm_smobs[n].size; scm_t_bits data = (size > 0 - ? (scm_t_bits) scm_must_malloc (size, SCM_SMOBNAME (n)) + ? (scm_t_bits) scm_gc_malloc (size, SCM_SMOBNAME (n)) : 0); return scm_alloc_cell (tc, data); } diff --git a/libguile/stime.c b/libguile/stime.c index a8ba26b8b..09a22f64c 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -314,7 +314,7 @@ setzone (SCM zone, int pos, const char *subr) char *buf; SCM_ASSERT (SCM_STRINGP (zone), zone, pos, subr); - buf = scm_must_malloc (SCM_STRING_LENGTH (zone) + sizeof (tzvar) + 1, subr); + buf = scm_malloc (SCM_STRING_LENGTH (zone) + sizeof (tzvar) + 1); sprintf (buf, "%s=%s", tzvar, SCM_STRING_CHARS (zone)); oldenv = environ; tmpenv[0] = buf; @@ -329,7 +329,7 @@ restorezone (SCM zone, char **oldenv, const char *subr SCM_UNUSED) { if (!SCM_UNBNDP (zone)) { - scm_must_free (environ[0]); + free (environ[0]); environ = oldenv; #ifdef HAVE_TZSET /* for the possible benefit of user code linked with libguile. */ @@ -378,7 +378,7 @@ SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0, #else ptr = ""; #endif - zname = SCM_MUST_MALLOC (strlen (ptr) + 1); + zname = scm_malloc (strlen (ptr) + 1); strcpy (zname, ptr); } /* the struct is copied in case localtime and gmtime share a buffer. */ @@ -407,7 +407,8 @@ SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0, result = filltime (<, zoff, zname); SCM_ALLOW_INTS; - scm_must_free (zname); + if (zname) + free (zname); return result; } #undef FUNC_NAME @@ -511,7 +512,7 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0, #else ptr = ""; #endif - zname = SCM_MUST_MALLOC (strlen (ptr) + 1); + zname = scm_malloc (strlen (ptr) + 1); strcpy (zname, ptr); } @@ -540,7 +541,8 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0, result = scm_cons (scm_long2num ((long) itime), filltime (<, zoff, zname)); SCM_ALLOW_INTS; - scm_must_free (zname); + if (zname) + free (zname); return result; } #undef FUNC_NAME @@ -590,12 +592,12 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0, a zero-byte output string! Workaround is to prepend a junk character to the format string, so that valid returns are always nonzero. */ - myfmt = SCM_MUST_MALLOC (len+2); + myfmt = scm_malloc (len+2); *myfmt = 'x'; strncpy(myfmt+1, fmt, len); myfmt[len+1] = 0; - tbuf = SCM_MUST_MALLOC (size); + tbuf = scm_malloc (size); { #if !defined (HAVE_TM_ZONE) /* it seems the only way to tell non-GNU versions of strftime what @@ -632,9 +634,9 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0, case. */ while ((len = strftime (tbuf, size, myfmt, &t)) == 0 || len == size) { - scm_must_free (tbuf); + free (tbuf); size *= 2; - tbuf = SCM_MUST_MALLOC (size); + tbuf = scm_malloc (size); } #if !defined (HAVE_TM_ZONE) @@ -647,8 +649,8 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0, } result = scm_mem2string (tbuf + 1, len - 1); - scm_must_free (tbuf); - scm_must_free(myfmt); + free (tbuf); + free (myfmt); return result; } #undef FUNC_NAME diff --git a/libguile/strings.c b/libguile/strings.c index 6744a58c6..c7517626d 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -133,7 +133,7 @@ scm_take_str (char *s, size_t len) SCM_ASSERT_RANGE (2, scm_ulong2num (len), len <= SCM_STRING_MAX_LENGTH); answer = scm_alloc_cell (SCM_MAKE_STRING_TAG (len), (scm_t_bits) s); - scm_done_malloc (len + 1); + scm_gc_register_collectable_memory (s, len+1, "string"); return answer; } @@ -191,7 +191,7 @@ scm_allocate_string (size_t len) SCM_ASSERT_RANGE (1, scm_long2num (len), len <= SCM_STRING_MAX_LENGTH); - mem = (char *) scm_must_malloc (len + 1, FUNC_NAME); + mem = (char *) scm_gc_malloc (len + 1, "string"); mem[len] = 0; s = scm_alloc_cell (SCM_MAKE_STRING_TAG (len), (scm_t_bits) mem); diff --git a/libguile/struct.c b/libguile/struct.c index 9d75e43f0..a384c8647 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -306,10 +306,10 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0, scm_t_bits * -scm_alloc_struct (int n_words, int n_extra, char *who) +scm_alloc_struct (int n_words, int n_extra, const char *what) { int size = sizeof (scm_t_bits) * (n_words + n_extra) + 7; - void * block = scm_must_malloc (size, who); + void * block = scm_gc_malloc (size, what); /* Adjust the pointer to hide the extra words. */ scm_t_bits * p = (scm_t_bits *) block + n_extra; @@ -326,36 +326,33 @@ scm_alloc_struct (int n_words, int n_extra, char *who) return p; } -size_t +void scm_struct_free_0 (scm_t_bits * vtable SCM_UNUSED, scm_t_bits * data SCM_UNUSED) { - return 0; } -size_t +void scm_struct_free_light (scm_t_bits * vtable, scm_t_bits * data) { - scm_must_free (data); - return vtable [scm_struct_i_size] & ~SCM_STRUCTF_MASK; + size_t n = vtable [scm_struct_i_size] & ~SCM_STRUCTF_MASK; + scm_gc_free (data, n, "struct"); } -size_t +void scm_struct_free_standard (scm_t_bits * vtable SCM_UNUSED, scm_t_bits * data) { size_t n = (data[scm_struct_i_n_words] + scm_struct_n_extra_words) * sizeof (scm_t_bits) + 7; - scm_must_free ((void *) data[scm_struct_i_ptr]); - return n; + scm_gc_free ((void *) data[scm_struct_i_ptr], n, "heavy struct"); } -size_t +void scm_struct_free_entity (scm_t_bits * vtable SCM_UNUSED, scm_t_bits * data) { size_t n = (data[scm_struct_i_n_words] + scm_struct_entity_n_extra_words) * sizeof (scm_t_bits) + 7; - scm_must_free ((void *) data[scm_struct_i_ptr]); - return n; + scm_gc_free ((void *) data[scm_struct_i_ptr], n, "entity struct"); } static void * @@ -455,14 +452,14 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1, { data = scm_alloc_struct (basic_size + tail_elts, scm_struct_entity_n_extra_words, - "make-struct"); + "entity struct"); data[scm_struct_i_procedure] = SCM_UNPACK (SCM_BOOL_F); data[scm_struct_i_setter] = SCM_UNPACK (SCM_BOOL_F); } else data = scm_alloc_struct (basic_size + tail_elts, scm_struct_n_extra_words, - "make-struct"); + "struct"); handle = scm_alloc_double_cell ((((scm_t_bits) SCM_STRUCT_DATA (vtable)) + scm_tc3_struct), (scm_t_bits) data, 0, 0); @@ -541,7 +538,7 @@ SCM_DEFINE (scm_make_vtable_vtable, "make-vtable-vtable", 2, 0, 1, SCM_DEFER_INTS; data = scm_alloc_struct (basic_size + tail_elts, scm_struct_n_extra_words, - "make-vtable-vtable"); + "struct"); handle = scm_alloc_double_cell ((scm_t_bits) data + scm_tc3_struct, (scm_t_bits) data, 0, 0); data [scm_vtable_index_layout] = SCM_UNPACK (layout); diff --git a/libguile/struct.h b/libguile/struct.h index 20687e38a..7c784b14d 100644 --- a/libguile/struct.h +++ b/libguile/struct.h @@ -71,7 +71,7 @@ #define scm_vtable_index_printer 2 /* A printer for this struct type. */ #define scm_vtable_offset_user 3 /* Where do user fields start? */ -typedef size_t (*scm_t_struct_free) (scm_t_bits * vtable, scm_t_bits * data); +typedef void (*scm_t_struct_free) (scm_t_bits * vtable, scm_t_bits * data); #define SCM_STRUCTF_MASK (0xFFF << 20) #define SCM_STRUCTF_ENTITY (1L << 30) /* Indicates presence of proc slots */ @@ -107,11 +107,12 @@ SCM_API SCM scm_structs_to_free; -SCM_API scm_t_bits * scm_alloc_struct (int n_words, int n_extra, char * who); -SCM_API size_t scm_struct_free_0 (scm_t_bits * vtable, scm_t_bits * data); -SCM_API size_t scm_struct_free_light (scm_t_bits * vtable, scm_t_bits * data); -SCM_API size_t scm_struct_free_standard (scm_t_bits * vtable, scm_t_bits * data); -SCM_API size_t scm_struct_free_entity (scm_t_bits * vtable, scm_t_bits * data); +SCM_API scm_t_bits * scm_alloc_struct (int n_words, int n_extra, + const char *what); +SCM_API void scm_struct_free_0 (scm_t_bits * vtable, scm_t_bits * data); +SCM_API void scm_struct_free_light (scm_t_bits * vtable, scm_t_bits * data); +SCM_API void scm_struct_free_standard (scm_t_bits * vtable, scm_t_bits * data); +SCM_API void scm_struct_free_entity (scm_t_bits * vtable, scm_t_bits * data); SCM_API SCM scm_make_struct_layout (SCM fields); SCM_API SCM scm_struct_p (SCM x); SCM_API SCM scm_struct_vtable_p (SCM x); diff --git a/libguile/symbols.c b/libguile/symbols.c index 106b18fce..c6979f9a4 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -126,7 +126,8 @@ scm_mem2symbol (const char *name, size_t len) SCM slot; symbol = scm_alloc_double_cell (SCM_MAKE_SYMBOL_TAG (len), - (scm_t_bits) scm_must_strndup (name, len), + (scm_t_bits) scm_gc_strndup (name, len, + "symbol"), raw_hash, SCM_UNPACK (scm_cons (SCM_BOOL_F, SCM_EOL))); @@ -146,7 +147,8 @@ scm_mem2uninterned_symbol (const char *name, size_t len) + SCM_T_BITS_MAX/2 + 1); return scm_alloc_double_cell (SCM_MAKE_SYMBOL_TAG (len), - (scm_t_bits) scm_must_strndup (name, len), + (scm_t_bits) scm_gc_strndup (name, len, + "symbol"), raw_hash, SCM_UNPACK (scm_cons (SCM_BOOL_F, SCM_EOL))); @@ -291,14 +293,14 @@ SCM_DEFINE (scm_gensym, "gensym", 0, 1, 0, SCM_VALIDATE_STRING (1, prefix); len = SCM_STRING_LENGTH (prefix); if (len > MAX_PREFIX_LENGTH) - name = SCM_MUST_MALLOC (len + SCM_INTBUFLEN); + name = scm_malloc (len + SCM_INTBUFLEN); memcpy (name, SCM_STRING_CHARS (prefix), len); } { int n_digits = scm_iint2str (gensym_counter++, 10, &name[len]); SCM res = scm_mem2symbol (name, len + n_digits); if (name != buf) - scm_must_free (name); + free (name); return res; } } diff --git a/libguile/unif.c b/libguile/unif.c index 94107db11..4e9c572b1 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -171,7 +171,7 @@ scm_make_uve (long k, SCM prot) scm_long2num (k), k <= SCM_BITVECTOR_MAX_LENGTH); i = sizeof (long) * ((k + SCM_LONG_BIT - 1) / SCM_LONG_BIT); v = scm_alloc_cell (SCM_MAKE_BITVECTOR_TAG (k), - (scm_t_bits) scm_must_malloc (i, "vector")); + (scm_t_bits) scm_gc_malloc (i, "vector")); } else v = scm_alloc_cell (SCM_MAKE_BITVECTOR_TAG (0), 0); @@ -240,7 +240,7 @@ scm_make_uve (long k, SCM prot) SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_UVECTOR_MAX_LENGTH); return scm_alloc_cell (SCM_MAKE_UVECTOR_TAG (k, type), - (scm_t_bits) scm_must_malloc (i ? i : 1, "vector")); + (scm_t_bits) scm_gc_malloc (i, "vector")); } #undef FUNC_NAME @@ -520,9 +520,9 @@ scm_make_ra (int ndim) SCM ra; SCM_DEFER_INTS; SCM_NEWSMOB(ra, ((scm_t_bits) ndim << 17) + scm_tc16_array, - scm_must_malloc ((sizeof (scm_t_array) + - ndim * sizeof (scm_t_array_dim)), - "array")); + scm_gc_malloc ((sizeof (scm_t_array) + + ndim * sizeof (scm_t_array_dim)), + "array")); SCM_ARRAY_V (ra) = scm_nullvect; SCM_ALLOW_INTS; return ra; @@ -2589,9 +2589,11 @@ array_mark (SCM ptr) static size_t array_free (SCM ptr) { - scm_must_free (SCM_ARRAY_MEM (ptr)); - return sizeof (scm_t_array) + - SCM_ARRAY_NDIM (ptr) * sizeof (scm_t_array_dim); + scm_gc_free (SCM_ARRAY_MEM (ptr), + (sizeof (scm_t_array) + + SCM_ARRAY_NDIM (ptr) * sizeof (scm_t_array_dim)), + "array"); + return 0; } void diff --git a/libguile/vectors.c b/libguile/vectors.c index 5868ba4f0..c1dfe840f 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -208,7 +208,7 @@ scm_c_make_vector (unsigned long int k, SCM fill) SCM_ASSERT_RANGE (1, scm_ulong2num (k), k <= SCM_VECTOR_MAX_LENGTH); - base = scm_must_malloc (k * sizeof (scm_t_bits), FUNC_NAME); + base = scm_gc_malloc (k * sizeof (scm_t_bits), "vector"); for (j = 0; j != k; ++j) base[j] = SCM_UNPACK (fill); } diff --git a/libguile/weaks.c b/libguile/weaks.c index d5fc5a060..08d570069 100644 --- a/libguile/weaks.c +++ b/libguile/weaks.c @@ -81,7 +81,7 @@ allocate_weak_vector (scm_t_bits type, SCM size, SCM fill, const char* caller) fill = SCM_UNSPECIFIED; SCM_ASSERT_RANGE (1, size, c_size <= SCM_VECTOR_MAX_LENGTH); - base = scm_must_malloc (c_size * sizeof (scm_t_bits), FUNC_NAME); + base = scm_gc_malloc (c_size * sizeof (scm_t_bits), "weak vector"); for (j = 0; j != c_size; ++j) base[j] = SCM_UNPACK (fill); v = scm_alloc_double_cell (SCM_MAKE_VECTOR_TAG (c_size, -- 2.20.1