Improves performance of write-u8vector by copying the vector in one chunk instead of writing it out character by character. I added range checks too which seems like the right thing to do and is required if either "from" or "to" are specified since that uses subu8vector now which will fail if "from" or "to" is out-of-range. (Letting just subu8vector do the range checks gives misleading error messages even though it is redundant.) However, this will cause old code that passed in invalid values to trigger an error now instead of just writing nothing as is the current behavior. I added tests for write-u8vector as well.
16MB test case, new: 0.06s CPU time, 0.04s GC time (major), 25/2 mutations (total/tracked), 3/4 GCs (major/minor) old (4.9.0.1): 0.63s CPU time, 0.01s GC time (major), 25 mutations, 3/4886 GCs (major/minor) Thanks and all the best, Thomas Hintz
From 018f2683b06a801b86ff7c5a54c153d3557992d4 Mon Sep 17 00:00:00 2001 From: Thomas Hintz <t...@thintz.com> Date: Mon, 20 Oct 2014 17:13:45 -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..b0fe6a6 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))) + (when from (check-range from 0 (or (fx+ to 1) len) '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
