I think the original patch is wrong. check-range for "from" is passing in the wrong value for the "to" parameter to check-range. It can also be simplified since "from" will always be specified. Attached is an updated patch.
All the best, Thomas Hintz
From 003245422fb5a55c19f0590b2fa73f48d426139f Mon Sep 17 00:00:00 2001 From: Thomas Hintz <t...@thintz.com> Date: Tue, 21 Oct 2014 10:38:00 -0700 Subject: [PATCH] Improving performance of write-u8vector. --- srfi-4.scm | 18 +++++++++++------- tests/srfi-4-tests.scm | 32 +++++++++++++++++++++++++++++++- 2 files changed, 42 insertions(+), 8 deletions(-) diff --git a/srfi-4.scm b/srfi-4.scm index fffa8da..5cd346e 100644 --- a/srfi-4.scm +++ b/srfi-4.scm @@ -639,15 +639,19 @@ EOF (define (subf32vector v from to) (subnvector v 'f32vector 4 from to 'subf32vector)) (define (subf64vector v from to) (subnvector v 'f64vector 8 from to 'subf64vector)) -(define (write-u8vector v #!optional (port ##sys#standard-output) (from 0) - (to (u8vector-length v))) +(define (write-u8vector v #!optional (port ##sys#standard-output) (from 0) to) (##sys#check-structure v 'u8vector 'write-u8vector) (##sys#check-output-port port #t 'write-u8vector) - (do ((i from (fx+ i 1))) - ((fx>= i to)) - (##sys#write-char-0 - (integer->char (##core#inline "C_u_i_u8vector_ref" v i)) - port) ) ) + (let ((len (##core#inline "C_u_i_8vector_length" v))) + (check-range from 0 (fx+ (or to len) 1) 'write-u8vector) + (when to (check-range to from (fx+ len 1) 'write-u8vector)) + ; using (write-string) since the "data" slot of a u8vector is + ; represented the same as a string + ((##sys#slot (##sys#slot port 2) 3) ; write-string + port + (if (and (fx= from 0) (or (not to) (fx= to len))) + (##sys#slot v 1) + (##sys#slot (subu8vector v from (or to len)) 1))))) (define (read-u8vector! n dest #!optional (port ##sys#standard-input) (start 0)) (##sys#check-input-port port #t 'read-u8vector!) diff --git a/tests/srfi-4-tests.scm b/tests/srfi-4-tests.scm index 1d0a1b5..8b78140 100644 --- a/tests/srfi-4-tests.scm +++ b/tests/srfi-4-tests.scm @@ -1,7 +1,7 @@ ;;;; srfi-4-tests.scm -(use srfi-1 srfi-4) +(use srfi-1 srfi-4 ports) (define-syntax test1 @@ -54,3 +54,33 @@ (assert (equal? u8vec #u8(112 113 114 115 116 107 108 109 110 111))) (assert (= 6 (read-u8vector! 10 u8vec input))) (assert (equal? u8vec #u8(117 118 119 120 121 122 108 109 110 111)))) + +(assert (string=? + "abc" + (with-output-to-string + (lambda () + (write-u8vector #u8(97 98 99)))))) + +(assert (string=? + "bc" + (with-output-to-string + (lambda () + (write-u8vector #u8(97 98 99) (current-output-port) 1))))) + +(assert (string=? + "a" + (with-output-to-string + (lambda () + (write-u8vector #u8(97 98 99) (current-output-port) 0 1))))) + +(assert (string=? + "b" + (with-output-to-string + (lambda () + (write-u8vector #u8(97 98 99) (current-output-port) 1 2))))) + +(assert (string=? + "" + (with-output-to-string + (lambda () + (write-u8vector #u8()))))) -- 2.0.4
_______________________________________________ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers
