1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
3 ;;; --- Error conditions.
6 (in-package :iolib.syscalls
)
8 ;;;-----------------------------------------------------------------------------
10 ;;;-----------------------------------------------------------------------------
12 (define-condition system-error
(error)
13 ((code :initarg
:code
:reader code-of
14 :documentation
"Numeric error code, or NIL.")
15 (identifier :initarg
:identifier
:reader identifier-of
16 :documentation
"Keyword identifier, or NIL.")
17 (message :initarg
:message
:reader message-of
18 :documentation
"Error description."))
19 (:default-initargs
:code nil
20 :identifier
:unknown-error
)
22 "Base class for errors signalled by IOlib low-level functions."))
24 (defun system-error (control-string &rest args
)
25 (error 'system-error
:message
(format nil
"~?" control-string args
)))
27 (define-condition syscall-error
(system-error)
29 (:documentation
"Base class for syscall errors."))
31 (defun syscall-error (control-string &rest args
)
32 (error 'syscall-error
:message
(format nil
"~?" control-string args
)))
35 ;;;-----------------------------------------------------------------------------
37 ;;;-----------------------------------------------------------------------------
39 (define-condition poll-error
(system-error)
41 (:report
(lambda (condition stream
)
42 (format stream
"Error caught while polling: ~A"
43 (message-of condition
))))
45 "Signaled when an error occurs while polling for I/O readiness
46 of a file descriptor."))
48 (define-condition poll-timeout
(condition)
49 ((event-type :initarg
:event-type
:reader event-type-of
))
50 (:report
(lambda (condition stream
)
51 (format stream
"Timeout occurred while polling for event ~S"
52 (event-type-of condition
))))
54 "Signaled when a timeout occurs while polling for I/O readiness
55 of a file descriptor."))
58 ;;;-----------------------------------------------------------------------------
59 ;;; Repeat upon conditions
60 ;;;-----------------------------------------------------------------------------
62 (defmacro repeat-decreasing-timeout
63 ((timeout-var timeout
&optional
(block-name nil blockp
)) &body body
)
64 (unless (find timeout-var
(flatten body
))
65 (warn "You probably want to use ~S inside the body ~A" timeout-var body
))
66 (unless blockp
(setf block-name
(gensym "BLOCK")))
67 (with-unique-names (deadline temp-timeout
)
68 `(let* ((,timeout-var
,timeout
)
69 (,deadline
(when ,timeout-var
70 (+ ,timeout-var
(%sys-get-monotonic-time
)))))
71 (loop :named
,block-name
:do
74 (let ((,temp-timeout
(- ,deadline
(%sys-get-monotonic-time
))))
76 (if (plusp ,temp-timeout
)
80 (defmacro repeat-upon-condition-decreasing-timeout
81 (((&rest conditions
) timeout-var timeout
&optional
(block-name nil blockp
)) &body body
)
82 (unless blockp
(setf block-name
(gensym "BLOCK")))
83 `(repeat-decreasing-timeout (,timeout-var
,timeout
,block-name
)
84 (ignore-some-conditions ,conditions
85 (return-from ,block-name
(progn ,@body
)))))