contrib/sb-bsd-sockets/util.lisp

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