On Tue, Oct 21, 2014 at 10:40:29AM -0700, Thomas Hintz wrote:
> 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.
Thanks for getting back to us on that. I probably wouldn't have noticed
the mistake in the original patch... :S
Also, thanks for the improving this part of the core's performance! With
this, websockets will really fly ;)
Here's a signed off patch, so another core member may push it.
Cheers,
Peter
--
http://www.more-magic.net
>From 45e4f87d35c4a7b2e779feade9d1da2d326876e0 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.
Signed-off-by: Peter Bex <peter....@xs4all.nl>
---
NEWS | 3 +++
srfi-4.scm | 18 +++++++++++-------
tests/srfi-4-tests.scm | 32 +++++++++++++++++++++++++++++++-
3 files changed, 45 insertions(+), 8 deletions(-)
diff --git a/NEWS b/NEWS
index 6fa2a4b..ba7f3b7 100644
--- a/NEWS
+++ b/NEWS
@@ -23,6 +23,9 @@
- normalize-pathname has been simplified to avoid adding trailing
slashes or dots (#1153, thanks to Michele La Monaca and Mario Goulart).
+- Unit srfi-4:
+ - write-u8vector has been made more efficient (thanks to Thomas Hintz).
+
- Unit lolevel:
- Restore long-lost but still documented "vector-like?" procedure (#983)
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())))))
--
1.7.10.4
_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
