1.0.42.41: use poll(2) instead of select(2) in SYSREAD-MAY-BLOCK-P

 Calling select() with a single FD is just waste.

 This also means that we don't use select() outside of serve-event,
 paving way to having more fds open than FD_SETSIZE allows.

NEWS

@@ -9,6 +9,8 @@ changes relative to sbcl-1.0.42
  * enhancement: symbols are printed using fully qualified names in several
  error and warning messages which are often associated with package
  conflicts or mixups (lp#622789, thanks to Attila Lendvai)
+ * optimization: use poll(2) instead of select(2) to check for blocking IO
+ on a single FD.
  * bug fix: SB-BSD-SOCKETS:SOCKET-CONNECT was not thread safe. (lp#505497,
  thanks to Andrew Golding)
  * bug fix: DOTIMES accepted literal non-integer reals. (lp#619393, thanks to

package-data-list.lisp-expr

@@ -2377,7 +2377,7 @@ no guarantees of interface stability."
  "UNIX-GETTIMEOFDAY" "UNIX-GETUID" "UNIX-GID" "UNIX-IOCTL"
  "UNIX-ISATTY" "UNIX-LSEEK" "UNIX-LSTAT" "UNIX-MKDIR"
  "UNIX-OPEN" "UNIX-OPENDIR" "UNIX-PATHNAME" "UNIX-PID"
- "UNIX-PIPE" "UNIX-READ" "UNIX-READDIR" "UNIX-READLINK" "UNIX-REALPATH"
+ "UNIX-PIPE" "UNIX-SIMPLE-POLL" "UNIX-READ" "UNIX-READDIR" "UNIX-READLINK" "UNIX-REALPATH"
  "UNIX-RENAME" "UNIX-SELECT" "UNIX-STAT" "UNIX-UID"
  "UNIX-UNLINK" "UNIX-WRITE"
  "WINSIZE"

src/code/fd-stream.lisp

@@ -941,20 +941,7 @@
  ;; This answers T at EOF on win32, I think.
  (not (sb!win32:fd-listen (fd-stream-fd stream)))
  #!-win32
- (sb!unix:with-restarted-syscall (count errno)
- (sb!alien:with-alien ((read-fds (sb!alien:struct sb!unix:fd-set)))
- (sb!unix:fd-zero read-fds)
- (sb!unix:fd-set (fd-stream-fd stream) read-fds)
- (sb!unix:unix-fast-select (1+ (fd-stream-fd stream))
- (sb!alien:addr read-fds)
- nil nil 0 0))
- (case count
- ((1) nil)
- ((0) t)
- (otherwise
- (simple-stream-perror "couldn't check whether ~S is readable"
- stream
- errno)))))
+ (not (sb!unix:unix-simple-poll (fd-stream-fd stream) :input 0)))
 
 ;;; If the read would block wait (using SERVE-EVENT) till input is available,
 ;;; then fill the input buffer, and return the number of bytes read. Throws

src/code/unix.lisp

@@ -570,29 +570,59 @@ corresponds to NAME, or NIL if there is none."
  (slot usage 'ru-nivcsw))
  who (addr usage))))
 
-;;;; sys/select.h
+;;;; poll.h
 
-(defvar *on-dangerous-select* :warn)
+(defvar *on-dangerous-wait* :warn)
 
 ;;; Calling select in a bad place can hang in a nasty manner, so it's better
 ;;; to have some way to detect these.
