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

Merge commit '8ca97482b0'

Browse source 
Conflicts:
	libguile/r6rs-ports.c
This commit is contained in:
Andy Wingo 2014-02-07 14:42:40 +01:00
commit e4eb0e39b4
3 changed files with 203 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

92
libguile/r6rs-ports.c
View file

@ -37,6 +37,7 @@
#include "libguile/validate.h"
#include "libguile/values.h"
#include "libguile/vectors.h"
#include "libguile/ports-internal.h"
@ -272,18 +273,59 @@ cbp_close (SCM port)
static scm_t_bits custom_binary_input_port_type = 0;
/* Size of the buffer embedded in custom binary input ports. */
#define CBIP_BUFFER_SIZE 4096
/* Initial size of the buffer embedded in custom binary input ports. */
#define CBIP_BUFFER_SIZE 8192
/* Return the bytevector associated with PORT. */
#define SCM_CBIP_BYTEVECTOR(_port) \
SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 4)
/* Set BV as the bytevector associated with PORT. */
#define SCM_SET_CBIP_BYTEVECTOR(_port, _bv) \
SCM_SIMPLE_VECTOR_SET (SCM_PACK (SCM_STREAM (_port)), 4, (_bv))
/* Return the various procedures of PORT. */
#define SCM_CBIP_READ_PROC(_port) \
SCM_SIMPLE_VECTOR_REF (SCM_PACK (SCM_STREAM (_port)), 0)
/* Set PORT's internal buffer according to READ_SIZE. */
static void
cbip_setvbuf (SCM port, long read_size, long write_size)
{
SCM bv;
scm_t_port *pt;
pt = SCM_PTAB_ENTRY (port);
bv = SCM_CBIP_BYTEVECTOR (port);
switch (read_size)
{
case 0:
/* Unbuffered: keep PORT's bytevector as is (it will be used in
future 'scm_c_read' calls), but point to the one-byte buffer. */
pt->read_buf = &pt->shortbuf;
pt->read_buf_size = 1;
break;
case -1:
/* Preferred size: keep the current bytevector and use it as the
backing store. */
pt->read_buf = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
pt->read_buf_size = SCM_BYTEVECTOR_LENGTH (bv);
break;
default:
/* Fully buffered: allocate a buffer of READ_SIZE bytes. */
bv = scm_c_make_bytevector (read_size);
SCM_SET_CBIP_BYTEVECTOR (port, bv);
pt->read_buf = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
pt->read_buf_size = read_size;
}
pt->read_pos = pt->read_end = pt->read_buf;
}
static inline SCM
make_cbip (SCM read_proc, SCM get_position_proc,
SCM set_position_proc, SCM close_proc)
@ -330,26 +372,39 @@ cbip_fill_input (SCM port)
int result;
scm_t_port *c_port = SCM_PTAB_ENTRY (port);
again:
if (c_port->read_pos >= c_port->read_end)
{
/* Invoke the user's `read!' procedure. */
int buffered;
size_t c_octets, c_requested;
SCM bv, read_proc, octets;
c_requested = c_port->read_buf_size;
/* Use the bytevector associated with PORT as the buffer passed to the
`read!' procedure, thereby avoiding additional allocations. */
bv = SCM_CBIP_BYTEVECTOR (port);
read_proc = SCM_CBIP_READ_PROC (port);
/* The assumption here is that C_PORT's internal buffer wasn't changed
behind our back. */
assert (c_port->read_buf ==
(unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv));
assert ((unsigned) c_port->read_buf_size
== SCM_BYTEVECTOR_LENGTH (bv));
bv = SCM_CBIP_BYTEVECTOR (port);
buffered =
(c_port->read_buf == (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv));
if (buffered)
/* Make sure the buffer isn't corrupt. BV can be passed directly
to READ_PROC. */
assert (c_port->read_buf_size == SCM_BYTEVECTOR_LENGTH (bv));
else
{
/* This is an unbuffered port. When called via the
'get-bytevector-*' procedures, and thus via 'scm_c_read', we
are passed the caller-provided buffer, so we need to check its
size. */
if (SCM_BYTEVECTOR_LENGTH (bv) < c_requested)
{
/* Bad luck: we have to make another allocation. Save that
bytevector for later reuse, in the hope that the application
has regular access patterns. */
bv = scm_c_make_bytevector (c_requested);
SCM_SET_CBIP_BYTEVECTOR (port, bv);
}
}
octets = scm_call_3 (read_proc, bv, SCM_INUM0,
scm_from_size_t (c_requested));
@ -357,11 +412,15 @@ cbip_fill_input (SCM port)
if (SCM_UNLIKELY (c_octets > c_requested))
scm_out_of_range (FUNC_NAME, octets);
c_port->read_pos = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
if (!buffered)
/* Copy the data back to the internal buffer. */
memcpy ((char *) c_port->read_pos, SCM_BYTEVECTOR_CONTENTS (bv),
c_octets);
c_port->read_end = (unsigned char *) c_port->read_pos + c_octets;
if (c_octets > 0)
goto again;
if (c_octets != 0 || c_requested == 0)
result = (int) *c_port->read_pos;
else
result = EOF;
}
@ -410,6 +469,7 @@ initialize_custom_binary_input_ports (void)
scm_set_port_seek (custom_binary_input_port_type, cbp_seek);
scm_set_port_close (custom_binary_input_port_type, cbp_close);
scm_set_port_setvbuf (custom_binary_input_port_type, cbip_setvbuf);
}