syscalls/os-conditions-unix.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- *NIX-specific error conditions.
   4 ;;;
   5
   6 (in-package :iolib.syscalls)
   7
   8 ;;;-------------------------------------------------------------------------
   9 ;;; POSIX Syscall Errors
  10 ;;;-------------------------------------------------------------------------
  11
  12 (define-condition posix-error (syscall-error)
  13   ()
  14   (:documentation
  15    "POSIX-ERRORs are signalled whenever ERRNO is set by a POSIX call."))
  16
  17 ;;; HASH TABLE mapping keywords (such as :EAGAIN) to symbols denoting
  18 ;;; subtypes of POSIX-ERROR.
  19 (defparameter *posix-error-map* (make-hash-table :test #'eq))
  20
  21 (defun get-posix-error-condition (keyword)
  22   (gethash keyword *posix-error-map*))
  23
  24 ;;; Define an error condition for each ERRNO value defined in the
  25 ;;; ERRNO-VALUES enum type and populate *POSIX-ERROR-MAP*.
  26 (macrolet
  27     ((define-posix-errors (keywords)
  28        `(progn
  29           ,@(loop :for kw :in keywords :collect
  30                (let ((cond-name (intern (symbol-name kw)))
  31                      (code (foreign-enum-value 'errno-values kw)))
  32                  `(progn
  33                     (define-condition ,cond-name (posix-error) ()
  34                       (:default-initargs :code ,code :identifier ,kw))
  35                     (setf (gethash ,kw *posix-error-map*) ',cond-name)))))))
  36   (define-posix-errors
  37       #.(foreign-enum-keyword-list 'errno-values)))
  38
  39 ;;; Instantiates a subclass of POSIX-ERROR matching ERR or a plain
  40 ;;; POSIX-ERROR if no matching subclass is found.  ERR can be either a
  41 ;;; keyword or an integer both denoting an ERRNO value.
  42 (defun make-posix-error (err)
  43   (multiple-value-bind (error-keyword error-code)
  44       (typecase err
  45         (keyword (values err (foreign-enum-value 'errno-values err :errorp nil)))
  46         (integer (values (foreign-enum-keyword 'errno-values err :errorp nil) err))
  47         (t (bug "Non-valid error-designator: ~A" err)))
  48     (unless (and error-keyword error-code)
  49       (bug "A non-existent ~A syscall error has been signaled: ~A, ~A"
  50            'errno-values (or error-keyword :unknown) error-code))
  51     (make-condition (get-posix-error-condition error-keyword))))
  52
  53 (declaim (inline posix-error))
  54 (defun posix-error (&optional (errno (%sys-errno)))
  55   (error (make-posix-error errno)))
  56
  57 ;;; Default ERROR-GENERATOR for ERRNO-WRAPPER.
  58 (declaim (inline signal-posix-error))
  59 (defun signal-posix-error (return-value)
  60   (declare (ignore return-value))
  61   (posix-error))