~ chicken-core (chicken-5) df85f4fcbe8803afc3af3fbadc9c06d0a80f88a2

commit df85f4fcbe8803afc3af3fbadc9c06d0a80f88a2
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Thu Jun 25 20:03:49 2015 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Mon Jul 13 22:35:37 2015 +1200

    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 47e82ef9..00a26ed8 100644
--- a/NEWS
+++ b/NEWS
@@ -29,6 +29,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 107a9444..e10cd087 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 dfa8150b..83f86203 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)
@@ -664,34 +665,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-exact 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 8b781403..9daaa78e 100644
--- a/tests/srfi-4-tests.scm
+++ b/tests/srfi-4-tests.scm
@@ -55,6 +55,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