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

1999-07-04 Gary Houston <ghouston@easynet.co.uk>

Browse source 
* strports.c (scm_strprint_obj): bug fix: get pt from the port,
	not from the parameter obj.  (Thanks to Eric Moore.)
	* ports.h: SCM_CRDY, SCM_CUC, SCM_CRDYP, SCM_SETRDY, SCM_CUNGET,
	SCM_CGETUN, SCM_CLRDY, SCM_TRY_CLRDY, SCM_N_READY_CHARS: deleted.
	* strings.c (scm_make_string): throw error if 2nd arg isn't
	a char.
	* unif.c (scm_uniform_array_read_x): fix reading from a port.
	allow non-fports.
	(scm_uniform_array_write): likewise.
1999-06-29  Gary Houston  <ghouston@easynet.co.uk>
	* ports.c (scm_drain_input): rewritten.
	* fports.c (local_fclose): check putback_buf.
	(local_read_flush): likewise.
	* ports.c (scm_remove_from_port_table): maybe free putback_buf.
	* ports.h (scm_port): replace cbuf/cbufend/cp with putback_buf/
	putback_buf_size.
	(SCM_INITIAL_PUTBACK_BUF_SIZE): renamed from SCM_INITIAL_CBUF_SIZE.
	* ports.c (scm_grow_port_cbuf): deleted.
	(scm_add_to_port_table): initialise putback_buf to 0.  remove cbuf
	stuff.
	(scm_char_ready_p): check putback_buf
	(scm_fill_buffer): likewise.
	(scm_ungetc): rewritten.
1999-06-27  Gary Houston  <ghouston@easynet.co.uk>
	* fports.c (local_fclose): account for push-back buffer.
	* ports.c (scm_char_ready_p): check the push-back buffer in
	a new way.
	* ioext.c (scm_do_read_line): remove the extra code to handle
	the push-back buffer.
	* ports.c (scm_getc): don't use SCM_CRDYP etc.
	* ioext.c (scm_do_read_line): call scm_fill_buffer.
	* ports.c (scm_ungetc): don't call SCM_CUNGET.  reset the
	read buffer pointers.
	scm_fill_buffer: new procedure.
	(scm_getc): call scm_fill_buffer.
	* ports.h (struct scm_port): saved_read_buf, saved_read_pos,
	saved_read_end: new fields.
1999-07-04  Gary Houston  <ghouston@easynet.co.uk>
	* configure.in: don't check for ways to violate stdio abstraction.
This commit is contained in:
Gary Houston 1999-07-04 11:02:21 +00:00
parent ab41a129a8
commit 6c9514275b
23 changed files with 631 additions and 1655 deletions
Download patch file Download diff file Expand all files Collapse all files

57
libguile/ChangeLog
View file

@ -1,3 +1,60 @@
1999-07-04 Gary Houston <ghouston@easynet.co.uk>
* strports.c (scm_strprint_obj): bug fix: get pt from the port,
not from the parameter obj. (Thanks to Eric Moore.)
* ports.h: SCM_CRDY, SCM_CUC, SCM_CRDYP, SCM_SETRDY, SCM_CUNGET,
SCM_CGETUN, SCM_CLRDY, SCM_TRY_CLRDY, SCM_N_READY_CHARS: deleted.
* strings.c (scm_make_string): throw error if 2nd arg isn't
a char.
* unif.c (scm_uniform_array_read_x): fix reading from a port.
allow non-fports.
(scm_uniform_array_write): likewise.
1999-06-29 Gary Houston <ghouston@easynet.co.uk>
* ports.c (scm_drain_input): rewritten.
* fports.c (local_fclose): check putback_buf.
(local_read_flush): likewise.
* ports.c (scm_remove_from_port_table): maybe free putback_buf.
* ports.h (scm_port): replace cbuf/cbufend/cp with putback_buf/
putback_buf_size.
(SCM_INITIAL_PUTBACK_BUF_SIZE): renamed from SCM_INITIAL_CBUF_SIZE.
* ports.c (scm_grow_port_cbuf): deleted.
(scm_add_to_port_table): initialise putback_buf to 0. remove cbuf
stuff.
(scm_char_ready_p): check putback_buf
(scm_fill_buffer): likewise.
(scm_ungetc): rewritten.
1999-06-27 Gary Houston <ghouston@easynet.co.uk>
* fports.c (local_fclose): account for push-back buffer.
* ports.c (scm_char_ready_p): check the push-back buffer in
a new way.
* ioext.c (scm_do_read_line): remove the extra code to handle
the push-back buffer.
* ports.c (scm_getc): don't use SCM_CRDYP etc.
* ioext.c (scm_do_read_line): call scm_fill_buffer.
* ports.c (scm_ungetc): don't call SCM_CUNGET. reset the
read buffer pointers.
scm_fill_buffer: new procedure.
(scm_getc): call scm_fill_buffer.
* ports.h (struct scm_port): saved_read_buf, saved_read_pos,
saved_read_end: new fields.
1999-06-24 Mikael Djurfeldt <mdj@orjan.nada.kth.se>
* dynl-dl.c (sysdep_dynl_link): Added parenthesis around the

