- "Receive on all ports and Xevents and dispatch to the appropriate handler
- function. If timeout is specified, server will wait the specified time (in
- seconds) and then return, otherwise it will wait until something happens.
- Server returns T if something happened and NIL otherwise."
- (multiple-value-bind (to-sec to-usec) (decode-timeout timeout)
- (sub-serve-event to-sec to-usec)))
-
-;;; These macros are chunks of code from SUB-SERVE-EVENT. They randomly
-;;; reference the READ-FDS and WRITE-FDS Alien variables (which wold be consed
-;;; if passed as function arguments.)
-(eval-when (:compile-toplevel :execute)
-
-;;; Initialize the fd-sets for UNIX-SELECT and return the active descriptor
-;;; count.
-(sb!xc:defmacro calc-masks ()
- '(progn
- (sb!unix:fd-zero read-fds)
- (sb!unix:fd-zero write-fds)
- (let ((count 0))
- (declare (type index count))
- (dolist (handler *descriptor-handlers*)
- (unless (or (handler-active handler)
- (handler-bogus handler))
- (let ((fd (handler-descriptor handler)))
- (ecase (handler-direction handler)
- (:input (sb!unix:fd-set fd read-fds))
- (:output (sb!unix:fd-set fd write-fds)))
- (when (> fd count)
- (setf count fd)))))
- (1+ count))))
-
-;;; Call file descriptor handlers according to the readable and writable masks
-;;; returned by select.
-(sb!xc:defmacro call-fd-handler ()
- '(let ((result nil))
- (dolist (handler *descriptor-handlers*)
- (let ((desc (handler-descriptor handler)))
- (when (ecase (handler-direction handler)
- (:input (sb!unix:fd-isset desc read-fds))
- (:output (sb!unix:fd-isset desc write-fds)))
- (unwind-protect
- (progn
- ;; Doesn't work -- ACK
- ;(setf (handler-active handler) t)
- (funcall (handler-function handler) desc))
- (setf (handler-active handler) nil))
- (ecase (handler-direction handler)
- (:input (sb!unix:fd-clr desc read-fds))
- (:output (sb!unix:fd-clr desc write-fds)))
- (setf result t)))
- result)))
-
-) ; EVAL-WHEN
-
-;;; When a *periodic-polling-function* is defined the server will not
-;;; block for more than the maximum event timeout and will call the
-;;; polling function if it does time out. One important use of this
-;;; is to periodically call process-yield.
-(declaim (type (or null function) *periodic-polling-function*))
-(defvar *periodic-polling-function*
- #!-mp nil #!+mp #'sb!mp:process-yield)
-(declaim (type (unsigned-byte 29) *max-event-to-sec* *max-event-to-usec*))
-(defvar *max-event-to-sec* 1)
-(defvar *max-event-to-usec* 0)
+ "Receive pending events on all FD-STREAMS and dispatch to the appropriate
+handler functions. If timeout is specified, server will wait the specified
+time (in seconds) and then return, otherwise it will wait until something
+happens. Server returns T if something happened and NIL otherwise. Timeout
+0 means polling without waiting."
+ (multiple-value-bind (to-sec to-usec stop-sec stop-usec signalp)
+ (decode-timeout timeout)
+ (declare (ignore stop-sec stop-usec))
+ (sub-serve-event to-sec to-usec signalp)))