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 compute-poll-flags (type)
44 (:read
(logior nix
:pollin nix
:pollrdhup nix
:pollpri
))
45 (:write
(logior nix
:pollout nix
:pollhup
))
46 (:read-write
(logior nix
:pollin nix
:pollrdhup nix
:pollpri
47 nix
:pollout nix
:pollhup
))))
49 (defun process-poll-revents (revents fd
)
50 (let ((readp nil
) (writep nil
))
52 ((nix:pollin nix
:pollrdhup nix
:pollpri
)
54 ((nix:pollout nix
:pollhup
) (setf writep t
))
55 ((nix:pollerr
) (error 'poll-error
:fd fd
))
56 ((nix:pollnval
) (error 'poll-error
:fd fd
57 :identifier
"Invalid file descriptor")))
58 (values readp writep
)))
60 (defun wait-until-fd-ready (fd event-type
&optional timeout
)
61 "Poll file descriptor `FD' for I/O readiness. `EVENT-TYPE' must be
62 :READ, :WRITE or :READ-WRITE which means \"either :READ or :WRITE\".
63 `TIMEOUT' must be either a non-negative integer measured in seconds,
64 or `NIL' meaning no timeout at all."
65 (flet ((poll-error (unix-err)
66 (error 'poll-error
:fd fd
67 :identifier
(osicat-sys:system-error-identifier unix-err
))))
68 (with-foreign-object (pollfd 'nix
::pollfd
)
69 (nix:bzero pollfd nix
::size-of-pollfd
)
70 (with-foreign-slots ((nix::fd nix
::events nix
::revents
)
73 nix
::events
(compute-poll-flags event-type
))
75 (let ((ret (nix:repeat-upon-condition-decreasing-timeout
76 ((nix:eintr
) tmp-timeout timeout
)
77 (nix:poll pollfd
1 (timeout->milisec timeout
)))))
79 (return-from wait-until-fd-ready
(values nil nil
))))
80 (nix:posix-error
(err) (poll-error err
)))
81 (process-poll-revents nix
::revents fd
)))))
83 (defun fd-ready-p (fd &optional
(event-type :read
))
84 "Tests file-descriptor `FD' for I/O readiness. `EVENT-TYPE'
85 must be :READ, :WRITE or :READ-WRITE which means \"either :READ
87 (multiple-value-bind (readp writep
)
88 (wait-until-fd-ready fd event-type
0)
92 (:read-write
(or readp writep
)))))
94 (defun fd-readablep (fd)
95 (nth-value 0 (wait-until-fd-ready fd
:read
0)))
97 (defun fd-writablep (fd)
98 (nth-value 1 (wait-until-fd-ready fd
:write
0)))