1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Indent-tabs-mode: NIL -*-
3 ;;; fd-wait.lisp --- Wait for events on single FDs.
5 ;;; Copyright (C) 2006-2007, Stelian Ionescu <sionescu@common-lisp.net>
7 ;;; This code is free software; you can redistribute it and/or
8 ;;; modify it under the terms of the version 2.1 of
9 ;;; the GNU Lesser General Public License as published by
10 ;;; the Free Software Foundation, as clarified by the
11 ;;; preamble found here:
12 ;;; http://opensource.franz.com/preamble.html
14 ;;; This program is distributed in the hope that it will be useful,
15 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;;; GNU General Public License for more details.
19 ;;; You should have received a copy of the GNU Lesser General
20 ;;; Public License along with this library; if not, write to the
21 ;;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
22 ;;; Boston, MA 02110-1301, USA
24 (in-package :io.multiplex
)
26 ;;; FIXME: Until a way to autodetect platform features is implemented
28 (define-constant nix
::pollrdhup
0)
30 (define-condition poll-error
(error)
31 ((fd :initarg
:fd
:reader poll-error-fd
)
32 (identifier :initarg
:identifier
:initform
"<Unknown error>"
33 :reader poll-error-identifier
))
34 (:report
(lambda (condition stream
)
35 (format stream
"Error caught while polling file descriptor ~A: ~A"
36 (poll-error-fd condition
)
37 (poll-error-identifier condition
))))
39 "Signaled when an error occurs while polling for I/O readiness
40 of a file descriptor."))
42 (defun %wait-until-fd-ready
(fd event-type timeout
)
43 (flet ((choose-poll-flags (type)
45 (:read
(logior nix
::pollin nix
::pollrdhup nix
::pollpri
))
46 (:write
(logior nix
::pollout nix
::pollhup
))
47 (:read-write
(logior nix
::pollin nix
::pollrdhup nix
::pollpri
48 nix
::pollout nix
::pollhup
))))
49 (poll-error (unix-err)
50 (error 'poll-error
:fd fd
51 :identifier
(osicat-sys:system-error-identifier unix-err
))))
52 (let ((readp nil
) (writep nil
))
53 (with-foreign-object (pollfd 'nix
::pollfd
)
54 (nix:bzero pollfd nix
::size-of-pollfd
)
55 (with-foreign-slots ((nix::fd nix
::events nix
::revents
)
58 nix
::events
(choose-poll-flags event-type
))
60 (let ((ret (nix:repeat-upon-condition-decreasing-timeout
61 ((nix:eintr
) tmp-timeout timeout
)
62 (nix:poll pollfd
1 (timeout->milisec timeout
)))))
64 (return-from %wait-until-fd-ready
(values nil nil
))))
65 (nix:posix-error
(err) (poll-error err
)))
66 (flags-case nix
::revents
67 ((nix::pollin nix
::pollrdhup nix
::pollpri
)
69 ((nix::pollout nix
::pollhup
) (setf writep t
))
70 ((nix::pollerr nix
::pollnval
) (error 'poll-error
:fd fd
)))
71 (values readp writep
))))))
73 (defun wait-until-fd-ready (fd event-type
&optional timeout
)
74 "Poll file descriptor `FD' for I/O readiness. `EVENT-TYPE' must be
75 :READ, :WRITE or :READ-WRITE which means \"either :READ or :WRITE\".
76 `TIMEOUT' must be either a non-negative integer measured in seconds,
77 or `NIL' meaning no timeout at all."
78 (%wait-until-fd-ready fd event-type timeout
))
80 (defun fd-ready-p (fd &optional
(event-type :read
))
81 "Tests file-descriptor `FD' for I/O readiness. `EVENT-TYPE'
82 must be :READ, :WRITE or :READ-WRITE which means \"either :READ
84 (multiple-value-bind (readp writep
)
85 (wait-until-fd-ready fd event-type
0)
89 (:read-write
(or readp writep
)))))
91 (defun fd-readablep (fd)
92 (nth-value 0 (wait-until-fd-ready fd
:read
0)))
94 (defun fd-writablep (fd)
95 (nth-value 1 (wait-until-fd-ready fd
:write
0)))