1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 09:10:22 +02:00

* 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.
This commit is contained in:
Marius Vollmer 2002-02-11 18:06:50 +00:00
parent d013f095c1
commit 4c9419ac31
36 changed files with 439 additions and 254 deletions

View file

@ -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)
if (old == NULL)
scm_malloc_register (new, newwhat);
else
{
fprintf (stderr,
"scm_must_realloc called on object not allocated with scm_must_malloc\n");
abort ();
}
if (strcmp ((char *) type->key, newwhat) != 0)
{
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