meta.lisp

   1 ;; Copyright (c) 2009, 2010 Vitaly Mayatskikh <v.mayatskih@gmail.com>
   2 ;;
   3 ;; This file is part of CL-ZMQ.
   4 ;;
   5 ;; Vitaly Mayatskikh grants you the rights to distribute
   6 ;; and use this software as governed by the terms
   7 ;; of the Lisp Lesser GNU Public License
   8 ;; (http://opensource.franz.com/preamble.html),
   9 ;; known as the LLGPL.
  10
  11 (in-package :zeromq)
  12
  13 (define-condition zmq-error (error)
  14   ((code :reader error-code :initarg :code)
  15    (description :reader error-description :initarg :description))
  16   (:report (lambda (condition stream)
  17              (format stream "ZMQ Error ~A - ~A."
  18                      (error-code condition)
  19                      (error-description condition)))))
  20
  21 (defun call-with-error-check (function args &key (type :int) error-p)
  22   (let ((error-p (or error-p
  23                      (if (eq type :int)
  24                          #'minusp
  25                          #'null-pointer-p)))
  26         (ret (apply function args)))
  27     (if (funcall error-p ret)
  28         (let* ((error-code (%errno))
  29                (error-description
  30                  (convert-from-foreign (%strerror error-code))))
  31           (make-condition zmq-error
  32                           :code error-code
  33                           :description description))
  34         ret)))
  35
  36 ;; Stolen from CFFI. Uses custom allocator (alloc-fn) instead of foreign-alloc
  37 (defun copy-lisp-string-octets (string alloc-fn
  38                                 &key
  39                                   (encoding cffi::*default-foreign-encoding*)
  40                                   (start 0) end)
  41   "Allocate a foreign string containing Lisp string STRING.
  42 The string must be freed with FOREIGN-STRING-FREE."
  43   (check-type string string)
  44   (cffi::with-checked-simple-vector ((string
  45                                       (coerce string 'babel:unicode-string))
  46                                      (start start) (end end))
  47     (declare (type simple-string string))
  48     (let* ((mapping (cffi::lookup-mapping
  49                      cffi::*foreign-string-mappings*
  50                      encoding))
  51            (count (funcall (cffi::octet-counter mapping) string start end 0))
  52            (ptr (funcall alloc-fn count)))
  53       (funcall (cffi::encoder mapping) string start end ptr 0)
  54       (values ptr count))))