diff --git a/configure.ac b/configure.ac index d33aad352..40ebc6742 100644 --- a/configure.ac +++ b/configure.ac @@ -218,13 +218,6 @@ AC_ARG_ENABLE(error-on-warning, *) AC_MSG_ERROR(bad value ${enableval} for --enable-error-on-warning) ;; esac]) -AC_ARG_ENABLE(debug-malloc, - [ --enable-debug-malloc include malloc debugging code], - if test "$enable_debug_malloc" = y || test "$enable_debug_malloc" = yes; then - AC_DEFINE([GUILE_DEBUG_MALLOC], 1, - [Define this if you want to debug scm_must_malloc/realloc/free calls.]) - fi) - # Check if JIT is available. GUILE_ENABLE_JIT diff --git a/doc/ref/api-memory.texi b/doc/ref/api-memory.texi index 9cf0fdc9a..864fa5cae 100644 --- a/doc/ref/api-memory.texi +++ b/doc/ref/api-memory.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000-2004, 2009, 2010, 2012-2016 +@c Copyright (C) 1996, 1997, 2000-2004, 2009, 2010, 2012-2016, 2025 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -245,17 +245,6 @@ freed (using @code{free} from the C library) when the current dynwind is left. @end deftypefn -@deffn {Scheme Procedure} malloc-stats -Return an alist ((@var{what} . @var{n}) ...) describing number -of malloced objects. -@var{what} is the second argument to @code{scm_gc_malloc}, -@var{n} is the number of objects of that type currently -allocated. - -This function is only available if the @code{GUILE_DEBUG_MALLOC} -preprocessor macro was defined when Guile was compiled. -@end deffn - @node Weak References @subsection Weak References diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 53ba9dcff..308052026 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -478,7 +478,6 @@ EXTRA_libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \ syscalls.h \ dynl.c regex-posix.c \ posix.c net_db.c socket.c \ - debug-malloc.c \ posix-w32.c \ locale-categories.h \ mini-gmp.h @@ -617,7 +616,6 @@ modinclude_HEADERS = \ chooks.h \ control.h \ continuations.h \ - debug-malloc.h \ debug.h \ deprecated.h \ deprecation.h \ diff --git a/libguile/debug-malloc.c b/libguile/debug-malloc.c deleted file mode 100644 index ac8bf710a..000000000 --- a/libguile/debug-malloc.c +++ /dev/null @@ -1,250 +0,0 @@ -/* Copyright 2000-2002,2004,2006,2008-2009,2018-2019 - Free Software Foundation, Inc. - - This file is part of Guile. - - Guile is free software: you can redistribute it and/or modify it - under the terms of the GNU Lesser General Public License as published - by the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - Guile is distributed in the hope that it will be useful, but WITHOUT - ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or - FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public - License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with Guile. If not, see - . */ - -#ifdef HAVE_CONFIG_H -# include -#endif - -#include -#include - -#include "alist.h" -#include "gsubr.h" -#include "numbers.h" -#include "strings.h" - -#include "debug-malloc.h" - - -/* - * The following code is a hack which I wrote quickly in order to - * solve a memory leak problem. Since I wanted to have the - * application running at close to normal speed, I prioritized speed - * over maintainability. /mdj - */ - -typedef struct hash_entry { - const void *key; - const void *data; -} hash_entry_t; - -#define N_SEEK 8 - -static int malloc_type_size = 31; -static hash_entry_t *malloc_type = 0; -static int malloc_object_size = 8191; -static hash_entry_t *malloc_object = 0; - -#define TABLE(table) malloc_ ## table -#define SIZE(table) malloc_ ## table ## _size -#define HASH(table, key) \ - &TABLE (table)[((unsigned long) key >> 4UL) * 2654435761UL % SIZE (table)] - -#define CREATE_HASH_ENTRY_AT(entry, table, h, k, done) \ -{ \ - int i; \ - do \ - { \ - for (i = 0; i < N_SEEK; ++i) \ - if (h[i].key == 0) \ - goto done; \ - grow (&TABLE (table), &SIZE (table)); \ - h = HASH (table, k); \ - } \ - while (1); \ - done: \ - (entry) = &h[i]; \ -} - -#define CREATE_HASH_ENTRY(table, k, d, done) \ - do \ - { \ - hash_entry_t *h = HASH (table, k); \ - hash_entry_t *entry; \ - CREATE_HASH_ENTRY_AT (entry, table, h, k, done); \ - entry->key = (k); \ - entry->data = (d); \ - } \ - while (0) - -#define GET_CREATE_HASH_ENTRY(entry, table, k, done) \ - do \ - { \ - hash_entry_t *h = HASH (table, k); \ - int i; \ - for (i = 0; i < N_SEEK; ++i) \ - if (h[i].key == (void *) (k)) \ - goto done; \ - CREATE_HASH_ENTRY_AT (entry, table, h, k, gche ## done); \ - entry->key = (k); \ - entry->data = 0; \ - break; \ - done: \ - (entry) = &h[i]; \ - } \ - while (0) - -static void -grow (hash_entry_t **table, int *size) -{ - hash_entry_t *oldtable = *table; - int oldsize = *size + N_SEEK; - hash_entry_t *TABLE (new) = 0; - int SIZE (new); - int i, j; - SIZE (new) = 2 * (oldsize - N_SEEK + 1) - 1; - again: - TABLE (new) = realloc (TABLE (new), - sizeof (hash_entry_t) * (SIZE (new) + N_SEEK)); - memset (TABLE (new), 0, sizeof (hash_entry_t) * (SIZE (new) + N_SEEK)); - for (i = 0; i < oldsize; ++i) - if (oldtable[i].key) - { - hash_entry_t *h = HASH (new, oldtable[i].key); - for (j = 0; j < N_SEEK; ++j) - if (h[j].key == 0) - { - h[j] = oldtable[i]; - goto next; - } - SIZE (new) *= 2; - goto again; - next: - ; - } - if (table == &malloc_type) - { - /* relocate malloc_object entries */ - for (i = 0; i < oldsize; ++i) - if (oldtable[i].key) - { - hash_entry_t *h = HASH (new, oldtable[i].key); - while (h->key != oldtable[i].key) - ++h; - oldtable[i].data = h; - } - for (i = 0; i < malloc_object_size + N_SEEK; ++i) - if (malloc_object[i].key) - malloc_object[i].data - = ((hash_entry_t *) malloc_object[i].data)->data; - } - free (*table); - *table = TABLE (new); - *size = SIZE (new); -} - -void -scm_malloc_register (void *obj, const char *what) -{ - hash_entry_t *type; - GET_CREATE_HASH_ENTRY (type, type, what, l1); - type->data = (void *) ((int) type->data + 1); - CREATE_HASH_ENTRY (object, obj, type, l2); -} - -void -scm_malloc_unregister (void *obj) -{ - hash_entry_t *object, *type; - GET_CREATE_HASH_ENTRY (object, object, obj, l1); - type = (hash_entry_t *) object->data; - if (type == 0) - { - fprintf (stderr, - "scm_gc_free called on object not allocated with scm_gc_malloc\n"); - abort (); - } - type->data = (void *) ((int) type->data - 1); - object->key = 0; -} - -void -scm_malloc_reregister (void *old, void *new, const char *newwhat) -{ - hash_entry_t *object, *type; - - if (old == NULL) - scm_malloc_register (new, newwhat); - else - { - GET_CREATE_HASH_ENTRY (object, object, old, l1); - type = (hash_entry_t *) object->data; - if (type == 0) - { - fprintf (stderr, - "scm_gc_realloc called on object not allocated " - "with scm_gc_malloc\n"); - abort (); - } - 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); - } - } -} - -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_gc_malloc},\n" - "@var{n} is the number of objects of that type currently\n" - "allocated.") -#define FUNC_NAME s_scm_malloc_stats -{ - SCM res = SCM_EOL; - int i; - for (i = 0; i < malloc_type_size + N_SEEK; ++i) - if (malloc_type[i].key) - res = scm_acons (scm_from_utf8_string ((char *) malloc_type[i].key), - scm_from_int ((int) malloc_type[i].data), - res); - return res; -} -#undef FUNC_NAME - -void -scm_debug_malloc_prehistory () -{ - malloc_type = malloc (sizeof (hash_entry_t) - * (malloc_type_size + N_SEEK)); - memset (malloc_type, 0, sizeof (hash_entry_t) * (malloc_type_size + N_SEEK)); - malloc_object = malloc (sizeof (hash_entry_t) - * (malloc_object_size + N_SEEK)); - memset (malloc_object, 0, sizeof (hash_entry_t) * (malloc_object_size + N_SEEK)); -} - -void -scm_init_debug_malloc () -{ -#include "debug-malloc.x" -} - diff --git a/libguile/debug-malloc.h b/libguile/debug-malloc.h deleted file mode 100644 index 4ced0d144..000000000 --- a/libguile/debug-malloc.h +++ /dev/null @@ -1,38 +0,0 @@ -#ifndef SCM_DEBUG_MALLOC_H -#define SCM_DEBUG_MALLOC_H - -/* Copyright 2000-2001,2006,2008,2018 - Free Software Foundation, Inc. - - This file is part of Guile. - - Guile is free software: you can redistribute it and/or modify it - under the terms of the GNU Lesser General Public License as published - by the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - Guile is distributed in the hope that it will be useful, but WITHOUT - ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or - FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public - License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with Guile. If not, see - . */ - - - -#include "libguile/scm.h" - - - -SCM_API void scm_malloc_register (void *obj, const char *what); -SCM_API void scm_malloc_unregister (void *obj); -SCM_API void scm_malloc_reregister (void *obj, void *new, const char *what); - -SCM_API SCM scm_malloc_stats (void); - -SCM_INTERNAL void scm_debug_malloc_prehistory (void); -SCM_INTERNAL void scm_init_debug_malloc (void); - -#endif /* SCM_DEBUG_MALLOC_H */ diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c index 219aac66b..3f2f23d76 100644 --- a/libguile/gc-malloc.c +++ b/libguile/gc-malloc.c @@ -141,22 +141,12 @@ void scm_gc_register_collectable_memory (void *mem, size_t size, const char *what) { scm_gc_register_allocation (size); - -#ifdef GUILE_DEBUG_MALLOC - if (mem) - scm_malloc_register (mem, what); -#endif } void scm_gc_unregister_collectable_memory (void *mem, size_t size, const char *what) { - /* Nothing to do. */ -#ifdef GUILE_DEBUG_MALLOC - if (mem) - scm_malloc_unregister (mem); -#endif } /* Allocate SIZE bytes of memory whose contents should not be scanned diff --git a/libguile/gc.c b/libguile/gc.c index 9825cb27a..927394393 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -54,10 +54,6 @@ #include "symbols.h" #include "vectors.h" -#ifdef GUILE_DEBUG_MALLOC -#include "debug-malloc.h" -#endif - #include "gc.h" #include "gc-internal.h" #include "gc-basic-stats.h" diff --git a/libguile/init.c b/libguile/init.c index 06280efec..179f8dea5 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -54,9 +54,6 @@ #include "control.h" #include "custom-ports.h" #include "debug.h" -#ifdef GUILE_DEBUG_MALLOC -#include "debug-malloc.h" -#endif #include "deprecated.h" #include "deprecation.h" #include "dynl.h" @@ -361,9 +358,6 @@ scm_i_init_guile (struct gc_stack_addr base) struct gc_mutator *mut = scm_storage_prehistory (base); scm_threads_prehistory (mut, base); /* requires storage_prehistory */ scm_weak_table_prehistory (); /* requires storage_prehistory */ -#ifdef GUILE_DEBUG_MALLOC - scm_debug_malloc_prehistory (); -#endif scm_symbols_prehistory (); /* requires weak_table_prehistory */ scm_modules_prehistory (); scm_init_array_handle (); @@ -393,9 +387,6 @@ scm_i_init_guile (struct gc_stack_addr base) scm_init_async (); /* requires smob_prehistory */ scm_init_boolean (); scm_init_chars (); -#ifdef GUILE_DEBUG_MALLOC - scm_init_debug_malloc (); -#endif scm_init_dynwind (); /* requires smob_prehistory */ scm_init_eq (); scm_init_error ();