-/* Copyright (C) 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 2009, 2010, 2011, 2013, 2014 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
#include "libguile/validate.h"
#include "libguile/values.h"
#include "libguile/vectors.h"
+#include "libguile/ports-internal.h"
\f
result = scm_call_0 (get_position_proc);
else
scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
- "R6RS custom binary port does not "
- "support `port-position'");
-
- offset += scm_to_int (result);
+ "R6RS custom binary port with "
+ "`port-position' support");
+ c_result = scm_to_int (result);
+ if (offset == 0)
+ /* We just want to know the current position. */
+ break;
+
+ offset += c_result;
/* Fall through. */
}
result = scm_call_1 (set_position_proc, scm_from_int (offset));
else
scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
- "R6RS custom binary port does not "
- "support `set-port-position!'");
+ "seekable R6RS custom binary port");
/* Assuming setting the position succeeded. */
c_result = offset;
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)
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. */
- unsigned c_octets;
+ int buffered;
+ size_t c_octets, c_requested;
SCM bv, read_proc, octets;
- /* Use the bytevector associated with PORT as the buffer passed to the
- `read!' procedure, thereby avoiding additional allocations. */
- bv = SCM_CBIP_BYTEVECTOR (port);
+ c_requested = c_port->read_buf_size;
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));
+ c_port->read_pos = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (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_I_MAKINUM (CBIP_BUFFER_SIZE));
- c_octets = scm_to_uint (octets);
+ scm_from_size_t (c_requested));
+ c_octets = scm_to_size_t (octets);
+ if (SCM_UNLIKELY (c_octets > c_requested))
+ scm_out_of_range (FUNC_NAME, octets);
+
+ 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_pos = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
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;
}
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);
}
HCoop / bpt / guile.git / blobdiff