-(defun note-dangerous-select ()
- (let ((action *on-dangerous-select*)
- (*on-dangerous-select* nil))
+(defun note-dangerous-wait (type)
+ (let ((action *on-dangerous-wait*)
+ (*on-dangerous-wait* nil))
  (case action
  (:warn
- (warn "Starting a select without a timeout while interrupts are ~
- disabled."))
+ (warn "Starting a ~A without a timeout while interrupts are ~
+ disabled."
+ type))
  (:error
- (error "Starting a select without a timeout while interrupts are ~
- disabled."))
+ (error "Starting a ~A without a timeout while interrupts are ~
+ disabled."
+ type))
  (:backtrace
- (write-line
- "=== Starting a select without a timeout while interrupts are disabled. ==="
- *debug-io*)
+ (format *debug-io*
+  "~&=== Starting a ~A without a timeout while interrupts are disabled. ===~%"
+  type)
  (sb!debug:backtrace)))
  nil))
 
+(define-alien-type nil
+ (struct pollfd
+ (fd int)
+ (events short) ; requested events
+ (revents short))) ; returned events
+
+;; Just for a single fd.
+(defun unix-simple-poll (fd direction to-msec)
+ (declare (fixnum fd to-msec))
+ (when (and (minusp to-msec) (not *interrupts-enabled*))
+ (note-dangerous-wait "poll(2)"))
+ (let ((events (ecase direction
+ (:input (logior pollin pollpri))
+ (:output pollout))))
+ (with-alien ((fds (struct pollfd)))
+ (sb!unix:with-restarted-syscall (count errno)
+ (progn
+ (setf (slot fds 'fd) fd
+ (slot fds 'events) events
+ (slot fds 'revents) 0)
+ (int-syscall ("poll" (* (struct pollfd)) int int)
+ (addr fds) 1 to-msec))
+ (if (zerop errno)
+ (and (eql 1 count) (logtest events (slot fds 'revents)))
+ (error "Syscall poll(2) failed: ~A" (strerror)))))))
+
+;;;; sys/select.h
+
 ;;;; FIXME: Why have both UNIX-SELECT and UNIX-FAST-SELECT?
 
 ;;; Perform the UNIX select(2) system call.
@@ -616,7 +646,7 @@ corresponds to NAME, or NIL if there is none."
  (select (alien-sap (addr tv)))))
  (t
  (unless *interrupts-enabled*
- (note-dangerous-select))
+ (note-dangerous-wait "select(2)"))
  (select (int-sap 0))))))
 
 ;;; UNIX-SELECT accepts sets of file descriptors and waits for an event
@@ -661,7 +691,7 @@ corresponds to NAME, or NIL if there is none."
  (setf (slot tv 'tv-sec) to-secs
  (slot tv 'tv-usec) to-usecs))
  ((not *interrupts-enabled*)
- (note-dangerous-select)))
+ (note-dangerous-wait "select(2)")))
  (num-to-fd-set rdf rdfds)
  (num-to-fd-set wrf wrfds)
  (num-to-fd-set xpf xpfds)

tests/threads.impure.lisp

@@ -17,7 +17,7 @@
 (use-package :test-util)
 (use-package "ASSERTOID")
 
-(setf sb-unix::*on-dangerous-select* :error)
+(setf sb-unix::*on-dangerous-wait* :error)
 
 (defun wait-for-threads (threads)
  (mapc (lambda (thread) (sb-thread:join-thread thread :default nil)) threads)

tools-for-build/grovel-headers.c

@@ -32,6 +32,8 @@
  #include <shlobj.h>
  #undef boolean
 #else
+ #include <poll.h>
+ #include <sys/select.h>
  #include <sys/times.h>
  #include <sys/wait.h>
  #include <sys/ioctl.h>
@@ -41,7 +43,6 @@
 #endif
 
 #include <sys/stat.h>
-#include <sys/select.h>
 #include <fcntl.h>
 #include <unistd.h>
 #include <signal.h>
@@ -250,8 +251,15 @@ main(int argc, char *argv[])
 
  printf("(in-package \"SB!UNIX\")\n\n");
 
+ printf(";;; select()\n");
  defconstant("fd-setsize", FD_SETSIZE);
 
+ printf(";;; poll()\n");
+ defconstant("pollin", POLLIN);
+ defconstant("pollout", POLLOUT);
+ defconstant("pollpri", POLLPRI);
+ DEFTYPE("nfds-t", nfds_t);
+
  printf(";;; langinfo\n");
  defconstant("codeset", CODESET);
 

tools-for-build/ldso-stubs.lisp

@@ -260,6 +260,7 @@ ldso_stub__ ## fct: ; \\
  "open"
  "opendir"
  "pipe"
+ "poll"
  "pow"
  "read"
  "readdir"

version.lisp-expr

@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.42.40"
+"1.0.42.41"