src/syscalls/os-conditions-unix.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- *NIX syscall error conditions.
   4 ;;;
   5
   6 (in-package :iolib.syscalls)
   7
   8 ;;;-------------------------------------------------------------------------
   9 ;;; POSIX Syscall Errors
  10 ;;;-------------------------------------------------------------------------
  11
  12 ;;; HASH TABLE mapping error codes to symbols denoting
  13 ;;; subtypes of SYSCALL-ERROR.
  14 (defparameter *syscall-error-map* (make-hash-table :test 'eql))
  15
  16 (declaim (inline get-syscall-error-condition))
  17 (defun get-syscall-error-condition (errno)
  18   (gethash errno *syscall-error-map*))
  19
  20 ;;; Define an error condition for each ERRNO value defined in the
  21 ;;; ERRNO-VALUES enum type and populate *SYSCALL-ERROR-MAP*.
  22 (macrolet
  23     ((define-syscall-errors (keywords)
  24        `(progn
  25           ,@(loop :for kw :in keywords :collect
  26                (let ((cond-name (intern (symbol-name kw)))
  27                      (code (foreign-enum-value 'errno-values kw)))
  28                  `(progn
  29                     (define-condition ,cond-name (syscall-error) ()
  30                       (:default-initargs :code ,code :identifier ,kw))
  31                     (setf (gethash ,code *syscall-error-map*) ',cond-name)))))))
  32   (define-syscall-errors
  33     #.(foreign-enum-keyword-list 'errno-values)))
  34
  35 ;;; Instantiates a subclass of SYSCALL-ERROR matching ERR
  36 ;;; ERR must be either an integer denoting an ERRNO value.
  37 (defun make-syscall-error (errno syscall fd fd2)
  38   (debug-only* (assert (integerp errno)))
  39   (let ((error-keyword (foreign-enum-keyword 'errno-values errno :errorp nil)))
  40     (unless error-keyword
  41       (bug "A non-existent ~A syscall error has been signaled: ~A, ~A"
  42            'errno-values (or error-keyword :unknown) errno))
  43     (make-condition (get-syscall-error-condition errno)
  44                     :syscall syscall :handle fd :handle2 fd2)))
  45
  46 (declaim (inline signal-syscall-error))
  47 (defun signal-syscall-error (&optional (errno (errno)) syscall fd fd2)
  48   (cond
  49     ((= errno eintr)
  50      (error 'eintr :syscall syscall :handle fd :handle2 fd2))
  51     (t
  52      (error (make-syscall-error errno syscall fd fd2)))))
  53
  54 (defun signal-syscall-error-kw (error-keyword &optional syscall fd fd2)
  55   (let ((errno (foreign-enum-value 'errno-values error-keyword :errorp nil)))
  56     (unless error-keyword
  57       (bug "A non-existent ~A syscall error has been signaled: ~A, ~A"
  58            'errno-values error-keyword errno))
  59     (signal-syscall-error errno syscall fd fd2)))