From 21bbe22a14a75fab54a5a8563fad63851a18fee3 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 31 Mar 2013 21:21:14 -0400 Subject: [PATCH] Optimize 'get-bytevector-some'; it may now read less than possible. * libguile/r6rs-ports.c (scm_get_bytevector_some): Rewrite to efficiently take the contents of the read/putback buffers. In the docstring, clarify that it might not return all available bytes. * doc/ref/api-io.texi (R6RS Binary Input): Clarify that 'get-bytevector-some' might not return all available bytes. * test-suite/tests/r6rs-ports.test ("get-bytevector-some [only-some]"): Remove bogus test, which requires more than the R6RS requires. --- doc/ref/api-io.texi | 7 +-- libguile/r6rs-ports.c | 78 ++++++++++---------------------- test-suite/tests/r6rs-ports.test | 24 ---------- 3 files changed, 28 insertions(+), 81 deletions(-) diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi index 11ae5803a..8c974be5f 100644 --- a/doc/ref/api-io.texi +++ b/doc/ref/api-io.texi @@ -1833,9 +1833,10 @@ actually read or the end-of-file object. @deffn {Scheme Procedure} get-bytevector-some port @deffnx {C Function} scm_get_bytevector_some (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. @end deffn @deffn {Scheme Procedure} get-bytevector-all port diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c index 7ee7a69f0..48f9f268b 100644 --- a/libguile/r6rs-ports.c +++ b/libguile/r6rs-ports.c @@ -550,71 +550,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; - - do - { - int c_chr; + if (pt->rw_active == SCM_PORT_WRITE) + scm_ptobs[SCM_PTOBNUM (port)].flush (port); - 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; - } + if (pt->rw_random) + pt->rw_active = SCM_PORT_READ; - /* We can't use `scm_c_read ()' since it blocks. */ - c_chr = scm_get_byte_or_eof (port); - if (c_chr != EOF) - { - c_bv[c_total] = (char) c_chr; - c_total++; - } - else - break; - } - /* XXX: We want to check for the availability of a byte, but that's - what `scm_char_ready_p' actually does. */ - while (scm_is_true (scm_char_ready_p (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 (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); - } + 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 diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test index ed4959826..2db2c5609 100644 --- a/test-suite/tests/r6rs-ports.test +++ b/test-suite/tests/r6rs-ports.test @@ -163,30 +163,6 @@ (equal? (bytevector->u8-list bv) (map char->integer (string->list str)))))) - (pass-if "get-bytevector-some [only-some]" - (let* ((str "GNU Guile") - (index 0) - (port (make-soft-port - (vector #f #f #f - (lambda () - (if (>= index (string-length str)) - (eof-object) - (let ((c (string-ref str index))) - (set! index (+ index 1)) - c))) - (lambda () #t) - (lambda () - ;; Number of readily available octets: falls to - ;; zero after 4 octets have been read. - (- 4 (modulo index 5)))) - "r")) - (bv (get-bytevector-some port))) - (and (bytevector? bv) - (= index 4) - (= (bytevector-length bv) index) - (equal? (bytevector->u8-list bv) - (map char->integer (string->list "GNU ")))))) - (pass-if "get-bytevector-all" (let* ((str "GNU Guile") (index 0) -- 2.20.1