1 ;; Copyright (c) 2009 Vitaly Mayatskikh <v.mayatskih@gmail.com>
3 ;; This file is part of 0MQ.
5 ;; 0MQ is free software; you can redistribute it and/or modify it under
6 ;; the terms of the Lesser GNU General Public License as published by
7 ;; the Free Software Foundation; either version 3 of the License, or
8 ;; (at your option) any later version.
10 ;; 0MQ is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ;; Lesser GNU General Public License for more details.
15 ;; You should have received a copy of the Lesser GNU General Public License
16 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
20 (define-condition error-again
(error)
21 ((argument :reader error-again
:initarg
:argument
))
22 (:report
(lambda (condition stream
)
23 (write-string (convert-from-foreign
24 (%strerror
(error-again condition
))
28 (defmacro defcfun
* (name-and-options return-type
&body args
)
29 (let* ((c-name (car name-and-options
))
30 (l-name (cadr name-and-options
))
31 (n-name (cffi::format-symbol t
"%~A" l-name
))
32 (name (list c-name n-name
))
34 (docstring (when (stringp (car args
)) (pop args
)))
38 unless
(consp i
) do
(setq opt t
)
41 and if
(not opt
) collect
(car i
) into names
42 else collect
(car i
) into opts
43 and collect
(list (car i
) 0) into opts-init
47 (defcfun ,name
,return-type
50 (defun ,l-name
(,@names
&optional
,@opts-init
)
52 (let ((,ret
(,n-name
,@names
,@opts
)))
53 (if ,(if (eq return-type
:pointer
)
54 `(zerop (pointer-address ,ret
))
57 ((eq *errno
* isys
:eagain
) (error 'error-again
:argument
*errno
*))
58 (t (error (convert-from-foreign (%strerror
*errno
*) :string
))))