From d0e6dc755604526646dd6ba3b53021bf1ffff54c Mon Sep 17 00:00:00 2001 From: Vasilij Schneidermann Date: Sun, 17 Mar 2024 19:47:30 +0100 Subject: [PATCH] Avoid needless allocation in read-bytevector! This change switches the implementation strategy to basing read-bytevector on top of read-bytevector! rather than the other way around. --- lib/scheme/extras.scm | 33 +++++++++++++-------------------- 1 file changed, 13 insertions(+), 20 deletions(-) diff --git a/lib/scheme/extras.scm b/lib/scheme/extras.scm index 98b4f3c3f..b87ce3960 100644 --- a/lib/scheme/extras.scm +++ b/lib/scheme/extras.scm @@ -136,15 +136,8 @@ #u8() (let ((in (if (pair? o) (car o) (current-input-port))) (res (make-bytevector n))) - (let lp ((i 0)) - (if (>= i n) - res - (let ((x (read-u8 in))) - (cond ((eof-object? x) - (if (zero? i) x (subbytes res 0 i))) - (else - (bytevector-u8-set! res i x) - (lp (+ i 1)))))))))) + (read-bytevector! res in) + res))) (define (read-bytevector! vec . o) (let* ((in (if (pair? o) (car o) (current-input-port))) @@ -152,19 +145,19 @@ (start (if (pair? o) (car o) 0)) (end (if (and (pair? o) (pair? (cdr o))) (cadr o) - (bytevector-length vec)))) + (bytevector-length vec))) + (n (- end start))) (if (>= start end) 0 - (let ((res (read-bytevector (- end start) in))) - (cond - ((eof-object? res) - res) - (else - (let ((len (bytevector-length res))) - (do ((i 0 (+ i 1))) - ((>= i len) len) - (bytevector-u8-set! vec (+ i start) (bytevector-u8-ref res i)) - )))))))) + (let lp ((i 0)) + (if (>= i n) + i + (let ((x (read-u8 in))) + (cond ((eof-object? x) + (if (zero? i) x i)) + (else + (bytevector-u8-set! vec (+ i start) x) + (lp (+ i 1)))))))))) (define (write-bytevector vec . o) (let* ((out (if (pair? o) (car o) (current-output-port)))