mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Optimize 'get-bytevector-some'; it may now read less than possible.

Browse source 
* 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.
This commit is contained in:
Mark H Weaver 2013-03-31 21:21:14 -04:00
parent 337edc591f
commit 21bbe22a14
3 changed files with 30 additions and 83 deletions
Download patch file Download diff file Expand all files Collapse all files

7
doc/ref/api-io.texi
View file

@ -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

78
libguile/r6rs-ports.c
View file

@ -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;
if (pt->rw_active == SCM_PORT_WRITE)
scm_ptobs[SCM_PTOBNUM (port)].flush (port);
do
if (pt->rw_random)
pt->rw_active = SCM_PORT_READ;
if (pt->read_pos >= pt->read_end)
{
int c_chr;
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 (scm_fill_input (port) == EOF)
return SCM_EOF_VAL;
}
/* 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)));
size = pt->read_end - pt->read_pos;
if (pt->read_buf == pt->putback_buf)
size += pt->saved_read_end - pt->saved_read_pos;
if (c_total == 0)
{
result = SCM_EOF_VAL;
scm_gc_free (c_bv, c_len, SCM_GC_BYTEVECTOR);
}
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;
}
bv = scm_c_make_bytevector (size);
scm_take_from_input_buffers
(port, (char *) SCM_BYTEVECTOR_CONTENTS (bv), size);
result = scm_c_take_gc_bytevector ((signed char *) c_bv, c_len);
}
return result;
return bv;
}
#undef FUNC_NAME

24
test-suite/tests/r6rs-ports.test
View file

@ -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)