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

* mallocs.c (scm_malloc_obj): use scm_gc_malloc in stead of

malloc.

* gc-segment.c (scm_i_get_new_heap_segment): remove cluster cruft:
only use SCM_MIN_HEAP_SEG_SIZE.

* ports.c (scm_add_to_port_table): add backwards compatibility
function

* ports.h: use scm_i_ prefix for port table and port table size.
This commit is contained in:
Han-Wen Nienhuys 2002-08-16 22:01:10 +00:00
parent f07c886abb
commit 67329a9eef
22 changed files with 107 additions and 77 deletions

View file

@ -1,3 +1,19 @@
2002-08-17 Han-Wen Nienhuys <hanwen@cs.uu.nl>
* *.c: use scm_malloc in stead of malloc everywhere.
* mallocs.c (scm_malloc_obj): use scm_gc_malloc in stead of
malloc.
* gc-segment.c (scm_i_get_new_heap_segment): remove cluster cruft:
only use SCM_MIN_HEAP_SEG_SIZE.
* ports.c (scm_add_to_port_table): add backwards compatibility
function
* ports.h: use scm_i_ prefix for port table and port table size.
2002-08-15 Mikael Djurfeldt <mdj@linnaeus>
* vports.c (scm_make_soft_port): Initialize pt variable.

View file

