1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
3 ;;; --- Wait for events on single FDs.
6 (in-package :io.multiplex
)
8 (define-condition poll-error
(error)
9 ((fd :initarg
:fd
:reader poll-error-fd
)
10 (identifier :initarg
:identifier
:initform
"Unknown error"
11 :reader poll-error-identifier
))
12 (:report
(lambda (condition stream
)
13 (format stream
"Error caught while polling file descriptor ~A: ~A"
14 (poll-error-fd condition
)
15 (poll-error-identifier condition
))))
17 "Signaled when an error occurs while polling for I/O readiness
18 of a file descriptor."))
20 (define-condition poll-timeout
(condition)
21 ((fd :initarg
:fd
:reader poll-timeout-fd
)
22 (event-type :initarg
:event-type
:reader poll-timeout-event-type
))
23 (:report
(lambda (condition stream
)
24 (format stream
"Timeout occurred while polling file descriptor ~A for event ~S"
25 (poll-timeout-fd condition
)
26 (poll-timeout-event-type condition
))))
28 "Signaled when a timeout occurs while polling for I/O readiness
29 of a file descriptor."))
31 (defun compute-poll-flags (type)
33 (:input
(logior isys
:pollin isys
:pollrdhup isys
:pollpri
))
34 (:output
(logior isys
:pollout
))
35 (:io
(logior isys
:pollin isys
:pollrdhup isys
:pollpri isys
:pollout
))))
37 (defun process-poll-revents (revents fd
)
38 (let ((readp nil
) (writep nil
))
40 ((isys:pollin isys
:pollrdhup isys
:pollpri
)
42 ((isys:pollout isys
:pollhup
) (setf writep t
))
43 ((isys:pollerr
) (error 'poll-error
:fd fd
))
44 ((isys:pollnval
) (error 'poll-error
:fd fd
45 :identifier
"Invalid file descriptor")))
46 (values readp writep
)))
48 (defun wait-until-fd-ready (file-descriptor event-type
&optional timeout errorp
)
49 "Poll file descriptor `FILE-DESCRIPTOR' for I/O readiness.
50 `EVENT-TYPE' must be either :INPUT, :OUTPUT or :IO.
51 `TIMEOUT' must be either a non-negative integer measured in seconds,
52 or `NIL' meaning no timeout at all. If `ERRORP' is not NIL and a timeout
53 occurs, then a condition of type `POLL-TIMEOUT' is signaled.
54 Returns two boolean values indicating readability and writeability of `FILE-DESCRIPTOR'."
55 (flet ((poll-error (unix-err)
56 (error 'poll-error
:fd file-descriptor
57 :identifier
(isys:identifier-of unix-err
))))
58 (with-foreign-object (pollfd 'isys
:pollfd
)
59 (isys:%sys-bzero pollfd isys
:size-of-pollfd
)
60 (with-foreign-slots ((isys:fd isys
:events isys
:revents
) pollfd isys
:pollfd
)
61 (setf isys
:fd file-descriptor
62 isys
:events
(compute-poll-flags event-type
))
64 (let ((ret (isys:repeat-upon-condition-decreasing-timeout
65 ((isys:eintr
) remaining-time timeout
)
66 (isys:%sys-poll pollfd
1 (timeout->milisec remaining-time
)))))
69 (error 'poll-timeout
:fd file-descriptor
:event-type event-type
)
70 (return* (values nil nil
)))))
71 (isys:posix-error
(err) (poll-error err
)))
72 (process-poll-revents isys
:revents file-descriptor
)))))
74 (defun fd-ready-p (fd &optional
(event-type :input
))
75 "Tests file-descriptor `FD' for I/O readiness.
76 `EVENT-TYPE' must be either :INPUT, :OUTPUT or :IO ."
77 (multiple-value-bind (readp writep
)
78 (wait-until-fd-ready fd event-type
0)
82 (:io
(or readp writep
)))))
84 (defun fd-readablep (fd)
85 (nth-value 0 (wait-until-fd-ready fd
:input
0)))
87 (defun fd-writablep (fd)
88 (nth-value 1 (wait-until-fd-ready fd
:output
0)))