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

@@ -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
+Read from @var{port}, blocking as necessary, until bytes are available
-and end-of-file is reached.  Return either a new bytevector containing
+or an end-of-file is reached.  Return either the end-of-file object or a
-the data read or the end-of-file object.
+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

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 "
+            "Read from @var{port}, blocking as necessary, until bytes "
-	    "are available or and end-of-file is reached.  Return either "
+            "are available or an end-of-file is reached.  Return either "
-	    "a new bytevector containing the data read or the "
+            "the end-of-file object or a new bytevector containing some "
-	    "end-of-file object.")
+            "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
+  scm_t_port *pt;
-     read while characters are available (buffered).  */
+  size_t size;
-
+  SCM bv;
-  SCM result;
-  char *c_bv;
-  unsigned c_len;
-  size_t c_total;
 
   SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
+  pt = SCM_PTAB_ENTRY (port);
 
-  c_len = 4096;
+  if (pt->rw_active == SCM_PORT_WRITE)
-  c_bv = (char *) scm_gc_malloc_pointerless (c_len, SCM_GC_BYTEVECTOR);
+    scm_ptobs[SCM_PTOBNUM (port)].flush (port);
-  c_total = 0;
 
-  do
+  if (pt->rw_random)
+    pt->rw_active = SCM_PORT_READ;
+
+  if (pt->read_pos >= pt->read_end)
     {
-      int c_chr;
+      if (scm_fill_input (port) == EOF)
-
+	return SCM_EOF_VAL;
-      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_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)
-    {
-      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;
-	}
-
-      result = scm_c_take_gc_bytevector ((signed char *) c_bv, c_len);
     }
 
-  return result;
+  size = pt->read_end - pt->read_pos;
+  if (pt->read_buf == pt->putback_buf)
+    size += pt->saved_read_end - pt->saved_read_pos;
+
+  bv = scm_c_make_bytevector (size);
+  scm_take_from_input_buffers
+    (port, (char *) SCM_BYTEVECTOR_CONTENTS (bv), size);
+
+  return bv;
 }
 #undef FUNC_NAME
 

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)