1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
3 ;;; --- Syscall error conditions.
6 (in-package :iolib.syscalls
)
8 ;;;-------------------------------------------------------------------------
10 ;;;-------------------------------------------------------------------------
12 (define-condition iolib-condition
()
15 (define-condition iolib-error
(error iolib-condition
)
18 (define-condition syscall-error
(iolib-error)
19 ((syscall :initarg
:syscall
:reader syscall-of
20 :documentation
"The name of the C syscall.")
21 (code :initarg
:code
:reader code-of
22 :documentation
"Numeric error code, or NIL.")
23 (identifier :initarg
:identifier
:reader identifier-of
24 :documentation
"Keyword identifier, or NIL.")
25 (message :initarg
:message
:reader message-of
26 :documentation
"Error description.")
27 (handle :initform nil
:initarg
:handle
:reader handle-of
28 :documentation
"The OS handle involved in the error situation.")
29 (handle2 :initform nil
:initarg
:handle2
:reader handle2-of
30 :documentation
"An optional second OS handler."))
31 (:default-initargs
:code nil
:identifier
:unknown
:message nil
)
32 (:documentation
"Base class for syscall errors."))
34 (defun syscall-error-p (thing)
35 (typep thing
'syscall-error
))
37 (defun syscall-error (control-string &rest args
)
38 (error 'syscall-error
:message
(format nil
"~?" control-string args
)))
41 ;;;-------------------------------------------------------------------------
43 ;;;-------------------------------------------------------------------------
45 (define-condition poll-error
(syscall-error)
46 ((event-type :initarg
:event-type
:reader event-type-of
))
47 (:report
(lambda (c s
)
48 (format s
"Poll error(event ~S, handle ~A)"
49 (event-type-of c
) (handle-of c
))
51 (format s
": ~A" (message-of c
)))))
53 "Signaled when an error occurs while polling for I/O readiness
54 of a file descriptor."))
56 (define-condition poll-timeout
(poll-error)
58 (:report
(lambda (c s
)
59 (format s
"Poll timeout(event ~S, handle ~A)"
60 (event-type-of c
) (handle-of c
))
62 (format s
": ~A" (message-of c
)))))
64 "Signaled when a timeout occurs while polling for I/O readiness
65 of a file descriptor."))
68 ;;;-------------------------------------------------------------------------
69 ;;; Repeat upon conditions
70 ;;;-------------------------------------------------------------------------
72 (defmacro repeat-upon-condition
((&rest conditions
) &body body
)
73 (with-gensyms (block-name)
74 `(loop :named
,block-name
:do
75 (ignore-some-conditions ,conditions
76 (return-from ,block-name
(progn ,@body
))))))
78 (defmacro repeat-upon-eintr
(&body body
)
79 `(repeat-upon-condition (eintr) ,@body
))
81 (defmacro repeat-decreasing-timeout
82 ((timeout-var timeout
&optional
(block-name nil blockp
)) &body body
)
83 (unless (find timeout-var
(flatten body
))
84 (warn "You probably want to use ~S inside the body ~A" timeout-var body
))
85 (unless blockp
(setf block-name
(gensym "BLOCK")))
86 (with-gensyms (deadline temp-timeout
)
87 `(let* ((,timeout-var
,timeout
)
88 (,deadline
(when ,timeout-var
89 (+ ,timeout-var
(get-monotonic-time)))))
90 (loop :named
,block-name
:do
93 (let ((,temp-timeout
(- ,deadline
(get-monotonic-time))))
95 (if (plusp ,temp-timeout
)
99 (defmacro repeat-upon-condition-decreasing-timeout
100 (((&rest conditions
) timeout-var timeout
&optional
(block-name nil blockp
)) &body body
)
101 (unless blockp
(setf block-name
(gensym "BLOCK")))
102 `(repeat-decreasing-timeout (,timeout-var
,timeout
,block-name
)
103 (ignore-some-conditions ,conditions
104 (return-from ,block-name
(progn ,@body
)))))