mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 08:40:19 +02:00
Code Activity

* gc.h, gc.c (scm_gc_sweep): Issue deprecation warning when

Browse source 
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
Download patch file Download diff file Expand all files Collapse all files

5
libguile/backtrace.c
View file

@ -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)
{

15
libguile/continuations.c
View file

@ -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)
continuation = scm_gc_malloc (sizeof (scm_t_contregs)
+ (stack_size - 1) * sizeof (SCM_STACKITEM),
FUNC_NAME);
"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);

6
libguile/convert.i.c
View file

@ -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);
}

16
libguile/coop-threads.c
View file

@ -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;
}

15
libguile/debug-malloc.c
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,12 +194,18 @@ 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_must_realloc called on object not allocated with scm_must_malloc\n");
"scm_gc_realloc called on object not allocated "
"with scm_gc_malloc\n");
abort ();
}
if (strcmp ((char *) type->key, newwhat) != 0)
@ -207,7 +213,7 @@ scm_malloc_reregister (void *old, void *new, const char *newwhat)
if (strcmp (newwhat, "vector-set-length!") != 0)
{
fprintf (stderr,
"scm_must_realloc called with arg %s, was %s\n",
"scm_gc_realloc called with arg %s, was %s\n",
newwhat,
(char *) type->key);
abort ();
@ -219,12 +225,13 @@ scm_malloc_reregister (void *old, void *new, const char *newwhat)
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_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

11
libguile/dynl.c
View file

@ -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);

39
libguile/environments.c
View file

@ -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;

2
libguile/environments.h
View file

@ -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);
};

7
libguile/extensions.c
View file

@ -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;

16
libguile/filesys.c
View file

@ -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

26
libguile/fports.c
View file

@ -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;
}

211
libguile/gc.c
View file

@ -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;

16
libguile/gc.h
View file

@ -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,

12
libguile/gh_data.c
View file

@ -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);
}

21
libguile/goops.c
View file

@ -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

6
libguile/guardians.c
View file

@ -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;

5
libguile/hooks.c
View file

@ -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;

2
libguile/init.c
View file

@ -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;

5
libguile/keywords.c
View file

@ -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);
}

5
libguile/load.c
View file

@ -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;
}

11
libguile/numbers.c
View file

@ -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;

28
libguile/ports.c
View file

@ -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,
void *newt = scm_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");
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;
}

18
libguile/posix.c
View file

@ -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

12
libguile/procs.c
View file

@ -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

10
libguile/rdelim.c
View file

@ -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,7 +196,7 @@ 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

10
libguile/regex-posix.c
View file

@ -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)

8
libguile/root.c
View file

@ -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;

9
libguile/smob.c
View file

@ -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);
}

26
libguile/stime.c
View file

@ -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 (&lt, 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 (&lt, 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

4
libguile/strings.c
View file

@ -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);

29
libguile/struct.c
View file

@ -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);

13
libguile/struct.h
View file

@ -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);

10
libguile/symbols.c
View file

@ -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;
}
}

14
libguile/unif.c
View file

@ -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,7 +520,7 @@ 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) +
scm_gc_malloc ((sizeof (scm_t_array) +
ndim * sizeof (scm_t_array_dim)),
"array"));
SCM_ARRAY_V (ra) = scm_nullvect;
@ -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

2
libguile/vectors.c
View file

@ -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);
}

2
libguile/weaks.c
View file

@ -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,