~ chicken-core (chicken-5) e0514dd8ee634e2625ab6b268f89a17791ef3ba1

commit e0514dd8ee634e2625ab6b268f89a17791ef3ba1
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Thu Jun 25 20:03:49 2015 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Thu Jun 25 20:03:49 2015 +0200

    Improve read-u8vector performance
    
    This also adds a few basic test cases for read-u8vector and makes the
    implicit depency of the srfi-4 unit on the extras unit explicit.
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/NEWS b/NEWS
index 0d72b4fb..9780decc 100644
--- a/NEWS
+++ b/NEWS
@@ -53,6 +53,8 @@
 
 - Unit srfi-4:
    - write-u8vector has been made more efficient (thanks to Thomas Hintz).
+   - read-u8vector has been made more efficient (thanks to Andy Bennett
+      for pointing this out and testing an improvement).
 
 - Unit lolevel:
   - Restore long-lost but still documented "vector-like?" procedure (#983)
diff --git a/manual/Acknowledgements b/manual/Acknowledgements
index 71972210..87ad40f0 100644
--- a/manual/Acknowledgements
+++ b/manual/Acknowledgements
@@ -4,11 +4,11 @@
 
 Many thanks to Jules Altfas, Nico Amtsberg, Alonso Andres, William
 Annis, Jason E. Aten, Marc Baily, Peter Barabas, Andrei Barbu, Jonah
-Beckford, Arto Bendiken, Kevin Beranek, Peter Bex, Jean-Francois
-Bignolles, Oivind Binde, Alaric Blagrave-Snellpym, Dave Bodenstab,
-Fabian Böhlke, T. Kurt Bond, Ashley Bone, Dominique Boucher, Terence
-Brannon, Roy Bryant, Adam Buchbinder, Hans Bulfone, "Category 5",
-Taylor Campbell, Naruto Canada, Mark Carter, Esteban U. Caamano
+Beckford, Arto Bendiken, Andy Bennett, Kevin Beranek, Peter Bex,
+Jean-Francois Bignolles, Oivind Binde, Alaric Blagrave Snell-Pym, Dave
+Bodenstab, Fabian Böhlke, T. Kurt Bond, Ashley Bone, Dominique Boucher,
+Terence Brannon, Roy Bryant, Adam Buchbinder, Hans Bulfone, "Category
+5", Taylor Campbell, Naruto Canada, Mark Carter, Esteban U. Caamano
 Castro, Semih Cemiloglu, Alex Charlton, Franklin Chen, Joo ChurlSoo,
 Thomas Chust, Gian Paolo Ciceri, Fulvio Ciriaco, Paul Colby, Tobia
 Conforto, John Cowan, Grzegorz Chrupala, James Crippen, Evan Hanson,
diff --git a/srfi-4.scm b/srfi-4.scm
index 369bdcef..0e4a8346 100644
--- a/srfi-4.scm
+++ b/srfi-4.scm
@@ -26,10 +26,11 @@
 
 
 (declare
- (unit srfi-4)
- (disable-interrupts)
- (not inline ##sys#user-print-hook ##sys#number-hash-hook)
- (foreign-declare #<<EOF
+  (unit srfi-4)
+  (uses extras)
+  (disable-interrupts)
+  (not inline ##sys#user-print-hook ##sys#number-hash-hook)
+  (foreign-declare #<<EOF
 #define C_copy_subvector(to, from, start_to, start_from, bytes)   \
   (C_memcpy((C_char *)C_data_pointer(to) + C_unfix(start_to), (C_char *)C_data_pointer(from) + C_unfix(start_from), C_unfix(bytes)), \
     C_SCHEME_UNDEFINED)
@@ -758,34 +759,9 @@ EOF
       (set! n (fx- size start)))
     (##sys#read-string! n dest port start)))
 
-(define read-u8vector
-  (let ()
-    (define (wrap str n)
-      (##sys#make-structure
-       'u8vector
-       (let ((str2 (##sys#allocate-vector n #t #f #t)))
-	 (##core#inline "C_string_to_bytevector" str2)
-	 (##core#inline "C_substring_copy" str str2 0 n 0)
-	 str2) ) )
-    (lambda (#!optional n (p ##sys#standard-input))
-      (##sys#check-input-port p #t 'read-u8vector)
-      (cond (n (##sys#check-fixnum n 'read-u8vector)
-	       (let* ((str (##sys#allocate-vector n #t #f #t))
-		      (n2 (##sys#read-string! n str p 0)) )
-		 (##core#inline "C_string_to_bytevector" str)
-		 (if (eq? n n2)
-		     (##sys#make-structure 'u8vector str)
-		     (wrap str n2) ) ) )
-	    (else
-	     (let ([str (open-output-string)])
-	       (let loop ()
-		 (let ([c (##sys#read-char-0 p)])
-		   (if (eof-object? c)
-		       (let* ((s (get-output-string str))
-			      (n (##sys#size s)) )
-			 (wrap s n) )
-		       (begin
-			 (##sys#write-char/port c str)
-			 (loop)))))))))))
+(define (read-u8vector #!optional n (p ##sys#standard-input))
+  (let ((str (##sys#read-string/port n p)))
+    (##core#inline "C_string_to_bytevector" str)
+    (##sys#make-structure 'u8vector str)))
 
 (register-feature! 'srfi-4)
diff --git a/tests/srfi-4-tests.scm b/tests/srfi-4-tests.scm
index 37432a86..610700dd 100644
--- a/tests/srfi-4-tests.scm
+++ b/tests/srfi-4-tests.scm
@@ -81,6 +81,20 @@
   (assert (= 6  (read-u8vector! 10 u8vec input)))
   (assert (equal? u8vec #u8(117 118 119 120 121 122 108 109 110 111))))
 
+(let ((input (open-input-string "abcdefghijklmnopqrs")))
+  (assert (equal? (read-u8vector 5 input)
+		  #u8(97 98 99 100 101)))
+  (assert (equal? (read-u8vector 5 input) #u8(102 103 104 105 106)))
+  (assert (equal? (read-u8vector #f input)
+		  #u8(107 108 109 110 111 112 113 114 115)))
+  (with-input-from-string "abcdefghijklmnopqrs"
+   (lambda ()
+     (assert (equal? (read-u8vector 5)
+		     #u8(97 98 99 100 101)))
+     (assert (equal? (read-u8vector 5) #u8(102 103 104 105 106)))
+     (assert (equal? (read-u8vector)
+		     #u8(107 108 109 110 111 112 113 114 115))))))
+
 (assert (string=?
 	 "abc"
 	 (with-output-to-string