3
libguile/Makefile.in
View file

@ -59,11 +59,9 @@ PRE_UNINSTALL = :
POST_UNINSTALL = :
host_alias = @host_alias@
host_triplet = @host@
AS = @AS@
AWK = @AWK@
CC = @CC@
CPP = @CPP@
DLLTOOL = @DLLTOOL@
GUILE_LIBS = @GUILE_LIBS@
GUILE_MAJOR_VERSION = @GUILE_MAJOR_VERSION@
GUILE_MINOR_VERSION = @GUILE_MINOR_VERSION@
@ -76,7 +74,6 @@ LN_S = @LN_S@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
NM = @NM@
OBJDUMP = @OBJDUMP@
PACKAGE = @PACKAGE@
QTHREAD_LTLIBS = @QTHREAD_LTLIBS@
RANLIB = @RANLIB@

11
libguile/fports.c
View file

@ -514,10 +514,13 @@ local_read_flush (SCM port)
scm_port *pt = SCM_PTAB_ENTRY (port);
int offset = pt->read_end - pt->read_pos;
if (SCM_CRDYP (port))
if (pt->read_buf == pt->putback_buf)
{
offset += SCM_N_READY_CHARS (port);
SCM_CLRDY (port);
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;
offset += pt->read_end - pt->read_pos;
}
if (offset > 0)
{
@ -541,6 +544,8 @@ local_fclose (SCM port)
SCM_SYSCALL (rv = close (fp->fdes));
if (rv == -1 && errno != EBADF)
scm_syserror ("local_fclose");
if (pt->read_buf == pt->putback_buf)
pt->read_buf = pt->saved_read_buf;
if (pt->read_buf != &pt->shortbuf)
free (pt->read_buf);
if (pt->write_buf != &pt->shortbuf)

44
libguile/ioext.c
View file

@ -148,44 +148,8 @@ scm_do_read_line (SCM port, int *len_p)
/* I thought reading lines was simple. Mercy me. */
/* If there are any pushed-back characters, read the line character
by character. */
if (SCM_CRDYP (port))
{
int buf_size = 60;
/* Invariant: buf always has buf_size + 1 characters allocated;
the `+ 1' is for the final '\0'. */
unsigned char *buf = malloc (buf_size + 1);
int buf_len = 0;
int c;
while ((c = scm_getc (port)) != EOF)
{
if (buf_len >= buf_size)
{
buf = realloc (buf, buf_size * 2 + 1);
buf_size *= 2;
}
buf[buf_len++] = c;
if (c == '\n')
break;
}
/* Since SCM_CRDYP returned true, we ought to have gotten at
least one character. */
if (buf_len == 0)
abort ();
buf[buf_len] = '\0';
*len_p = buf_len;
return buf;
}
/* The common case: no unread characters, and the buffer contains
a complete line. This needs to be fast. */
/* The common case: the buffer contains a complete line.
This needs to be fast. */
if ((end = memchr (pt->read_pos, '\n', (pt->read_end - pt->read_pos)))
!= 0)
{
@ -202,7 +166,7 @@ scm_do_read_line (SCM port, int *len_p)
return buf;
}
/* There are no unread characters, and the buffer contains no newlines. */
/* The buffer contains no newlines. */
{
/* When live, len is always the number of characters in the
current buffer that are part of the current line. */
@ -234,7 +198,7 @@ scm_do_read_line (SCM port, int *len_p)
/* Get more characters. I think having fill_buffer return a
character is not terribly graceful... */
c = (scm_ptobs[SCM_PTOBNUM (port)].fill_buffer) (port);
c = scm_fill_buffer (port, pt);
if (c == EOF)
{
/* If we're missing a final newline in the file, return

161
libguile/ports.c
View file

@ -128,62 +128,61 @@ SCM
scm_char_ready_p (port)
SCM port;
{
scm_port *pt = SCM_PTAB_ENTRY (port);
if (SCM_UNBNDP (port))
port = scm_cur_inp;
else
SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1,
s_char_ready_p);
if (SCM_CRDYP (port))
/* if the current read buffer is filled, or the
last pushed-back char has been read and the saved buffer is
filled, result is true. */
if (pt->read_pos < pt->read_end
|| (pt->read_buf == pt->putback_buf
&& pt->saved_read_pos < pt->saved_read_end))
return SCM_BOOL_T;
else
{
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_ptobfuns *ptob = &scm_ptobs[SCM_PTOBNUM (port)];
if (pt->read_pos < pt->read_end)
return SCM_BOOL_T;
if (ptob->input_waiting_p)
return (ptob->input_waiting_p (port)) ? SCM_BOOL_T : SCM_BOOL_F;
else
{
scm_ptobfuns *ptob = &scm_ptobs[SCM_PTOBNUM (port)];
if (ptob->input_waiting_p)
return (ptob->input_waiting_p (port)) ? SCM_BOOL_T : SCM_BOOL_F;
else
return SCM_BOOL_T;
}
return SCM_BOOL_T;
}
}
/* Clear a port's read buffer, returning the contents. */
/* Clear a port's read buffers, returning the contents. */
SCM_PROC (s_drain_input, "drain-input", 1, 0, 0, scm_drain_input);
SCM
scm_drain_input (SCM port)
{
SCM result;
scm_port *pt = SCM_PTAB_ENTRY (port);
int p_count;
int count;
char *dst;
char *p_buf;
SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1,
s_drain_input);
p_count = (SCM_CRDYP (port)) ? SCM_N_READY_CHARS (port) : 0;
result = scm_makstr (p_count + pt->read_end - pt->read_pos, 0);
dst = SCM_CHARS (result);
p_buf = SCM_PTAB_ENTRY (port)->cp;
count = pt->read_end - pt->read_pos;
if (pt->read_buf == pt->putback_buf)
count += pt->saved_read_end - pt->saved_read_pos;
while (p_count > 0)
{
*dst++ = *p_buf--;
p_count--;
}
SCM_CLRDY (port);
result = scm_makstr (count, 0);
dst = SCM_CHARS (result);
while (pt->read_pos < pt->read_end)
*dst++ = *(pt->read_pos++);
if (pt->read_buf == pt->putback_buf)
{
*dst++ = *(pt->read_pos++);
while (pt->saved_read_pos < pt->saved_read_end)
*dst++ = *(pt->saved_read_pos++);
}
return result;
}
@ -299,10 +298,8 @@ scm_add_to_port_table (port)
entry->file_name = SCM_BOOL_F;
entry->line_number = 0;
entry->column_number = 0;
entry->cp
= entry->cbuf;
entry->cbufend
= &entry->cbuf[SCM_INITIAL_CBUF_SIZE];
entry->putback_buf = 0;
entry->putback_buf_size = 0;
entry->rw_active = 0;
scm_port_table[scm_port_table_size] = entry;
@ -311,7 +308,7 @@ scm_add_to_port_table (port)
return entry;
}
/* Remove a port from the table. */
/* Remove a port from the table and destroy it. */
void
scm_remove_from_port_table (port)
@ -319,9 +316,11 @@ scm_remove_from_port_table (port)
{
scm_port *p = SCM_PTAB_ENTRY (port);
int i = p->entry;
/* Error if not found: too violent? May occur in GC. */
if (i >= scm_port_table_size)
scm_wta (port, "Port not in table", "scm_remove_from_port_table");
if (p->putback_buf)
free (p->putback_buf);
free (p);
/* Since we have just freed slot i we can shrink the table by moving
the last entry to that slot... */
@ -334,6 +333,7 @@ scm_remove_from_port_table (port)
scm_port_table_size--;
}
#if 0
void
scm_grow_port_cbuf (port, requested)
SCM port;
@ -342,12 +342,17 @@ scm_grow_port_cbuf (port, requested)
scm_port *p = SCM_PTAB_ENTRY (port);
int size = p->cbufend - p->cbuf;
int new_size = size * 3 / 2;
int count = p->cp - p->cbuf;
if (new_size < requested)
new_size = requested;
p = realloc (p, sizeof (*p) - SCM_INITIAL_CBUF_SIZE + new_size);
p->cp = p->cbuf + count;
p->bufend = p->cbuf + new_size;
scm_port_table[p->entry] = p;
SCM_SETPTAB_ENTRY (port, p);
}
#endif
#ifdef GUILE_DEBUG
/* Undocumented functions for debugging. */
@ -623,33 +628,43 @@ scm_read_char (port)
return SCM_MAKICHR (c);
}
int
scm_fill_buffer (SCM port, scm_port *pt)
/* port and pt refer to the same port. */
{
if (pt->read_buf == pt->putback_buf)
{
/* finished reading put-back chars. */
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_pos < pt->read_end)
return *(pt->read_pos++);
}
return scm_ptobs[SCM_PTOBNUM (port)].fill_buffer (port);
}
int
scm_getc (port)
SCM port;
{
int c;
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_ptobfuns *ptob = &scm_ptobs[SCM_PTOBNUM (port)];
if (pt->rw_active == SCM_PORT_WRITE)
{
ptob->fflush (port);
/* may be marginally faster than calling scm_fflush. */
scm_ptobs[SCM_PTOBNUM (port)].fflush (port);
}
if (SCM_CRDYP (port))
if (pt->read_pos < pt->read_end)
{
c = SCM_CGETUN (port);
SCM_TRY_CLRDY (port); /* Clear ungetted char */
c = *(pt->read_pos++);
}
else
{
if (pt->read_pos < pt->read_end)
{
c = *(pt->read_pos++);
}
else
{
c = ptob->fill_buffer (port);
}
c = scm_fill_buffer (port, pt);
}
if (pt->rw_random)
@ -681,7 +696,9 @@ scm_putc (c, port)
if (pt->rw_active == SCM_PORT_READ)
ptob->read_flush (port);
*(pt->write_pos++) = (char) c;
if (pt->write_pos == pt->write_end)
ptob->fflush (port);
@ -765,7 +782,59 @@ scm_ungetc (c, port)
{
scm_port *pt = SCM_PTAB_ENTRY (port);
SCM_CUNGET (c, port);
if (pt->read_buf == pt->putback_buf)
/* already using the put-back buffer. */
{
/* enlarge putback_buf if necessary. */
if (pt->read_end == pt->read_buf + pt->read_buf_size
&& pt->read_buf == pt->read_pos)
{
int new_size = pt->read_buf_size * 2;
unsigned char *tmp =
(unsigned char *) realloc (pt->putback_buf, new_size);
if (tmp == NULL)
scm_memory_error ("scm_ungetc");
pt->read_pos = pt->read_buf = pt->putback_buf = tmp;
pt->read_end = pt->read_buf + pt->read_buf_size;
pt->read_buf_size = pt->putback_buf_size = new_size;
}
/* shift any existing bytes to buffer + 1. */
if (pt->read_pos == pt->read_end)
pt->read_end = pt->read_buf + 1;
else if (pt->read_pos != pt->read_buf + 1)
{
int count = pt->read_end - pt->read_pos;
memmove (pt->read_buf + 1, pt->read_pos, count);
pt->read_end = pt->read_buf + 1 + count;
}
pt->read_pos = pt->read_buf;
}
else
/* switch to the put-back buffer. */
{
if (pt->putback_buf == NULL)
{
pt->putback_buf = (char *) malloc (pt->putback_buf_size);
if (pt->putback_buf == NULL)
scm_memory_error ("scm_ungetc");
pt->putback_buf_size = SCM_INITIAL_PUTBACK_BUF_SIZE;
}
pt->saved_read_buf = pt->read_buf;
pt->saved_read_pos = pt->read_pos;
pt->saved_read_end = pt->read_end;
pt->saved_read_buf_size = pt->read_buf_size;
pt->read_pos = pt->read_buf = pt->putback_buf;
pt->read_end = pt->read_buf + 1;
pt->read_buf_size = pt->putback_buf_size;
}
*pt->read_buf = c;
if (pt->rw_random)
pt->rw_active = SCM_PORT_READ;

65
libguile/ports.h
View file

@ -53,7 +53,7 @@
#define SCM_INITIAL_CBUF_SIZE 4
#define SCM_INITIAL_PUTBACK_BUF_SIZE 4
/* C representation of a Scheme port. */
@ -86,11 +86,20 @@ typedef struct
unsigned char *read_end; /* pointer to last buffered char + 1. */
off_t read_buf_size; /* size of the buffer. */
/* when chars are put back into the buffer, e.g., using peek-char or
unread-string, the read-buffer pointers are switched to cbuf.
the original pointers are saved here and restored when the put-back
chars have been consumed. */
unsigned char *saved_read_buf;
const unsigned char *saved_read_pos;
unsigned char *saved_read_end;
off_t saved_read_buf_size;
/* write requests are saved into this buffer at write_pos until it
reaches write_buf + write_buf_size, then the ptob flush is
called. */
unsigned char *write_buf; /* buffer start. */
unsigned char *write_buf; /* buffer start. */
unsigned char *write_pos; /* pointer to last buffered char + 1. */
unsigned char *write_end; /* pointer to end of buffer + 1. */
off_t write_buf_size; /* size of the buffer. */
@ -107,11 +116,9 @@ typedef struct
can be SCM_PORT_WRITE, SCM_PORT_READ,
or 0. */
/* a completely separate buffer which is only used for un-read chars
and strings. */
unsigned char *cp; /* where to put and get unget chars */
unsigned char *cbufend; /* points after this struct */
unsigned char cbuf[SCM_INITIAL_CBUF_SIZE]; /* must be last: may grow */
/* a buffer for un-read chars and strings. */
unsigned char *putback_buf;
int putback_buf_size; /* allocated size of putback_buf. */
} scm_port;
/* values for the rw_active flag. */
@ -135,12 +142,9 @@ extern int scm_port_table_size; /* Number of ports in scm_port_table. */
#define SCM_RDNG (2L<<16) /* Is it a readable port? */
#define SCM_WRTNG (4L<<16) /* Is it writable? */
#define SCM_BUF0 (8L<<16) /* Is it unbuffered? */
#define SCM_CRDY (32L<<16) /* Are there pushed back characters? */
/* #define SCM_CRDY (32L<<16) obsolete, for pushed back characters */
#define SCM_BUFLINE (64L<<16) /* Is it line-buffered? */
/* A mask used to clear the char-ready port flag. */
#define SCM_CUC (~SCM_CRDY)
#define SCM_PORTP(x) (SCM_TYP7(x)==scm_tc7_port)
#define SCM_OPPORTP(x) (((0x7f | SCM_OPN) & SCM_CAR(x))==(scm_tc7_port | SCM_OPN))
#define SCM_OPINPORTP(x) (((0x7f | SCM_OPN | SCM_RDNG) & SCM_CAR(x))==(scm_tc7_port | SCM_OPN | SCM_RDNG))
@ -158,49 +162,11 @@ extern int scm_port_table_size; /* Number of ports in scm_port_table. */
#define SCM_COL(x) SCM_PTAB_ENTRY(x)->column_number
#define SCM_REVEALED(x) SCM_PTAB_ENTRY(x)->revealed
#define SCM_SETREVEALED(x,s) (SCM_PTAB_ENTRY(x)->revealed = s)
#define SCM_CRDYP(port) (SCM_CAR (port) & SCM_CRDY)
#define SCM_SETRDY(port) {SCM_SETOR_CAR (port, SCM_CRDY);}
#define SCM_CUNGET(c, port) \
{ \
if (SCM_CRDYP (port)) \
{ \
if (++SCM_PTAB_ENTRY (port)->cp == SCM_PTAB_ENTRY (port)->cbufend) \
scm_grow_port_cbuf (port, 1); \
*SCM_PTAB_ENTRY (port)->cp = c; \
} \
else \
{ \
SCM_PTAB_ENTRY (port)->cbuf[0] = c; \
SCM_SETRDY (port); \
} \
} \
#define SCM_CGETUN(port) (*SCM_PTAB_ENTRY (port)->cp)
#define SCM_CLRDY(port) \
{ \
SCM_PTAB_ENTRY (port)->cp = SCM_PTAB_ENTRY (port)->cbuf; \
SCM_SETAND_CAR (port, SCM_CUC); \
} \
#define SCM_TRY_CLRDY(port) \
{ \
if (SCM_PTAB_ENTRY (port)->cp == SCM_PTAB_ENTRY (port)->cbuf) \
SCM_SETAND_CAR (port, SCM_CUC); \
else \
--SCM_PTAB_ENTRY (port)->cp; \
} \
/* Returns number of unread characters in a port.
Returns wrong answer if SCM_CRDYP is false. */
#define SCM_N_READY_CHARS(port) \
(SCM_PTAB_ENTRY (port)->cp - SCM_PTAB_ENTRY (port)->cbuf + 1)
#define SCM_INCLINE(port) {SCM_LINUM (port) += 1; SCM_COL (port) = 0;}
#define SCM_INCCOL(port) {SCM_COL (port) += 1;}
#define SCM_TABCOL(port) {SCM_COL (port) += 8 - SCM_COL (port) % 8;}
typedef struct scm_ptobfuns
@ -261,6 +227,7 @@ extern void scm_putc SCM_P ((int c, SCM port));
extern void scm_puts SCM_P ((char *str_data, SCM port));
extern void scm_lfwrite SCM_P ((char *ptr, scm_sizet size, SCM port));
extern void scm_fflush SCM_P ((SCM port));
extern int scm_fill_buffer (SCM port, scm_port *pt);
extern int scm_getc SCM_P ((SCM port));
extern void scm_ungetc SCM_P ((int c, SCM port));
extern void scm_ungets SCM_P ((char *s, int n, SCM port));

18
libguile/scmconfig.h.in
View file

@ -94,24 +94,6 @@
#undef DEBUG_EXTENSIONS
#undef READER_EXTENSIONS
/* Define this if your system has a way to set a stdio stream's file
descriptor. */
#undef FD_SETTER
/* Set this to the name of a field in FILE which contains the number
of buffered characters waiting to be read. */
#undef FILE_CNT_FIELD
/* Define this if your stdio has _gptr and _egptr fields which can
be compared to give the number of buffered characters waiting to
be read. */
#undef FILE_CNT_GPTR
/* Define this if your stdio has _IO_read_ptr and _IO_read_end fields
which can be compared to give the number of buffered characters
waiting to be read. */
#undef FILE_CNT_READPTR
/* Define this if your system defines struct linger, for use with the
getsockopt and setsockopt system calls. */
#undef HAVE_STRUCT_LINGER

16
libguile/strings.c
View file

@ -246,19 +246,19 @@ scm_make_string (k, chr)
SCM chr;
{
SCM res;
register unsigned char *dst;
register long i;
SCM_ASSERT (SCM_INUMP (k) && (k >= 0), k, SCM_ARG1, s_make_string);
i = SCM_INUM (k);
res = scm_makstr (i, 0);
dst = SCM_UCHARS (res);
if SCM_ICHRP (chr)
if (!SCM_UNBNDP (chr))
{
char c = SCM_ICHR (chr);
for (i--;i >= 0;i--)
{
dst[i] = c;
}
SCM_ASSERT (SCM_ICHRP (chr), chr, SCM_ARG2, s_make_string);
{
unsigned char *dst = SCM_UCHARS (res);
char c = SCM_ICHR (chr);
memset (dst, c, i);
}
}
return res;
}

2
libguile/strports.c
View file

@ -247,7 +247,7 @@ scm_strprint_obj (obj)
port = scm_mkstrport (SCM_MAKINUM (0), str, SCM_OPN | SCM_WRTNG, "scm_strprint_obj");
scm_prin1 (obj, port, 1);
{
scm_port *pt = SCM_PTAB_ENTRY (obj);
scm_port *pt = SCM_PTAB_ENTRY (port);
SCM answer;
answer = scm_makfromstr (SCM_CHARS (SCM_STREAM (port)),

83
libguile/unif.c
View file

@ -1469,7 +1469,7 @@ scm_uniform_array_read_x (ra, port_or_fd, start, end)
port_or_fd = scm_cur_inp;
else
SCM_ASSERT (SCM_INUMP (port_or_fd)
|| (SCM_NIMP (port_or_fd) && SCM_OPINFPORTP (port_or_fd)),
|| (SCM_NIMP (port_or_fd) && SCM_OPINPORTP (port_or_fd)),
port_or_fd, SCM_ARG2, s_uniform_array_read_x);
vlen = SCM_LENGTH (v);
@ -1542,18 +1542,49 @@ loop:
if (SCM_NIMP (port_or_fd))
{
/* if we have stored a character from the port in our own buffer,
push it back onto the stream. */
/* An ungetc before an fread will not work on some systems if
setbuf(0). do #define NOSETBUF in scmfig.h to fix this. */
if (SCM_CRDYP (port_or_fd))
scm_port *pt = SCM_PTAB_ENTRY (port_or_fd);
int remaining = (cend - offset) * sz;
char *dest = SCM_CHARS (v) + (cstart + offset) * sz;
if (pt->rw_active == SCM_PORT_WRITE)
scm_fflush (port_or_fd);
ans = cend - offset;
while (remaining > 0)
{
ungetc (SCM_CGETUN (port_or_fd), (FILE *)SCM_STREAM (port_or_fd));
SCM_CLRDY (port_or_fd); /* Clear ungetted char */
if (pt->read_pos < pt->read_end)
{
int to_copy = min (pt->read_end - pt->read_pos,
remaining);
memcpy (dest, pt->read_pos, to_copy);
pt->read_pos += to_copy;
remaining -= to_copy;
dest += to_copy;
}
else
{
int ch = scm_fill_buffer (port_or_fd, pt);
if (ch == EOF)
{
if (remaining % sz != 0)
{
scm_misc_error (s_uniform_array_read_x,
"unexpected EOF",
SCM_EOL);
}
ans -= remaining / sz;
break;
}
*dest++ = ch;
remaining--;
}
}
SCM_SYSCALL (ans = fread (SCM_CHARS (v) + (cstart + offset) * sz,
(scm_sizet) sz, (scm_sizet) (cend - offset),
(FILE *)SCM_STREAM (port_or_fd)));
if (pt->rw_random)
pt->rw_active = SCM_PORT_READ;
}
else /* file descriptor. */
{
@ -1593,7 +1624,7 @@ scm_uniform_array_write (v, port_or_fd, start, end)
port_or_fd = scm_cur_outp;
else
SCM_ASSERT (SCM_INUMP (port_or_fd)
|| (SCM_NIMP (port_or_fd) && SCM_OPOUTFPORTP (port_or_fd)),
|| (SCM_NIMP (port_or_fd) && SCM_OPOUTPORTP (port_or_fd)),
port_or_fd, SCM_ARG2, s_uniform_array_write);
vlen = SCM_LENGTH (v);
@ -1666,9 +1697,31 @@ loop:
if (SCM_NIMP (port_or_fd))
{
SCM_SYSCALL (ans = fwrite (SCM_CHARS (v) + (cstart + offset) * sz,
(scm_sizet) sz, (scm_sizet) (cend - offset),
(FILE *)SCM_STREAM (port_or_fd)));
scm_port *pt = SCM_PTAB_ENTRY (port_or_fd);
int remaining = (cend - offset) * sz;
char *source = SCM_CHARS (v) + (cstart + offset) * sz;
scm_ptobfuns *ptob = &scm_ptobs[SCM_PTOBNUM (port_or_fd)];
ans = cend - offset;
if (pt->rw_active == SCM_PORT_READ)
ptob->read_flush (port_or_fd);
while (remaining > 0)
{
int to_copy = min (pt->write_end - pt->write_pos, remaining);
memcpy (pt->write_pos, source, to_copy);
pt->write_pos += to_copy;
source += to_copy;
remaining -= to_copy;
if (pt->write_pos == pt->write_end)
ptob->fflush (port_or_fd);
}
if (pt->rw_random)
{
pt->rw_active = SCM_PORT_WRITE;
}
}
else /* file descriptor. */
{