diff --git a/racket/src/io/port/fd-port.rkt b/racket/src/io/port/fd-port.rkt index cad56fa521..7d9d8e29f1 100644 --- a/racket/src/io/port/fd-port.rkt +++ b/racket/src/io/port/fd-port.rkt @@ -61,8 +61,8 @@ (end-atomic) (send fd-input-port this raise-read-error n)] [(eqv? n RKTIO_READ_EOF) eof] - [(eqv? n 0) (wrap-evt (fd-evt fd RKTIO_POLL_READ this) - (lambda (v) 0))] + [(eqv? n 0) (or (fd-semaphore-update! fd 'read) + (fd-evt fd RKTIO_POLL_READ this))] [else n]))] [close @@ -379,6 +379,9 @@ ;; ---------------------------------------- +;; The ready value for an `fd-evt` is 0, so it can be used directly +;; for an input port + (struct fd-evt (fd mode [closed #:mutable]) #:property prop:evt @@ -388,7 +391,7 @@ (lambda (fde ctx) (cond [(core-port-closed? (fd-evt-closed fde)) - (values (list fde) #f)] + (values '(0) #f)] [else (define mode (fd-evt-mode fde)) (define ready? @@ -401,7 +404,7 @@ RKTIO_POLL_READY)))) (cond [ready? - (values (list fde) #f)] + (values '(0) #f)] ;; If the called is going to block (i.e., not just polling), then ;; try to get a semaphore to represent the file descriptor, because ;; that can be more scalable (especially for lots of TCP sockets) @@ -411,7 +414,7 @@ 'read 'write))) => (lambda (s) ; got a semaphore - (values #f (wrap-evt s (lambda (s) fde))))] + (values #f (wrap-evt s (lambda (s) 0))))] [else ;; If `sched-info` in `poll-ctx` is not #f, then we can register this file ;; descriptor so that if no thread is able to make progress, diff --git a/racket/src/io/port/input-port.rkt b/racket/src/io/port/input-port.rkt index f25bf29274..50054ef1f1 100644 --- a/racket/src/io/port/input-port.rkt +++ b/racket/src/io/port/input-port.rkt @@ -74,7 +74,8 @@ ;; be exposed to untrusted code, and instead of should be copied if ;; necessary. The return values are the same as documented for ;; `make-input-port`, except that a pipe result is not allowed (or, - ;; more precisely, it's treated as an event). + ;; more precisely, it's treated as an event), and a semaphore is + ;; treated like an event that produces 0. [read-in (lambda (bstr start end copy?) eof)] ;; port or (bytes start-k end-k skip-k progress-evt copy? -*> (or/c integer? ...)) diff --git a/racket/src/io/port/read-and-peek.rkt b/racket/src/io/port/read-and-peek.rkt index 9d87787e52..66508b60de 100644 --- a/racket/src/io/port/read-and-peek.rkt +++ b/racket/src/io/port/read-and-peek.rkt @@ -101,6 +101,21 @@ "result" v "byte-string length" (- end start))])] [(eof-object? v) eof] + [(semaphore? v) + ;; A semaphore is treated as a special case, making + ;; it equivalent to an evt that returns 0 + (cond + [zero-ok? + ;; Poll: + (cond + [(semaphore-try-wait? v) + (loop in extra-count-ins)] + [else 0])] + [else + (if enable-break? + (semaphore-wait/enable-break v) + (semaphore-wait v)) + (loop in extra-count-ins)])] [(evt? v) ;; If `zero-ok?`, we should at least poll the event (define timeout (if zero-ok? (lambda () 0) #f)) @@ -186,6 +201,14 @@ "result" v "byte-string length" (- end start))])] [(eof-object? v) eof] + [(semaphore? v) + (cond + [zero-ok? 0] + [else + (if enable-break? + (semaphore-wait/enable-break v) + (semaphore-wait v)) + (loop in)])] [(evt? v) (cond [zero-ok? 0]