Switch NET.SOCKETS to syscalls package.
[iolib.git] / syscalls / conditions.lisp
blob5694356df2f9f067853b53fe0e7ff9f3e591e997
1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
2 ;;;
3 ;;; --- Error conditions.
4 ;;;
6 (in-package :iolib.syscalls)
8 ;;;-------------------------------------------------------------------------
9 ;;; System Errors
10 ;;;-------------------------------------------------------------------------
12 (define-condition condition-info-mixin (condition)
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 :identifier :unknown :message nil))
21 (define-condition system-error (error condition-info-mixin)
23 (:documentation
24 "Base class for errors signalled by IOlib low-level functions."))
26 (defun system-error (control-string &rest args)
27 (error 'system-error :message (format nil "~?" control-string args)))
29 (define-condition syscall-error (system-error)
30 ((handle :initform nil :initarg :handle :reader handle-of))
31 (:documentation "Base class for syscall errors."))
33 (defun syscall-error (control-string &rest args)
34 (error 'syscall-error :message (format nil "~?" control-string args)))
37 ;;;-------------------------------------------------------------------------
38 ;;; I/O Poll Errors
39 ;;;-------------------------------------------------------------------------
41 (define-condition poll-error (system-error)
42 ((event-type :initarg :event-type :reader event-type-of)
43 (os-handle :initarg :os-handle :reader os-handle-of))
44 (:report (lambda (c s)
45 (format s "Poll error(event ~S, handle ~A)"
46 (event-type-of c) (os-handle-of c))
47 (when (message-of c)
48 (format s ": ~A" (message-of c)))))
49 (:documentation
50 "Signaled when an error occurs while polling for I/O readiness
51 of a file descriptor."))
53 (define-condition poll-timeout (condition-info-mixin)
54 ((event-type :initarg :event-type :reader event-type-of)
55 (os-handle :initarg :os-handle :reader os-handle-of))
56 (:report (lambda (c s)
57 (format s "Poll timeout(event ~S, handle ~A)"
58 (event-type-of c) (os-handle-of c))
59 (when (message-of c)
60 (format s ": ~A" (message-of c)))))
61 (:documentation
62 "Signaled when a timeout occurs while polling for I/O readiness
63 of a file descriptor."))
66 ;;;-------------------------------------------------------------------------
67 ;;; Repeat upon conditions
68 ;;;-------------------------------------------------------------------------
70 (defmacro repeat-upon-condition ((&rest conditions) &body body)
71 (with-gensyms (block-name)
72 `(loop :named ,block-name :do
73 (ignore-some-conditions ,conditions
74 (return-from ,block-name (progn ,@body))))))
76 (defmacro repeat-upon-eintr (&body body)
77 `(repeat-upon-condition (eintr) ,@body))
79 (defmacro repeat-decreasing-timeout
80 ((timeout-var timeout &optional (block-name nil blockp)) &body body)
81 (unless (find timeout-var (flatten body))
82 (warn "You probably want to use ~S inside the body ~A" timeout-var body))
83 (unless blockp (setf block-name (gensym "BLOCK")))
84 (with-gensyms (deadline temp-timeout)
85 `(let* ((,timeout-var ,timeout)
86 (,deadline (when ,timeout-var
87 (+ ,timeout-var (%sys-get-monotonic-time)))))
88 (loop :named ,block-name :do
89 ,@body
90 (when ,deadline
91 (let ((,temp-timeout (- ,deadline (%sys-get-monotonic-time))))
92 (setf ,timeout-var
93 (if (plusp ,temp-timeout)
94 ,temp-timeout
95 0))))))))
97 (defmacro repeat-upon-condition-decreasing-timeout
98 (((&rest conditions) timeout-var timeout &optional (block-name nil blockp)) &body body)
99 (unless blockp (setf block-name (gensym "BLOCK")))
100 `(repeat-decreasing-timeout (,timeout-var ,timeout ,block-name)
101 (ignore-some-conditions ,conditions
102 (return-from ,block-name (progn ,@body)))))