contrib/sb-bsd-sockets/util.lisp

   1 (in-package :sb-bsd-sockets)
   2
   3 ;;; System call helpers
   4
   5 (defun interrupted-p (errno)
   6   (member errno `(,sockint::EAGAIN ,sockint::EINTR) :test #'=))
   7
   8 (defmacro syscall-error-case ((form result-var test-form errno-form)
   9                               &optional no-error-form
  10                               &body clauses)
  11   (let ((interrupted-case nil)
  12         (error-case nil)
  13         (no-error-case `(,no-error-form)))
  14     (dolist (clause clauses)
  15       (ecase (first clause)
  16         (:interrupted
  17          (setf interrupted-case (rest clause)))
  18         (:error
  19          (setf error-case (rest clause)))))
  20     `(let ((,result-var ,form))
  21        (cond
  22          ,@(when interrupted-case
  23              `(((and ,test-form (interrupted-p ,errno-form))
  24                 ,@interrupted-case)))
  25          ,@(when error-case
  26              `((,test-form
  27                 ,@error-case)))
  28          ,@(when no-error-case
  29              `((t ,@no-error-case)))))))
  30
  31 (defmacro socket-error-case ((context form
  32                               &optional
  33                               (result-var (gensym "RESULT"))
  34                               (test-form `(= ,result-var -1))
  35                               (errno-form `(socket-errno)))
  36                              &optional no-error-form
  37                              &body clauses)
  38   `(syscall-error-case (,form ,result-var ,test-form ,errno-form)
  39        ,no-error-form
  40      ,@(unless (find :error clauses :key #'first)
  41          `((:error (socket-error ,context))))
  42      ,@clauses))
  43
  44 (defmacro addrinfo-error-case ((context form
  45                                 &optional
  46                                 (result-var (gensym "RESULT"))
  47                                 (test-form `(not (zerop ,result-var))))
  48                              &optional no-error-form
  49                              &body clauses)
  50   `(syscall-error-case (,form ,result-var ,test-form nil)
  51        ,no-error-form
  52      ,@(unless (find :error clauses :key #'first)
  53          `((:error (addrinfo-error ,context ,result-var))))
  54      ,@clauses))