zmq-api.lisp

   1 (in-package :cl-zmq)
   2
   3 (defun bind (s address)
   4   (with-foreign-string (addr address)
   5     (%bind s addr)))
   6
   7 (defun connect (s address)
   8   (with-foreign-string (addr address)
   9     (%connect s addr)))
  10
  11 (defun make-message (&optional (data nil data-p) &key (size nil size-p))
  12   (let* ((msg (make-instance 'msg :finalizer #'msg-close))
  13          (raw (msg-raw msg)))
  14     (when size-p
  15       (msg-init-size raw size))
  16     (when data-p
  17       (multiple-value-bind (ptr len)
  18           (etypecase data
  19             (string (let ((ptr (convert-to-foreign data :string)))
  20                       (values ptr (1+ (foreign-funcall "strlen" :pointer ptr :long)))))
  21             (array (let* ((len (length data))
  22                           (ptr (foreign-alloc :uchar :count len)))
  23                      (dotimes (i len)
  24                        (setf (mem-aref ptr :uchar i) (aref data i)))
  25                      (values ptr len))))
  26         (msg-init-data raw ptr len (callback zmq-free))))
  27     msg))
  28
  29 (defmacro with-context ((context app-threads io-threads &optional flags) &body body)
  30   `(let ((,context (init ,app-threads ,io-threads (or ,flags 0))))
  31      ,@body
  32      (term ,context)))
  33
  34 (defmacro with-socket ((socket context type) &body body)
  35   `(let ((,socket (socket ,context ,type)))
  36      ,@body
  37      (close ,socket)))
  38
  39 (defmacro with-stopwatch (&body body)
  40   (let ((watch (gensym)))
  41     `(with-foreign-object (,watch :long 2)
  42        (setq ,watch (stopwatch-start))
  43        ,@body
  44        (stopwatch-stop ,watch))))
  45
  46 (defun msg-data-as-string (msg)
  47   (let ((data (%msg-data (msg-raw msg))))
  48     (unless (zerop (pointer-address data))
  49       (convert-from-foreign data :string))))
  50
  51 (defun msg-data-as-array (msg)
  52   (let ((data (%msg-data (msg-raw msg))))
  53     (unless (zerop (pointer-address data))
  54       (let* ((len (msg-size msg))
  55              (arr (make-array len :element-type '(unsigned-byte))))
  56         (dotimes (i len)
  57           (setf (aref arr i) (mem-aref data :uchar i)))
  58         arr))))
  59
  60 (defun send (s msg &optional flags)
  61   (%send s (msg-raw msg) (or flags 0)))
  62
  63 (defun recv (s msg &optional flags)
  64   (%recv s (msg-raw msg) (or flags 0)))
  65
  66 (defun msg-size (msg)
  67   (%msg-size (msg-raw msg)))
  68
  69 (defun msg-move (dst src)
  70   (%msg-move (msg-raw dst) (msg-raw src)))
  71
  72 (defun msg-copy (dst src)
  73   (%msg-copy (msg-raw dst) (msg-raw src)))
  74
  75 (defun setsockopt (socket option value)
  76   (etypecase value
  77     (string (with-foreign-string (string value)
  78               (%setsockopt socket option string (length value))))
  79     (integer (with-foreign-object (int :long 2)
  80                (setf (mem-aref int :long 0) value)
  81                (%setsockopt socket option int (foreign-type-size :long))))))
  82 ;