~ chicken-core (master) de586f1eb5355db9f15eb042aeb713249bc91103

commit de586f1eb5355db9f15eb042aeb713249bc91103
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Sun Aug 16 21:16:06 2026 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sun Aug 16 21:16:06 2026 +0200

    correct uses of read-bytevector port-method, provide fallback implementation for custom input ports

diff --git a/port.scm b/port.scm
index 34dd6024..902e5ca1 100644
--- a/port.scm
+++ b/port.scm
@@ -287,8 +287,8 @@ char *ttyname(int fd) {
 		      (loop) )
 		     (else c))))))
      read-bytevector:
-     (lambda (p n dest start)
-       (let loop ((n n) (c 0) (p start))
+     (lambda (dest start end)
+       (let loop ((n (fx- end start)) (c 0) (p start))
 	 (cond ((null? ports) c)
 	       ((fx<= n 0) c)
 	       (else
@@ -354,7 +354,12 @@ char *ttyname(int fd) {
 (define make-input-port
   (lambda (read ready? close #!rest r
                 #!key peek-char read-bytevector read-line read-buffered)
-    ;XXX this is for ensuring old-style calls fail and can be removed at some stage
+    (define (insert dest start c)
+      (let* ((bv (##sys#make-bytevector 4))
+             (m (##core#inline "C_utf_insert" bv 0 c)))
+        (##core#inline "C_copy_memory_with_offset" dest bv 0 start m)
+        m))
+   ;XXX this is for ensuring old-style calls fail and can be removed at some stage
     (when (and (pair? r) (not (##core#inline "C_i_keywordp" (car r))))
       (error 'make-input-port "invalid invocation - use keyword parameters" r))
     (let* ((class
@@ -381,9 +386,32 @@ char *ttyname(int fd) {
 	     #f				; flush-output
 	     (lambda (p)		; char-ready?
 	       (ready?) )
-	     (or read-bytevector	; read-bytevector!
+	     (if read-bytevector	; read-bytevector!
+                 (lambda (p n dest start)
+                  (let ((last (and (not peek-char) (##sys#slot p 10)))
+                        (m 0))
+                    (when last
+                      (set! m (insert dest start last))
+                      (##sys#setislot p 10 #f)
+                      (set! start (fx+ start m))
+                      (set! n (and n (fx- n m))))
+                    (if (and n (fx<= n m))
+                        m
+                        (fx+ m (read-bytevector dest start (and n (fx+ start n)))))))
 	         (lambda (p n dest start)
-	           (error "binary I/O not supported for custom text input port without bytevector-read method" p)))
+	           (let loop ((n n) (c 0))
+                     (cond ((eq? n 0) c)
+                           ((and (not peek-char) (##sys#slot p 10)) =>
+                             (lambda (last)
+                               (let ((m (insert dest start last)))
+                                 (##sys#setislot p 10 #f)
+                                 (loop (and n (fx- n m)) (fx+ c m)))))
+                          (else
+                            (let ((x (read)))
+                              (if (eof-object? x) 
+                                  c
+                                  (let ((m (insert dest start x)))
+                                    (loop (and n (fx- n m)) (fx+ c m))))))))))
 	     read-line			; read-line
 	     read-buffered))
 	   (data (vector #f))
diff --git a/posixunix.scm b/posixunix.scm
index a155455f..b76b8808 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -863,16 +863,15 @@ static int set_file_mtime(C_word filename, C_word atime, C_word mtime)
 		       (fetch))
 		     (peek) )
                    read-bytevector:
-		   (lambda (port n dest start) ; read-bytevector!
-		     (let loop ([n (or n (fx- (##sys#size dest) start))]
+		   (lambda (dest start end) ; read-bytevector!
+		     (let loop ([n (fx- end start)]
                                 [m 0]
                                 [start start])
 		       (cond [(eq? 0 n) m]
 			     [(fx< bufpos buflen)
 			      (let* ([rest (fx- buflen bufpos)]
 				     [n2 (if (fx< n rest) n rest)])
-				(##core#inline "C_copy_memory_with_offset"
-                                  dest buf start bufpos n2)
+				(##core#inline "C_copy_memory_with_offset" dest buf start bufpos n2)
 				(set! bufpos (fx+ bufpos n2))
 				(loop (fx- n n2) (fx+ m n2) (fx+ start n2)) ) ]
 			     [else
diff --git a/tcp.scm b/tcp.scm
index a20539b0..91bfed1c 100644
--- a/tcp.scm
+++ b/tcp.scm
@@ -436,14 +436,13 @@ EOF
                        (lambda (buf start n)
                          (##core#inline "C_utf_decode" buf start)))))
                read-bytevector:
-	       (lambda (p n dest start)	; read-bytevector!
-		 (let loop ((n n) (m 0) (start start))
+	       (lambda (dest start end)	; read-bytevector!
+		 (let loop ((n (fx- end start)) (m 0) (start start))
 		   (cond ((eq? n 0) m)
 			 ((fx< bufindex buflen)
 			  (let* ((rest (fx- buflen bufindex))
 				 (n2 (if (fx< n rest) n rest)))
-			    (##core#inline "C_copy_memory_with_offset" dest buf start 
-                              bufindex n2)
+			    (##core#inline "C_copy_memory_with_offset" dest buf start bufindex n2)
 			    (set! bufindex (fx+ bufindex n2))
 			    (loop (fx- n n2) (fx+ m n2) (fx+ start n2)) ) )
 			 (else