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