@ -200,7 +200,7 @@ alloca (unsigned size)
/* Allocate combined header + user data storage. */
{
register pointer new = (pointer) malloc (sizeof (header) + size);
register pointer new = (pointer) scm_malloc (sizeof (header) + size);
/* Address of header. */
if (new == 0)

View file

@ -40,7 +40,7 @@
* If you do not wish that, delete this exception notice. */
/* $Id: coop.c,v 1.29 2001-11-04 15:52:29 ela Exp $ */
/* $Id: coop.c,v 1.30 2002-08-16 22:01:09 hanwen Exp $ */
/* Cooperative thread library, based on QuickThreads */
@ -620,7 +620,7 @@ coop_create (coop_userf_t *f, void *pu)
else
#endif
{
t = malloc (sizeof (coop_t));
t = scm_malloc (sizeof (coop_t), "coop");
t->specific = NULL;
t->n_keys = 0;
@ -647,7 +647,7 @@ coop_create (coop_userf_t *f, void *pu)
while (coop_child || mother_awake_p)
usleep (0);
#else
t->sto = malloc (COOP_STKSIZE);
t->sto = scm_malloc (COOP_STKSIZE);
sto = COOP_STKALIGN (t->sto, QT_STKALIGN);
t->sp = QT_SP (sto, COOP_STKSIZE - QT_STKALIGN);
#endif
@ -730,7 +730,7 @@ coop_join(coop_t *t)
/* Create a join list if necessary */
if (t->joining == NULL)
{
t->joining = malloc(sizeof(coop_q_t));
t->joining = scm_malloc(sizeof(coop_q_t));
coop_qinit((coop_q_t *) t->joining);
}

View file

@ -87,7 +87,7 @@ scm_c_issue_deprecation_warning (const char *msg)
scm_newline (scm_current_error_port ());
}
msg = strdup (msg);
iw = malloc (sizeof (struct issued_warning));
iw = scm_malloc (sizeof (struct issued_warning));
if (msg == NULL || iw == NULL)
return;
iw->message = msg;

View file

@ -220,9 +220,9 @@ scm_evict_ports (int fd)
{
long i;
for (i = 0; i < scm_port_table_size; i++)
for (i = 0; i < scm_i_port_table_size; i++)
{
SCM port = scm_port_table[i]->port;
SCM port = scm_i_port_table[i]->port;
if (SCM_FPORTP (port))
{

View file

@ -512,21 +512,14 @@ scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, policy_on_erro
freelist->collected = LONG_MAX;
}
if (len > scm_max_segment_size)
len = scm_max_segment_size;
if (len > SCM_MIN_HEAP_SEG_SIZE)
len = SCM_MIN_HEAP_SEG_SIZE;
{
size_t smallest;
scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist);
smallest = 1024 * 10; /* UGH. */
if (len < smallest)
len = smallest;
/* Allocate with decaying ambition. */
while ((len >= SCM_MIN_HEAP_SEG_SIZE)
&& (len >= smallest))
while (len >= SCM_MIN_HEAP_SEG_SIZE)
{
if (scm_i_initialize_heap_segment_data (seg, len))
{

View file

@ -892,9 +892,9 @@ scm_init_storage ()
scm_c_hook_init (&scm_after_gc_c_hook, 0, SCM_C_HOOK_NORMAL);
/* Initialise the list of ports. */
scm_port_table = (scm_t_port **)
malloc (sizeof (scm_t_port *) * scm_port_table_room);
if (!scm_port_table)
scm_i_port_table = (scm_t_port **)
malloc (sizeof (scm_t_port *) * scm_i_port_table_room);
if (!scm_i_port_table)
return 1;
#ifdef HAVE_ATEXIT

View file

@ -2393,7 +2393,7 @@ create_smob_classes (void)
{
long i;
scm_smob_class = (SCM *) malloc (255 * sizeof (SCM));
scm_smob_class = (SCM *) scm_malloc (255 * sizeof (SCM));
for (i = 0; i < 255; ++i)
scm_smob_class[i] = 0;
@ -2436,7 +2436,7 @@ create_port_classes (void)
{
long i;
scm_port_class = (SCM *) malloc (3 * 256 * sizeof (SCM));
scm_port_class = (SCM *) scm_malloc (3 * 256 * sizeof (SCM));
for (i = 0; i < 3 * 256; ++i)
scm_port_class[i] = 0;

View file

@ -302,11 +302,11 @@ SCM_DEFINE (scm_fdes_to_ports, "fdes->ports", 1, 0, 0,
SCM_VALIDATE_INUM_COPY (1, fd, int_fd);
for (i = 0; i < scm_port_table_size; i++)
for (i = 0; i < scm_i_port_table_size; i++)
{
if (SCM_OPFPORTP (scm_port_table[i]->port)
&& ((scm_t_fport *) scm_port_table[i]->stream)->fdes == int_fd)
result = scm_cons (scm_port_table[i]->port, result);
if (SCM_OPFPORTP (scm_i_port_table[i]->port)
&& ((scm_t_fport *) scm_i_port_table[i]->stream)->fdes == int_fd)
result = scm_cons (scm_i_port_table[i]->port, result);
}
return result;
}

View file

@ -84,7 +84,7 @@ malloc_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
SCM
scm_malloc_obj (size_t n)
{
scm_t_bits mem = n ? (scm_t_bits) malloc (n) : 0;
scm_t_bits mem = n ? (scm_t_bits) scm_gc_malloc (n, "malloc smob") : 0;
if (n && !mem)
return SCM_BOOL_F;
SCM_RETURN_NEWSMOB (scm_tc16_malloc, mem);

View file

@ -446,36 +446,36 @@ SCM_DEFINE (scm_set_current_error_port, "set-current-error-port", 1, 0, 0,
/* The port table --- an array of pointers to ports. */
scm_t_port **scm_port_table;
scm_t_port **scm_i_port_table;
long scm_port_table_size = 0; /* Number of ports in scm_port_table. */
long scm_port_table_room = 20; /* Size of the array. */
long scm_i_port_table_size = 0; /* Number of ports in scm_i_port_table. */
long scm_i_port_table_room = 20; /* Size of the array. */
SCM
scm_new_port_table_entry (scm_t_bits tag)
#define FUNC_NAME "scm_new_port_table_entry"
{
SCM z = scm_cell (SCM_EOL, SCM_EOL);
SCM z = scm_cons (SCM_EOL, SCM_EOL);
scm_t_port *entry = (scm_t_port *) scm_gc_calloc (sizeof (scm_t_port), "port");
if (scm_port_table_size == scm_port_table_room)
if (scm_i_port_table_size == scm_i_port_table_room)
{
/* initial malloc is in gc.c. this doesn't use scm_gc_malloc etc.,
since it can never be freed during gc. */
void *newt = scm_realloc ((char *) scm_port_table,
void *newt = scm_realloc ((char *) scm_i_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;
* scm_i_port_table_room * 2));
scm_i_port_table = (scm_t_port **) newt;
scm_i_port_table_room *= 2;
}
entry->entry = scm_port_table_size;
entry->entry = scm_i_port_table_size;
entry->file_name = SCM_BOOL_F;
entry->rw_active = SCM_PORT_NEITHER;
scm_port_table[scm_port_table_size] = entry;
scm_port_table_size++;
scm_i_port_table[scm_i_port_table_size] = entry;
scm_i_port_table_size++;
entry->port = z;
SCM_SET_CELL_TYPE(z, tag);
@ -485,6 +485,22 @@ scm_new_port_table_entry (scm_t_bits tag)
}
#undef FUNC_NAME
#if SCM_ENABLE_DEPRECATED==1
SCM_API scm_t_port *
scm_add_to_port_table (SCM port)
{
SCM z = scm_new_port_table_entry (scm_tc7_port);
scm_t_port * pt = SCM_PTAB_ENTRY(z);
pt->port = port;
SCM_SETCAR(z, SCM_EOL);
SCM_SETCDR(z, SCM_EOL);
return pt;
}
#endif
/* Remove a port from the table and destroy it. */
void
scm_remove_from_port_table (SCM port)
@ -493,20 +509,20 @@ scm_remove_from_port_table (SCM port)
scm_t_port *p = SCM_PTAB_ENTRY (port);
long i = p->entry;
if (i >= scm_port_table_size)
if (i >= scm_i_port_table_size)
SCM_MISC_ERROR ("Port not in table: ~S", scm_list_1 (port));
if (p->putback_buf)
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)
if (i < scm_i_port_table_size - 1)
{
scm_port_table[i] = scm_port_table[scm_port_table_size - 1];
scm_port_table[i]->entry = i;
scm_i_port_table[i] = scm_i_port_table[scm_i_port_table_size - 1];
scm_i_port_table[i]->entry = i;
}
SCM_SETPTAB_ENTRY (port, 0);
scm_port_table_size--;
scm_i_port_table_size--;
}
#undef FUNC_NAME
@ -520,7 +536,7 @@ SCM_DEFINE (scm_pt_size, "pt-size", 0, 0, 0,
"is only included in @code{--enable-guile-debug} builds.")
#define FUNC_NAME s_scm_pt_size
{
return SCM_MAKINUM (scm_port_table_size);
return SCM_MAKINUM (scm_i_port_table_size);
}
#undef FUNC_NAME
@ -533,10 +549,10 @@ SCM_DEFINE (scm_pt_member, "pt-member", 1, 0, 0,
{
long i;
SCM_VALIDATE_INUM_COPY (1, index, i);
if (i < 0 || i >= scm_port_table_size)
if (i < 0 || i >= scm_i_port_table_size)
return SCM_BOOL_F;
else
return scm_port_table[i]->port;
return scm_i_port_table[i]->port;
}
#undef FUNC_NAME
#endif
@ -741,8 +757,8 @@ SCM_DEFINE (scm_port_for_each, "port-for-each", 1, 0, 0,
SCM_DEFER_INTS;
scm_block_gc++;
ports = SCM_EOL;
for (i = 0; i < scm_port_table_size; i++)
ports = scm_cons (scm_port_table[i]->port, ports);
for (i = 0; i < scm_i_port_table_size; i++)
ports = scm_cons (scm_i_port_table[i]->port, ports);
scm_block_gc--;
SCM_ALLOW_INTS;
@ -844,10 +860,10 @@ SCM_DEFINE (scm_flush_all_ports, "flush-all-ports", 0, 0, 0,
{
size_t i;
for (i = 0; i < scm_port_table_size; i++)
for (i = 0; i < scm_i_port_table_size; i++)
{
if (SCM_OPOUTPORTP (scm_port_table[i]->port))
scm_flush (scm_port_table[i]->port);
if (SCM_OPOUTPORTP (scm_i_port_table[i]->port))
scm_flush (scm_i_port_table[i]->port);
}
return SCM_UNSPECIFIED;
}
@ -1497,7 +1513,7 @@ void
scm_ports_prehistory ()
{
scm_numptob = 0;
scm_ptobs = (scm_t_ptob_descriptor *) malloc (sizeof (scm_t_ptob_descriptor));
scm_ptobs = (scm_t_ptob_descriptor *) scm_malloc (sizeof (scm_t_ptob_descriptor));
}

View file

@ -132,8 +132,8 @@ typedef struct
size_t putback_buf_size; /* allocated size of putback_buf. */
} scm_t_port;
SCM_API scm_t_port **scm_port_table;
SCM_API long scm_port_table_size; /* Number of ports in scm_port_table. */
SCM_API scm_t_port **scm_i_port_table;
SCM_API long scm_i_port_table_size; /* Number of ports in scm_i_port_table. */
#define SCM_READ_BUFFER_EMPTY_P(c_port) (c_port->read_pos >= c_port->read_end)
@ -215,7 +215,7 @@ typedef struct scm_t_ptob_descriptor
SCM_API scm_t_ptob_descriptor *scm_ptobs;
SCM_API long scm_numptob;
SCM_API long scm_port_table_room;
SCM_API long scm_i_port_table_room;
@ -309,6 +309,11 @@ SCM_API SCM scm_void_port (char * mode_str);
SCM_API SCM scm_sys_make_void_port (SCM mode);
SCM_API void scm_init_ports (void);
#if SCM_ENABLE_DEPRECATED==1
SCM_API scm_t_port * scm_add_to_port_table (SCM port);
#endif
#ifdef GUILE_DEBUG
SCM_API SCM scm_pt_size (void);
SCM_API SCM scm_pt_member (SCM member);

View file

@ -906,7 +906,7 @@ environ_list_to_c (SCM envlist, int arg, const char *proc)
num_strings = scm_ilength (envlist);
SCM_ASSERT (num_strings >= 0, envlist, arg, proc);
result = (char **) malloc ((num_strings + 1) * sizeof (char *));
result = (char **) scm_malloc ((num_strings + 1) * sizeof (char *));
if (result == NULL)
scm_memory_error (proc);
for (i = 0; !SCM_NULL_OR_NIL_P (envlist); ++i, envlist = SCM_CDR (envlist))
@ -918,7 +918,7 @@ environ_list_to_c (SCM envlist, int arg, const char *proc)
SCM_ASSERT (SCM_STRINGP (str), envlist, arg, proc);
len = SCM_STRING_LENGTH (str);
src = SCM_STRING_CHARS (str);
result[i] = malloc (len + 1);
result[i] = scm_malloc (len + 1);
if (result[i] == NULL)
scm_memory_error (proc);
memcpy (result[i], src, len);
@ -1193,7 +1193,7 @@ SCM_DEFINE (scm_putenv, "putenv", 1, 0, 0,
else
{
/* must make a new copy to be left in the environment, safe from gc. */
ptr = malloc (SCM_STRING_LENGTH (str) + 1);
ptr = scm_malloc (SCM_STRING_LENGTH (str) + 1);
if (ptr == NULL)
SCM_MEMORY_ERROR;
strncpy (ptr, SCM_STRING_CHARS (str), SCM_STRING_LENGTH (str));

View file

@ -115,7 +115,7 @@ putenv (const char *string)
if (*ep == NULL)
{
static char **last_environ = NULL;
char **new_environ = (char **) malloc ((size + 2) * sizeof (char *));
char **new_environ = (char **) scm_malloc ((size + 2) * sizeof (char *));
if (new_environ == NULL)
return -1;
memcpy ((char *) new_environ, (char *) environ, size * sizeof (char *));

View file

@ -176,7 +176,7 @@ scm_i_init_rstate (scm_t_i_rstate *state, char *seed, int n)
scm_t_i_rstate *
scm_i_copy_rstate (scm_t_i_rstate *state)
{
scm_t_rstate *new_state = malloc (scm_the_rng.rstate_size);
scm_t_rstate *new_state = scm_malloc (scm_the_rng.rstate_size);
if (new_state == 0)
scm_memory_error ("rstate");
return memcpy (new_state, state, scm_the_rng.rstate_size);
@ -190,7 +190,7 @@ scm_i_copy_rstate (scm_t_i_rstate *state)
scm_t_rstate *
scm_c_make_rstate (char *seed, int n)
{
scm_t_rstate *state = malloc (scm_the_rng.rstate_size);
scm_t_rstate *state = scm_malloc (scm_the_rng.rstate_size);
if (state == 0)
scm_memory_error ("rstate");
state->reserved0 = 0;

View file

@ -83,7 +83,7 @@ scm_cat_path (char *str1, const char *str2, long n)
strncat (str1 + len, str2, n);
return str1;
}
str1 = (char *) malloc ((size_t) (n + 1));
str1 = (char *) scm_malloc ((size_t) (n + 1));
if (!str1)
return 0L;
str1[0] = 0;
@ -236,7 +236,7 @@ script_read_arg (FILE *f)
#define FUNC_NAME "script_read_arg"
{
size_t size = 7;
char *buf = malloc (size + 1);
char *buf = scm_malloc (size + 1);
size_t len = 0;
if (! buf)
@ -315,7 +315,7 @@ scm_get_meta_args (int argc, char **argv)
char *narg, **nargv;
if (!(argc > 2 && script_meta_arg_P (argv[1])))
return 0L;
if (!(nargv = (char **) malloc ((1 + nargc) * sizeof (char *))))
if (!(nargv = (char **) scm_malloc ((1 + nargc) * sizeof (char *))))
return 0L;
nargv[0] = argv[0];
while (((argi + 1) < argc) && (script_meta_arg_P (argv[argi])))

View file

@ -707,7 +707,7 @@ scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg,
SCM_VALIDATE_CONS (which_arg + 1, *args);
SCM_VALIDATE_INUM_COPY (which_arg + 1, SCM_CAR (*args), port);
*args = SCM_CDR (*args);
soka = (struct sockaddr_in *) malloc (sizeof (struct sockaddr_in));
soka = (struct sockaddr_in *) scm_malloc (sizeof (struct sockaddr_in));
if (!soka)
scm_memory_error (proc);
/* 4.4BSD-style interface includes sin_len member and defines SIN_LEN,
@ -745,7 +745,7 @@ scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg,
*args = SCM_CDR (*args);
}
}
soka = (struct sockaddr_in6 *) malloc (sizeof (struct sockaddr_in6));
soka = (struct sockaddr_in6 *) scm_malloc (sizeof (struct sockaddr_in6));
if (!soka)
scm_memory_error (proc);
#ifdef SIN_LEN6
@ -777,7 +777,7 @@ scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg,
member of the structure. */
addr_size = sizeof (struct sockaddr_un)
+ max (0, SCM_STRING_LENGTH (address) + 1 - (sizeof soka->sun_path));
soka = (struct sockaddr_un *) malloc (addr_size);
soka = (struct sockaddr_un *) scm_malloc (addr_size);
if (!soka)
scm_memory_error (proc);
memset (soka, 0, addr_size); /* for sun_len: see sin_len above. */

View file

@ -878,7 +878,7 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
the following array does not contain any new references to
SCM objects, so we can get away with allocing it on the heap.
*/
temp = malloc (len * sizeof(SCM));
temp = scm_malloc (len * sizeof(SCM));
scm_merge_vector_step (items,
temp,
@ -919,7 +919,7 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0,
else if (SCM_VECTORP (items))
{
long len = SCM_VECTOR_LENGTH (items);
SCM *temp = malloc (len * sizeof (SCM));
SCM *temp = scm_malloc (len * sizeof (SCM));
SCM retvec = scm_make_uve (len, scm_array_prototype (items));
scm_array_copy_x (items, retvec);

View file

@ -138,7 +138,7 @@ scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM plist)
scm_t_srcprops_chunk *mem;
size_t n = sizeof (scm_t_srcprops_chunk)
+ sizeof (scm_t_srcprops) * (SRCPROPS_CHUNKSIZE - 1);
SCM_SYSCALL (mem = (scm_t_srcprops_chunk *) malloc (n));
SCM_SYSCALL (mem = (scm_t_srcprops_chunk *) scm_malloc (n));
if (mem == NULL)
scm_memory_error ("srcprops");
scm_mallocated += n;

View file

@ -363,7 +363,7 @@ scm_c_string2str (SCM obj, char *str, size_t *lenp)
{
/* FIXME: Should we use exported wrappers for malloc (and free), which
* allow windows DLLs to call the correct freeing function? */
str = (char *) malloc ((len + 1) * sizeof (char));
str = (char *) scm_malloc ((len + 1) * sizeof (char));
if (str == NULL)
return NULL;
}

View file

@ -383,7 +383,7 @@ scm_c_symbol2str (SCM obj, char *str, size_t *lenp)
{
/* FIXME: Should we use exported wrappers for malloc (and free), which
* allow windows DLLs to call the correct freeing function? */
str = (char *) malloc ((len + 1) * sizeof (char));
str = (char *) scm_malloc ((len + 1) * sizeof (char));
if (str == NULL)
return NULL;
}

View file

@ -57,7 +57,7 @@ opendir (const char * name)
if (!name || !*name)
return NULL;
file = malloc (strlen (name) + 3);
file = scm_malloc (strlen (name) + 3);
strcpy (file, name);
if (file[strlen (name) - 1] != '/' && file[strlen (name) - 1] != '\\')
strcat (file, "/*");
@ -70,10 +70,10 @@ opendir (const char * name)
return NULL;
}
dir = malloc (sizeof (DIR));
dir = scm_malloc (sizeof (DIR));
dir->mask = file;
dir->fd = (int) hnd;
dir->data = malloc (sizeof (WIN32_FIND_DATA));
dir->data = scm_malloc (sizeof (WIN32_FIND_DATA));
dir->allocation = sizeof (WIN32_FIND_DATA);
dir->size = dir->allocation;
dir->filepos = 0;