From c9bc4ffee20c34337db7a9c50e411e5e11d3eac8 Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Thu, 25 Jun 2015 20:03:49 +0200
Subject: [PATCH] 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.
---
 NEWS                    |  2 ++
 manual/Acknowledgements | 22 +++++++++++-----------
 srfi-4.scm              | 42 +++++++++---------------------------------
 tests/srfi-4-tests.scm  | 14 ++++++++++++++
 4 files changed, 36 insertions(+), 44 deletions(-)

diff --git a/NEWS b/NEWS
index 0d72b4f..9780dec 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 c8c4f09..603ba30 100644
--- a/manual/Acknowledgements
+++ b/manual/Acknowledgements
@@ -4,17 +4,17 @@
 
 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
-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,
-Adhi Hargo, Moritz Heidkamp, Tollef Fog Heen, Drew Hess, Alejandro
-Forero Cuervo, Peter Danenberg, Linh Dang, Brian Denheyer, Sean
-D'Epagnier, "dgym", "Don", Chris Double, "Brown Dragon", David
+Beckford, Arto Bendiken, Andy Bennett, 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 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, Adhi Hargo, Moritz Heidkamp, Tollef Fog Heen, Drew Hess,
+Alejandro Forero Cuervo, Peter Danenberg, Linh Dang, Brian Denheyer,
+Sean D'Epagnier, "dgym", "Don", Chris Double, "Brown Dragon", David
 Dreisigmeyer, Jarod Eells, Petter Egesund, Stephen Eilert, Steve
 Elkins, Daniel B. Faken, Erik Falor, Will Farr, Graham Fawcett, Marc
 Feeley, "Fizzie", Matthew Flatt, Kimura Fuyuki, Tony Garnock-Jones,
diff --git a/srfi-4.scm b/srfi-4.scm
index 369bdce..0e4a834 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 37432a8..e4271f6 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
-- 
2.1.4