- (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.
-(declaim (type (or null function) *periodic-polling-function*))
-(defvar *periodic-polling-function* nil)
-(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)
-
-;;; Takes timeout broken into seconds and microseconds.
-(defun sub-serve-event (to-sec to-usec)
- (declare (type (or null (unsigned-byte 29)) to-sec to-usec))
-
- (let ((call-polling-fn nil))
- (when (and *periodic-polling-function*
- ;; Enforce a maximum timeout.
- (or (null to-sec)
- (> to-sec *max-event-to-sec*)
- (and (= to-sec *max-event-to-sec*)
- (> to-usec *max-event-to-usec*))))
- (setf to-sec *max-event-to-sec*)
- (setf to-usec *max-event-to-usec*)
- (setf call-polling-fn t))