1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-03 16:20:39 +02:00

* ports.h, ports.c (scm_unread_string): New procedure.

(scm_grow_port_cbuf): New function.
* ports.c (scm_add_to_port_table, scm_remove_from_port_table):
Handle new fields.
(scm_generic_fgets), fports.c (local_fgets): Use a loop
to read unread characters.  Use SCM_TRY_CLRDY instead of
SCM_CLRDY.
This commit is contained in:
Mikael Djurfeldt 1998-10-30 08:23:13 +00:00
parent 0855ef7154
commit ee1e7e13b3

View file

@ -250,11 +250,16 @@ scm_add_to_port_table (port)
scm_must_malloc (sizeof (struct scm_port_table), scm_must_malloc (sizeof (struct scm_port_table),
"system port table")); "system port table"));
scm_port_table[scm_port_table_size]->port = port; scm_port_table[scm_port_table_size]->port = port;
scm_port_table[scm_port_table_size]->entry = scm_port_table_size;
scm_port_table[scm_port_table_size]->revealed = 0; scm_port_table[scm_port_table_size]->revealed = 0;
scm_port_table[scm_port_table_size]->stream = 0; scm_port_table[scm_port_table_size]->stream = 0;
scm_port_table[scm_port_table_size]->file_name = SCM_BOOL_F; scm_port_table[scm_port_table_size]->file_name = SCM_BOOL_F;
scm_port_table[scm_port_table_size]->line_number = 0; scm_port_table[scm_port_table_size]->line_number = 0;
scm_port_table[scm_port_table_size]->column_number = 0; scm_port_table[scm_port_table_size]->column_number = 0;
scm_port_table[scm_port_table_size]->cp
= scm_port_table[scm_port_table_size]->cbuf;
scm_port_table[scm_port_table_size]->cbufend
= &scm_port_table[scm_port_table_size]->cbuf[SCM_INITIAL_CBUF_SIZE];
return scm_port_table[scm_port_table_size++]; return scm_port_table[scm_port_table_size++];
} }
@ -264,21 +269,41 @@ void
scm_remove_from_port_table (port) scm_remove_from_port_table (port)
SCM port; SCM port;
{ {
int i = 0; struct scm_port_table *p = SCM_PTAB_ENTRY (port);
while (scm_port_table[i]->port != port) int i = p->entry;
{
i++;
/* Error if not found: too violent? May occur in GC. */ /* Error if not found: too violent? May occur in GC. */
if (i >= scm_port_table_size) if (i >= scm_port_table_size)
scm_wta (port, "Port not in table", "scm_remove_from_port_table"); scm_wta (port, "Port not in table", "scm_remove_from_port_table");
} scm_mallocated -= (sizeof (*p)
scm_must_free ((char *)scm_port_table[i]); + (p->cbufend - p->cbuf)
scm_mallocated -= sizeof (*scm_port_table[i]); - SCM_INITIAL_CBUF_SIZE);
scm_must_free ((char *)p);
/* 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)
{
scm_port_table[i] = scm_port_table[scm_port_table_size - 1]; scm_port_table[i] = scm_port_table[scm_port_table_size - 1];
scm_port_table[i]->entry = i;
}
SCM_SETPTAB_ENTRY (port, 0); SCM_SETPTAB_ENTRY (port, 0);
scm_port_table_size--; scm_port_table_size--;
} }
void
scm_grow_port_cbuf (port, requested)
SCM port;
size_t requested;
{
struct scm_port_table *p = SCM_PTAB_ENTRY (port);
int size = p->cbufend - p->cbuf;
int new_size = size * 3 / 2;
if (new_size < requested)
new_size = requested;
p = realloc (p, sizeof (*p) - SCM_INITIAL_CBUF_SIZE + new_size);
scm_port_table[p->entry] = p;
SCM_SETPTAB_ENTRY (port, p);
}
#ifdef GUILE_DEBUG #ifdef GUILE_DEBUG
/* Undocumented functions for debugging. */ /* Undocumented functions for debugging. */
/* Return the number of ports in the table. */ /* Return the number of ports in the table. */
@ -618,11 +643,11 @@ scm_generic_fgets (port, len)
/* If a char has been pushed onto the port with scm_ungetc, /* If a char has been pushed onto the port with scm_ungetc,
read that first. */ read that first. */
if (SCM_CRDYP (port)) while (SCM_CRDYP (port))
{ {
buf[*len] = SCM_CGETUN (port); buf[*len] = SCM_CGETUN (port);
SCM_CLRDY (port); SCM_TRY_CLRDY (port);
if (buf[(*len)++] == '\n') if (buf[(*len)++] == '\n' || *len == limit - 1)
{ {
buf[*len] = '\0'; buf[*len] = '\0';
return buf; return buf;
@ -676,6 +701,27 @@ scm_unread_char (cobj, port)
return cobj; return cobj;
} }
SCM_PROC (s_unread_string, "unread-string", 2, 0, 0, scm_unread_string);
SCM
scm_unread_string (str, port)
SCM str;
SCM port;
{
SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str),
str, SCM_ARG1, s_unread_string);
if (SCM_UNBNDP (port))
port = scm_cur_inp;
else
SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port),
port, SCM_ARG2, s_unread_string);
scm_ungets (SCM_UCHARS (str), SCM_LENGTH (str), port);
return str;
}
SCM_PROC (s_port_line, "port-line", 1, 0, 0, scm_port_line); SCM_PROC (s_port_line, "port-line", 1, 0, 0, scm_port_line);
SCM SCM