syscalls/conditions.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Error conditions.
   4 ;;;
   5
   6 (in-package :iolib.syscalls)
   7
   8 ;;;-----------------------------------------------------------------------------
   9 ;;; System Errors
  10 ;;;-----------------------------------------------------------------------------
  11
  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)
  21   (:documentation
  22    "Base class for errors signalled by IOlib low-level functions."))
  23
  24 (defun system-error (control-string &rest args)
  25   (error 'system-error :message (format nil "~?" control-string args)))
  26
  27 (define-condition syscall-error (system-error)
  28   ()
  29   (:documentation "Base class for syscall errors."))
  30
  31 (defun syscall-error (control-string &rest args)
  32   (error 'syscall-error :message (format nil "~?" control-string args)))
  33 \f
  34
  35 ;;;-----------------------------------------------------------------------------
  36 ;;; I/O Poll Errors
  37 ;;;-----------------------------------------------------------------------------
  38
  39 (define-condition poll-error (system-error)
  40   ()
  41   (:report (lambda (condition stream)
  42              (format stream "Error caught while polling: ~A"
  43                      (message-of condition))))
  44   (:documentation
  45    "Signaled when an error occurs while polling for I/O readiness
  46 of a file descriptor."))
  47
  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))))
  53   (:documentation
  54    "Signaled when a timeout occurs while polling for I/O readiness
  55 of a file descriptor."))
  56 \f
  57
  58 ;;;-----------------------------------------------------------------------------
  59 ;;; Repeat upon conditions
  60 ;;;-----------------------------------------------------------------------------
  61
  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 (get-monotonic-time)))))
  71        (loop :named ,block-name :do
  72          ,@body
  73            (when ,deadline
  74              (let ((,temp-timeout (- ,deadline (get-monotonic-time))))
  75                (setf ,timeout-var
  76                      (if (plusp ,temp-timeout)
  77                          ,temp-timeout
  78                          0))))))))
  79
  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)))))