1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +02:00

Custom binary input ports support 'setvbuf'.

* libguile/r6rs-ports.c (CBIP_BUFFER_SIZE): Adjust comment.  Set to 8KiB.
  (SCM_SET_CBIP_BYTEVECTOR): New macro.
  (cbip_setvbuf): New function.
  (make_cbip): Set PORT's 'setvbuf' internal field.
  (cbip_fill_input): Check whether PORT is buffered.  When unbuffered,
  check whether BV can hold C_REQUESTED bytes, and allocate a new
  bytevector if not; copy the data back from BV to c_port->read_pos.
  Remove 'again' label, and don't loop there.
* test-suite/tests/r6rs-ports.test ("7.2.7 Input Ports")["custom binary
  input port unbuffered & 'port-position'", "custom binary input port
  unbuffered & 'read!' calls", "custom binary input port, unbuffered
  then buffered", "custom binary input port, buffered then unbuffered"]:
  New tests.
* doc/ref/api-io.texi (R6RS Binary Input): Document the buffering of
  custom binary input ports, and link to 'setvbuf'.
This commit is contained in:
Ludovic Courtès 2014-01-16 23:43:31 +01:00
parent 122f24cc8a
commit 8ca97482b0
3 changed files with 206 additions and 17 deletions

View file

@ -37,6 +37,7 @@
#include "libguile/validate.h"
#include "libguile/values.h"
#include "libguile/vectors.h"
#include "libguile/ports-internal.h"
@ -280,18 +281,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)
@ -331,7 +373,10 @@ make_cbip (SCM read_proc, SCM get_position_proc,
c_port->read_end = (unsigned char *) c_bv;
c_port->read_buf_size = c_len;
/* Mark PORT as open, readable and unbuffered (hmm, how elegant...). */
/* 'setvbuf' is supported. */
SCM_PORT_GET_INTERNAL (port)->setvbuf = cbip_setvbuf;
/* Mark PORT as open and readable. */
SCM_SET_CELL_TYPE (port, custom_binary_input_port_type | mode_bits);
scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
@ -346,26 +391,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));
@ -373,11 +431,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;
}