mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-03 13:20:26 +02:00
Code Activity

Remove GUILE_DEBUG_MALLOC configuration

Browse source 
* configure.ac: Remove --enable-debug-malloc.
* doc/ref/api-memory.texi (Memory Blocks): Remove malloc-stats mention.
* libguile/debug-malloc.c:
* libguile/debug-malloc.h: Remove.
* libguile/Makefile.am (EXTRA_libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES):
(modinclude_HEADERS): Remove debug-malloc mentions.
* libguile/gc-malloc.c (scm_gc_register_collectable_memory):
(scm_calloc):
* libguile/init.c (scm_i_init_guile): Remove debug-malloc things.
This commit is contained in:
Andy Wingo 2025-04-30 11:21:52 +02:00
parent f3649d7d1b
commit a13c30eeba
8 changed files with 1 additions and 332 deletions
Download patch file Download diff file Expand all files Collapse all files

7
configure.ac
View file

@ -218,13 +218,6 @@ AC_ARG_ENABLE(error-on-warning,
*) AC_MSG_ERROR(bad value ${enableval} for --enable-error-on-warning) ;; *) AC_MSG_ERROR(bad value ${enableval} for --enable-error-on-warning) ;;
esac]) 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. # Check if JIT is available.
GUILE_ENABLE_JIT GUILE_ENABLE_JIT

13
doc/ref/api-memory.texi
View file

@ -1,6 +1,6 @@
@c -*-texinfo-*- @c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual. @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 Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions. @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. left.
@end deftypefn @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 @node Weak References
@subsection Weak References @subsection Weak References

2
libguile/Makefile.am
View file

@ -478,7 +478,6 @@ EXTRA_libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \
syscalls.h \ syscalls.h \
dynl.c regex-posix.c \ dynl.c regex-posix.c \
posix.c net_db.c socket.c \ posix.c net_db.c socket.c \
debug-malloc.c \
posix-w32.c \ posix-w32.c \
locale-categories.h \ locale-categories.h \
mini-gmp.h mini-gmp.h
@ -617,7 +616,6 @@ modinclude_HEADERS = \
chooks.h \ chooks.h \
control.h \ control.h \
continuations.h \ continuations.h \
debug-malloc.h \
debug.h \ debug.h \
deprecated.h \ deprecated.h \
deprecation.h \ deprecation.h \

250
libguile/debug-malloc.c
View file

@ -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
<https://www.gnu.org/licenses/>. */
#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include <string.h>
#include <stdio.h>
#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"
}

38
libguile/debug-malloc.h
View file

@ -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
<https://www.gnu.org/licenses/>. */
#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 */

10
libguile/gc-malloc.c
View file

@ -141,22 +141,12 @@ void
scm_gc_register_collectable_memory (void *mem, size_t size, const char *what) scm_gc_register_collectable_memory (void *mem, size_t size, const char *what)
{ {
scm_gc_register_allocation (size); scm_gc_register_allocation (size);
#ifdef GUILE_DEBUG_MALLOC
if (mem)
scm_malloc_register (mem, what);
#endif
} }
void void
scm_gc_unregister_collectable_memory (void *mem, size_t size, const char *what) 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 /* Allocate SIZE bytes of memory whose contents should not be scanned

4
libguile/gc.c
View file

@ -54,10 +54,6 @@
#include "symbols.h" #include "symbols.h"
#include "vectors.h" #include "vectors.h"
#ifdef GUILE_DEBUG_MALLOC
#include "debug-malloc.h"
#endif
#include "gc.h" #include "gc.h"
#include "gc-internal.h" #include "gc-internal.h"
#include "gc-basic-stats.h" #include "gc-basic-stats.h"

9
libguile/init.c
View file

@ -54,9 +54,6 @@
#include "control.h" #include "control.h"
#include "custom-ports.h" #include "custom-ports.h"
#include "debug.h" #include "debug.h"
#ifdef GUILE_DEBUG_MALLOC
#include "debug-malloc.h"
#endif
#include "deprecated.h" #include "deprecated.h"
#include "deprecation.h" #include "deprecation.h"
#include "dynl.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); struct gc_mutator *mut = scm_storage_prehistory (base);
scm_threads_prehistory (mut, base); /* requires storage_prehistory */ scm_threads_prehistory (mut, base); /* requires storage_prehistory */
scm_weak_table_prehistory (); /* 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_symbols_prehistory (); /* requires weak_table_prehistory */
scm_modules_prehistory (); scm_modules_prehistory ();
scm_init_array_handle (); 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_async (); /* requires smob_prehistory */
scm_init_boolean (); scm_init_boolean ();
scm_init_chars (); scm_init_chars ();
#ifdef GUILE_DEBUG_MALLOC
scm_init_debug_malloc ();
#endif
scm_init_dynwind (); /* requires smob_prehistory */ scm_init_dynwind (); /* requires smob_prehistory */
scm_init_eq (); scm_init_eq ();
scm_init_error (); scm_init_error ();