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.
* 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
"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"
;; 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
(slot usage 'ru-nivcsw))
who (addr usage))))
\f
-;;;; 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)))))))
+\f
+;;;; sys/select.h
+
;;;; FIXME: Why have both UNIX-SELECT and UNIX-FAST-SELECT?
;;; Perform the UNIX select(2) system call.
(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
(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)
(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)
#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>
#endif
#include <sys/stat.h>
-#include <sys/select.h>
#include <fcntl.h>
#include <unistd.h>
#include <signal.h>
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);
"open"
"opendir"
"pipe"
+ "poll"
"pow"
"read"
"readdir"
;;; 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"
projects / sbcl.git / commitdiff