~ chicken-core (master) d34bb82234711196d529f9c3557071bbed28aaee
commit d34bb82234711196d529f9c3557071bbed28aaee
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Sat Sep 5 23:11:04 2026 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Sat Sep 5 23:11:04 2026 +0200
distinguish between u8-ready? and char-ready? methods
extends port-class vector to an optional slot holding the char-ready? method.
char-ready? for bytevector-ports always returns #t, like for string-ports
diff --git a/library.scm b/library.scm
index 92a52916..a08477ed 100644
--- a/library.scm
+++ b/library.scm
@@ -1256,15 +1256,16 @@ EOF
(lambda (_ _) ; close
(##sys#setislot port 8 #t))
#f ; flush-output
- (lambda (_) ; char-ready?
- (not (eq? index bv-len)))
+ (lambda (_) #t) ; u8-ready?
(lambda (p n dest start) ; read-bytevector!
(let ((n2 (min n (##core#inline "C_fixnum_difference" bv-len index))))
(##core#inline "C_copy_memory_with_offset" dest bv start index n2)
(set! index (##core#inline "C_fixnum_plus" index n2))
n2))
#f ; read-line
- #f))) ; read-buffered
+ #f ; read-buffered
+ (lambda (_) #t) ; char-ready?
+ )))
port)))
(set! scheme#open-output-bytevector
@@ -1304,10 +1305,12 @@ EOF
(lambda (_ _) ; close
(##sys#setislot port 8 #t))
#f ; flush-output
- #f ; char-ready?
+ #f ; u8-ready?
#f ; read-bytevector!
#f ; read-line
- #f)) ; read-buffered
+ #f ; read-buffered
+ #f ; char-ready?
+ ))
port)))
(set! scheme#get-output-bytevector
@@ -4060,10 +4063,11 @@ EOF
; 3: (write-bytevector PORT BYTEVECTOR START END)
; 4: (close PORT DIRECTION)
; 5: (flush-output PORT)
-; 6: (char-ready? PORT) -> BOOL
+; 6: (u8-ready? PORT) -> BOOL
; 7: (read-bytevector! PORT COUNT BYTEVECTOR START) -> COUNT'
; 8: (read-line PORT LIMIT) -> STRING | EOF
; 9: (read-buffered PORT) -> STRING
+; [10: (char-ready? PORT) -> BOOL (optional)]
(define (##sys#make-port i/o class name type)
(let ((port (##core#inline_allocate ("C_a_i_port" 17))))
@@ -4087,6 +4091,9 @@ EOF
; 12: Static buffer for read-line, allocated on-demand
(define ##sys#stream-port-class
+ (define (u8-ready? p)
+ (or (##sys#slot p 10)
+ (##core#inline "C_char_ready_p" p) ))
(vector (lambda (p) ; read-char
(let loop ()
(let ((peeked (##sys#slot p 10)))
@@ -4141,8 +4148,7 @@ EOF
(##sys#update-errno) )
(lambda (p) ; flush-output
(##core#inline "C_flush_output" p) )
- (lambda (p) ; char-ready?
- (##core#inline "C_char_ready_p" p) )
+ u8-ready?
(lambda (p n dest start) ; read-bytevector!
(let ((pb (##sys#slot p 10))
(nc 0))
@@ -4226,6 +4232,7 @@ EOF
(##sys#setislot p 4 (fx+ (##sys#slot p 4) 1))
(##sys#buffer->string/encoding buffer 0 n (##sys#slot p 15))))))))
#f ; read-buffered
+ u8-ready? ; char-ready?
) )
(define ##sys#open-file-port (##core#primitive "C_open_file_port"))
@@ -5854,7 +5861,7 @@ EOF
(##sys#setislot p 10 (fx+ position len)) ) ) )
void ; close
(lambda (p) #f) ; flush-output
- (lambda (p) #t) ; char-ready?
+ (lambda (p) #t) ; u8-ready?
(lambda (p n dest start) ; read-bytevector!
(let* ((pos (##sys#slot p 10))
(input (##sys#slot p 12))
@@ -5892,6 +5899,7 @@ EOF
(buffered (##sys#buffer->string buf pos rest)))
(##sys#setislot p 10 len)
buffered))))
+ (lambda (p) #t) ; char-ready?
)))
;; Invokes the eos handler when EOS is reached to get more data.
diff --git a/port.scm b/port.scm
index 1d24bf0b..a3f991d8 100644
--- a/port.scm
+++ b/port.scm
@@ -274,7 +274,7 @@ char *ttyname(int fd) {
(else c) ) ) ) ) )
(lambda ()
(and (not (null? ports))
- (char-ready? (car ports))))
+ (char-ready? (car ports)))) ; must this depend on encoding of port?
void
peek-char:
(lambda ()
@@ -384,7 +384,7 @@ char *ttyname(int fd) {
(lambda (p d) ; close
(close))
#f ; flush-output
- (lambda (p) ; char-ready?
+ (lambda (p) ; u8-ready?
(ready?) )
(if read-bytevector ; read-bytevector!
(lambda (p n dest start)
@@ -413,7 +413,9 @@ char *ttyname(int fd) {
(let ((m (insert dest start x)))
(loop (and n (fx- n m)) (fx+ c m))))))))))
read-line ; read-line
- read-buffered))
+ read-buffered ; read-buffered
+ (lambda (p) (ready?)) ; char-ready?
+ )))
(data (vector #f))
(port (##sys#make-port 1 class "(custom)" 'custom)))
(##sys#setslot port 10 #f)
@@ -438,10 +440,12 @@ char *ttyname(int fd) {
(close))
(lambda (p) ; flush-output
(when force-output (force-output)) )
- #f ; char-ready?
+ #f ; u8-ready?
#f ; read-bytevector!
#f ; read-line
- #f)) ; read-buffered
+ #f ; read-buffered
+ #f ; char-ready?
+ ))
(data (vector #f))
(port (##sys#make-port 2 class "(custom)" 'custom)))
(##sys#set-port-data! port data)
@@ -507,11 +511,13 @@ char *ttyname(int fd) {
(lambda (p d) ; close
(close))
#f ; flush-output
- (lambda (p) ; char-ready?
+ (lambda (p) ; u8-ready?
(ready?) )
read-bv ; read-bytevector!
#f ; read-line
- #f))
+ #f ; read-buffered
+ (lambda (p) (ready?)) ; char-ready?
+ ))
(data (vector #f))
(port (##sys#make-port 1 class "(custom binary)" 'custom)))
(##sys#setslot port 10 #f)
@@ -546,10 +552,12 @@ char *ttyname(int fd) {
(close))
(lambda (p) ; flush-output
(when force-output (force-output)) )
- #f ; char-ready?
+ #f ; u8-ready?
#f ; read-bytevector!
#f ; read-line
- #f)) ; read-buffered
+ #f ; read-buffered
+ #f ; char-ready?
+ ))
(data (vector #f))
(port (##sys#make-port 2 class "(custom binary)" 'custom)))
(##sys#set-port-data! port data)
@@ -573,14 +581,16 @@ char *ttyname(int fd) {
((2) (close-output-port o))))
(lambda (_) ; flush-output
(flush-output o))
- (lambda (_) ; char-ready?
- (char-ready? i))
+ (lambda (_) ; u8-ready?
+ (u8-ready? i))
(lambda (_ n d s) ; read-bytevector!
(chicken.io#read-bytevector! d i s (fx+ s n)))
(lambda (_ l) ; read-line
(read-line i l))
- (lambda () ; read-buffered
- (read-buffered i))))
+ (lambda (_) ; read-buffered
+ (read-buffered i))
+ (lambda (_) ; char-ready?
+ (char-ready? i))))
(port (##sys#make-port 3 class "(bidirectional)" 'bidirectional)))
(##sys#set-port-data! port (vector #f))
port))
diff --git a/posixunix.scm b/posixunix.scm
index 6a7f86be..da74f08a 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -857,7 +857,7 @@ static int set_file_mtime(C_word filename, C_word atime, C_word mtime)
(dec buf start len
(lambda (buf start len)
(##core#inline "C_utf_decode" buf start)))))))
- (lambda () ; char-ready?
+ (lambda () ; char-ready? (effectively u8-ready?)
(or (fx< bufpos buflen)
(ready?)) )
(lambda () ; close
Trap