1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
3 ;;; --- Wait for events on single FDs.
6 (in-package :iolib
/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
)
45 (error 'poll-error
:fd fd
))
47 (error 'poll-error
:fd fd
:identifier
"Invalid file descriptor")))
48 (values readp writep
)))
50 (defun wait-until-fd-ready (file-descriptor event-type
&optional timeout errorp
)
51 "Poll file descriptor `FILE-DESCRIPTOR' for I/O readiness.
52 `EVENT-TYPE' must be either :INPUT, :OUTPUT or :IO.
53 `TIMEOUT' must be either a non-negative real measured in seconds,
54 or `NIL' meaning no timeout at all. If `ERRORP' is not NIL and a timeout
55 occurs, then a condition of type `POLL-TIMEOUT' is signaled.
56 Returns two boolean values indicating readability and writeability of `FILE-DESCRIPTOR'."
57 (flet ((poll-error (unix-err)
58 (error 'poll-error
:fd file-descriptor
59 :identifier
(isys:identifier-of unix-err
))))
60 (with-foreign-object (pollfd '(:struct isys
:pollfd
))
61 (isys:bzero pollfd
(isys:sizeof
'(:struct isys
:pollfd
)))
62 (with-foreign-slots ((isys:fd isys
:events isys
:revents
)
63 pollfd
(:struct isys
:pollfd
))
64 (setf isys
:fd file-descriptor
65 isys
:events
(compute-poll-flags event-type
))
67 (let ((ret (isys:repeat-upon-condition-decreasing-timeout
68 ((isys:eintr
) remaining-time timeout
)
69 (isys:poll pollfd
1 (timeout->milliseconds remaining-time
)))))
72 (error 'poll-timeout
:fd file-descriptor
:event-type event-type
)
73 (return* (values nil nil
)))))
74 (isys:syscall-error
(err) (poll-error err
)))
75 (process-poll-revents isys
:revents file-descriptor
)))))
77 (defun fd-ready-p (fd &optional
(event-type :input
))
78 "Tests file-descriptor `FD' for I/O readiness.
79 `EVENT-TYPE' must be either :INPUT, :OUTPUT or :IO ."
80 (multiple-value-bind (readp writep
)
81 (wait-until-fd-ready fd event-type
0)
85 (:io
(or readp writep
)))))
87 (defun fd-readablep (fd)
88 (nth-value 0 (wait-until-fd-ready fd
:input
0)))
90 (defun fd-writablep (fd)
91 (nth-value 1 (wait-until-fd-ready fd
:output
0)))