mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-02 15:40:38 +02:00
Code Activity

Move bytevector input ports implementation to Scheme

Browse source 
* module/ice-9/binary-ports.scm (open-bytevector-input-port): New
implementation.
* libguile/r6rs-ports.c (scm_open_bytevector_input_port): Proxy to
Scheme.
This commit is contained in:
Andy Wingo 2025-06-18 10:37:42 +02:00
parent 2fc5ff5264
commit 2a015937ca
2 changed files with 55 additions and 134 deletions
Download patch file Download diff file Expand all files Collapse all files

146
libguile/r6rs-ports.c
View file

@ -55,22 +55,6 @@ SCM_SYMBOL (sym_ISO_8859_1, "ISO-8859-1");
SCM_SYMBOL (sym_error, "error");
/* Unimplemented features. */
/* Transoders are currently not implemented since Guile 1.8 is not
Unicode-capable. Thus, most of the code here assumes the use of the
binary transcoder. */
static inline void
transcoders_not_implemented (void)
{
fprintf (stderr, "%s: warning: transcoders not implemented\n",
PACKAGE_NAME);
}
/* End-of-file object. */
@ -85,118 +69,6 @@ SCM_DEFINE (scm_eof_object, "eof-object", 0, 0, 0,
#undef FUNC_NAME
/* Input ports. */
#define MAX(A, B) ((A) >= (B) ? (A) : (B))
#define MIN(A, B) ((A) < (B) ? (A) : (B))
/* Bytevector input ports. */
static scm_t_port_type *bytevector_input_port_type = 0;
struct bytevector_input_port {
SCM bytevector;
size_t pos;
};
static inline SCM
make_bytevector_input_port (SCM bv)
{
const unsigned long mode_bits = SCM_RDNG;
struct bytevector_input_port *stream;
stream = scm_gc_typed_calloc (struct bytevector_input_port);
stream->bytevector = bv;
stream->pos = 0;
return scm_c_make_port_with_encoding (bytevector_input_port_type, mode_bits,
sym_ISO_8859_1, sym_error,
(scm_t_bits) stream);
}
static size_t
bytevector_input_port_read (SCM port, SCM dst, size_t start, size_t count)
{
size_t remaining;
struct bytevector_input_port *stream = (void *) SCM_STREAM (port);
if (stream->pos >= SCM_BYTEVECTOR_LENGTH (stream->bytevector))
return 0;
remaining = SCM_BYTEVECTOR_LENGTH (stream->bytevector) - stream->pos;
if (remaining < count)
count = remaining;
memcpy (SCM_BYTEVECTOR_CONTENTS (dst) + start,
SCM_BYTEVECTOR_CONTENTS (stream->bytevector) + stream->pos,
count);
stream->pos += count;
return count;
}
static scm_t_off
bytevector_input_port_seek (SCM port, scm_t_off offset, int whence)
#define FUNC_NAME "bytevector_input_port_seek"
{
struct bytevector_input_port *stream = (void *) SCM_STREAM (port);
size_t base;
scm_t_off target;
if (whence == SEEK_CUR)
base = stream->pos;
else if (whence == SEEK_SET)
base = 0;
else if (whence == SEEK_END)
base = SCM_BYTEVECTOR_LENGTH (stream->bytevector);
else
scm_wrong_type_arg_msg (FUNC_NAME, 0, port, "invalid `seek' parameter");
if (base > SCM_T_OFF_MAX
|| INT_ADD_OVERFLOW ((scm_t_off) base, offset))
scm_num_overflow (FUNC_NAME);
target = (scm_t_off) base + offset;
if (target >= 0 && target <= SCM_BYTEVECTOR_LENGTH (stream->bytevector))
stream->pos = target;
else
scm_out_of_range (FUNC_NAME, scm_from_off_t (offset));
return target;
}
#undef FUNC_NAME
/* Instantiate the bytevector input port type. */
static inline void
initialize_bytevector_input_ports (void)
{
bytevector_input_port_type =
scm_make_port_type ("r6rs-bytevector-input-port",
bytevector_input_port_read,
NULL);
scm_set_port_seek (bytevector_input_port_type, bytevector_input_port_seek);
}
SCM_DEFINE (scm_open_bytevector_input_port,
"open-bytevector-input-port", 1, 1, 0,
(SCM bv, SCM transcoder),
"Return an input port whose contents are drawn from "
"bytevector @var{bv}.")
#define FUNC_NAME s_scm_open_bytevector_input_port
{
SCM_VALIDATE_BYTEVECTOR (1, bv);
if (!SCM_UNBNDP (transcoder) && !scm_is_false (transcoder))
transcoders_not_implemented ();
return make_bytevector_input_port (bv);
}
#undef FUNC_NAME
/* Binary input. */
@ -351,6 +223,8 @@ SCM_DEFINE (scm_get_bytevector_some, "get-bytevector-some", 1, 0, 0,
}
#undef FUNC_NAME
#define MIN(A, B) ((A) < (B) ? (A) : (B))
SCM_DEFINE (scm_get_bytevector_some_x, "get-bytevector-some!", 4, 0, 0,
(SCM port, SCM bv, SCM start, SCM count),
"Read up to @var{count} bytes from @var{port}, blocking "
@ -518,18 +392,31 @@ SCM_DEFINE (scm_unget_bytevector, "unget-bytevector", 2, 2, 0,
/* Bytevector output port. */
/* Bytevector input and output ports. */
static SCM open_bytevector_input_port_var;
static SCM open_bytevector_output_port_var;
static scm_i_pthread_once_t bytevector_port_vars = SCM_I_PTHREAD_ONCE_INIT;
static void
init_bytevector_port_vars (void)
{
open_bytevector_input_port_var =
scm_c_public_lookup ("ice-9 binary-ports", "open-bytevector-input-port");
open_bytevector_output_port_var =
scm_c_public_lookup ("ice-9 binary-ports", "open-bytevector-output-port");
}
SCM
scm_open_bytevector_input_port (SCM bv, SCM transcoder)
{
scm_i_pthread_once (&bytevector_port_vars, init_bytevector_port_vars);
return SCM_UNBNDP (transcoder)
? scm_call_1 (scm_variable_ref (open_bytevector_input_port_var), bv)
: scm_call_2 (scm_variable_ref (open_bytevector_input_port_var), bv,
transcoder);
}
SCM
scm_open_bytevector_output_port (SCM transcoder)
{
@ -724,7 +611,6 @@ scm_register_r6rs_ports (void)
(scm_t_extension_init_func) scm_init_r6rs_ports,
NULL);
initialize_bytevector_input_ports ();
initialize_transcoded_ports ();
}