X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/74bbb99457c661a98fbdde0c0504da1b3a053fc3..0dbc5e571aa3bdb73fd0b9b1631e502167c4325a:/libguile/r6rs-ports.c diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c index 60ba38caa..db0b3f6c3 100644 --- a/libguile/r6rs-ports.c +++ b/libguile/r6rs-ports.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2009, 2010, 2011 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 @@ -37,6 +37,7 @@ #include "libguile/validate.h" #include "libguile/values.h" #include "libguile/vectors.h" +#include "libguile/ports-internal.h" @@ -216,10 +217,14 @@ cbp_seek (SCM port, scm_t_off offset, int whence) 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. */ } @@ -232,8 +237,7 @@ cbp_seek (SCM port, scm_t_off offset, int whence) 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; @@ -269,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) @@ -327,34 +372,58 @@ 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. */ - 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; } @@ -403,6 +472,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); } @@ -480,16 +550,11 @@ SCM_DEFINE (scm_get_bytevector_n, "get-bytevector-n", 2, 0, 0, /* Don't invoke `scm_c_read ()' since it may block. */ c_read = 0; - if ((c_read == 0) && (c_count > 0)) + if (c_read < c_count) { - if (SCM_EOF_OBJECT_P (scm_peek_char (port))) - result = SCM_EOF_VAL; + if (c_read == 0) + result = SCM_EOF_VAL; else - result = scm_null_bytevector; - } - else - { - if (c_read < c_count) result = scm_c_shrink_bytevector (result, c_read); } @@ -527,13 +592,8 @@ SCM_DEFINE (scm_get_bytevector_n_x, "get-bytevector-n!", 4, 0, 0, /* Don't invoke `scm_c_read ()' since it may block. */ c_read = 0; - if ((c_read == 0) && (c_count > 0)) - { - if (SCM_EOF_OBJECT_P (scm_peek_char (port))) - result = SCM_EOF_VAL; - else - result = SCM_I_MAKINUM (0); - } + if (c_read == 0 && c_count > 0) + result = SCM_EOF_VAL; else result = scm_from_size_t (c_read); @@ -544,69 +604,41 @@ SCM_DEFINE (scm_get_bytevector_n_x, "get-bytevector-n!", 4, 0, 0, SCM_DEFINE (scm_get_bytevector_some, "get-bytevector-some", 1, 0, 0, (SCM port), - "Read from @var{port}, blocking as necessary, until data " - "are available or and end-of-file is reached. Return either " - "a new bytevector containing the data read or the " - "end-of-file object.") + "Read from @var{port}, blocking as necessary, until bytes " + "are available or an end-of-file is reached. Return either " + "the end-of-file object or a new bytevector containing some " + "of the available bytes (at least one), and update the port " + "position to point just past these bytes.") #define FUNC_NAME s_scm_get_bytevector_some { - /* Read at least one byte, unless the end-of-file is already reached, and - read while characters are available (buffered). */ - - SCM result; - char *c_bv; - unsigned c_len; - size_t c_total; + scm_t_port *pt; + size_t size; + SCM bv; SCM_VALIDATE_BINARY_INPUT_PORT (1, port); + pt = SCM_PTAB_ENTRY (port); - c_len = 4096; - c_bv = (char *) scm_gc_malloc_pointerless (c_len, SCM_GC_BYTEVECTOR); - c_total = 0; + if (pt->rw_active == SCM_PORT_WRITE) + scm_flush_unlocked (port); - do - { - int c_chr; + if (pt->rw_random) + pt->rw_active = SCM_PORT_READ; - if (c_total + 1 > c_len) - { - /* Grow the bytevector. */ - c_bv = (char *) scm_gc_realloc (c_bv, c_len, c_len * 2, - SCM_GC_BYTEVECTOR); - c_len *= 2; - } - - /* We can't use `scm_c_read ()' since it blocks. */ - c_chr = scm_getc_unlocked (port); - if (c_chr != EOF) - { - c_bv[c_total] = (char) c_chr; - c_total++; - } - } - while ((scm_is_true (scm_char_ready_p (port))) - && (!SCM_EOF_OBJECT_P (scm_peek_char (port)))); - - if (c_total == 0) + if (pt->read_pos >= pt->read_end) { - result = SCM_EOF_VAL; - scm_gc_free (c_bv, c_len, SCM_GC_BYTEVECTOR); + if (scm_fill_input_unlocked (port) == EOF) + return SCM_EOF_VAL; } - else - { - if (c_len > c_total) - { - /* Shrink the bytevector. */ - c_bv = (char *) scm_gc_realloc (c_bv, c_len, c_total, - SCM_GC_BYTEVECTOR); - c_len = (unsigned) c_total; - } - result = scm_c_take_gc_bytevector ((signed char *) c_bv, c_len, - SCM_BOOL_F); - } + size = pt->read_end - pt->read_pos; + if (pt->read_buf == pt->putback_buf) + size += pt->saved_read_end - pt->saved_read_pos; - return result; + bv = scm_c_make_bytevector (size); + scm_take_from_input_buffers + (port, (char *) SCM_BYTEVECTOR_CONTENTS (bv), size); + + return bv; } #undef FUNC_NAME @@ -645,7 +677,7 @@ SCM_DEFINE (scm_get_bytevector_all, "get-bytevector-all", 1, 0, 0, c_read = scm_c_read_unlocked (port, c_bv + c_total, c_count); c_total += c_read, c_count -= c_read; } - while (!SCM_EOF_OBJECT_P (scm_peek_char (port))); + while (c_count == 0); if (c_total == 0) { @@ -737,6 +769,49 @@ SCM_DEFINE (scm_put_bytevector, "put-bytevector", 2, 2, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_unget_bytevector, "unget-bytevector", 2, 2, 0, + (SCM port, SCM bv, SCM start, SCM count), + "Unget the contents of @var{bv} to @var{port}, optionally " + "starting at index @var{start} and limiting to @var{count} " + "octets.") +#define FUNC_NAME s_scm_unget_bytevector +{ + unsigned char *c_bv; + size_t c_start, c_count, c_len; + + SCM_VALIDATE_BINARY_INPUT_PORT (1, port); + SCM_VALIDATE_BYTEVECTOR (2, bv); + + c_len = SCM_BYTEVECTOR_LENGTH (bv); + c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv); + + if (!scm_is_eq (start, SCM_UNDEFINED)) + { + c_start = scm_to_size_t (start); + + if (!scm_is_eq (count, SCM_UNDEFINED)) + { + c_count = scm_to_size_t (count); + if (SCM_UNLIKELY (c_start + c_count > c_len)) + scm_out_of_range (FUNC_NAME, count); + } + else + { + if (SCM_UNLIKELY (c_start >= c_len)) + scm_out_of_range (FUNC_NAME, start); + else + c_count = c_len - c_start; + } + } + else + c_start = 0, c_count = c_len; + + scm_unget_bytes (c_bv + c_start, c_count, port); + + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + /* Bytevector output port ("bop" for short). */ @@ -1176,6 +1251,8 @@ initialize_transcoded_ports (void) scm_set_port_close (transcoded_port_type, tp_close); } +SCM_INTERNAL SCM scm_i_make_transcoded_port (SCM); + SCM_DEFINE (scm_i_make_transcoded_port, "%make-transcoded-port", 1, 0, 0, (SCM port),