io: add shortcut to get semaphore on blocking fd read

When reading from an input fd blocks, instead of creating a general
event that creates a semaphore, use the semaphore directly (when
available). Also, treat a semaphore internally as an event that
always produces 0.

This change speeds up the "echo" shootout benchmark.

This change speeds up the "echo" shootout benchmark.

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,

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? ...))

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]