X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/df655031011719067e2b6819572a262028bb4858..b958141cdb081ceb16ca5828abda71f772fe0c57:/libguile/r6rs-ports.c diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c index 60ba38caa..fc676895d 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 @@ -216,10 +216,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 +236,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; @@ -480,16 +483,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 +525,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 +537,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 +610,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 +702,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 +1184,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),