diff options
Diffstat (limited to 'bindings/cl')
| -rw-r--r-- | bindings/cl/Makefile.am | 9 | ||||
| -rw-r--r-- | bindings/cl/meta.lisp | 59 | ||||
| -rw-r--r-- | bindings/cl/package.lisp | 108 | ||||
| -rw-r--r-- | bindings/cl/zeromq-api.lisp | 155 | ||||
| -rw-r--r-- | bindings/cl/zeromq.asd | 38 | ||||
| -rw-r--r-- | bindings/cl/zeromq.lisp | 244 |
6 files changed, 613 insertions, 0 deletions
diff --git a/bindings/cl/Makefile.am b/bindings/cl/Makefile.am new file mode 100644 index 0000000..034d1f4 --- /dev/null +++ b/bindings/cl/Makefile.am @@ -0,0 +1,9 @@ +sitedir=$(CLDIR)/../site/zeromq +zeromqasd=$(CLDIR)/zeromq.asd + +install-data-local: + if test -d $(sitedir); then rm -rdf $(sitedir); fi + mkdir $(sitedir) + chown --reference=$(sitedir)/.. $(sitedir) + cp *.lisp *.asd $(sitedir) + ln -sf $(sitedir)/zeromq.asd $(zeromqasd) diff --git a/bindings/cl/meta.lisp b/bindings/cl/meta.lisp new file mode 100644 index 0000000..751a089 --- /dev/null +++ b/bindings/cl/meta.lisp @@ -0,0 +1,59 @@ +;; Copyright (c) 2009 Vitaly Mayatskikh <v.mayatskih@gmail.com> +;; +;; This file is part of 0MQ. +;; +;; 0MQ is free software; you can redistribute it and/or modify it under +;; the terms of the Lesser GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; 0MQ is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; Lesser GNU General Public License for more details. +;; +;; You should have received a copy of the Lesser GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +(in-package :zeromq) + +(define-condition error-again (error) + ((argument :reader error-again :initarg :argument)) + (:report (lambda (condition stream) + (write-string (convert-from-foreign + (%strerror (error-again condition)) + :string) + stream)))) + +(defmacro defcfun* (name-and-options return-type &body args) + (let* ((c-name (car name-and-options)) + (l-name (cadr name-and-options)) + (n-name (cffi::format-symbol t "%~A" l-name)) + (name (list c-name n-name)) + + (docstring (when (stringp (car args)) (pop args))) + (ret (gensym))) + (loop with opt + for i in args + unless (consp i) do (setq opt t) + else + collect i into args* + and if (not opt) collect (car i) into names + else collect (car i) into opts + and collect (list (car i) 0) into opts-init + end + finally (return + `(progn + (defcfun ,name ,return-type + ,@args*) + + (defun ,l-name (,@names &optional ,@opts-init) + ,docstring + (let ((,ret (,n-name ,@names ,@opts))) + (if ,(if (eq return-type :pointer) + `(zerop (pointer-address ,ret)) + `(not (zerop ,ret))) + (cond + ((eq *errno* isys:eagain) (error 'error-again :argument *errno*)) + (t (error (convert-from-foreign (%strerror *errno*) :string)))) + ,ret)))))))) diff --git a/bindings/cl/package.lisp b/bindings/cl/package.lisp new file mode 100644 index 0000000..89713b1 --- /dev/null +++ b/bindings/cl/package.lisp @@ -0,0 +1,108 @@ +;; Copyright (c) 2009 Vitaly Mayatskikh <v.mayatskih@gmail.com> +;; +;; This file is part of 0MQ. +;; +;; 0MQ is free software; you can redistribute it and/or modify it under +;; the terms of the Lesser GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; 0MQ is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; Lesser GNU General Public License for more details. +;; +;; You should have received a copy of the Lesser GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +(defpackage #:zeromq + (:nicknames :zmq) + (:use :cl :cffi) + (:shadow #:sleep #:close) + (:export + ;; constants + #:affinity + #:delimiter + #:downstream + #:efsm + #:emthread + #:enocompatproto + #:hausnumero + #:hwm + #:identity + #:lwm + #:max-vsm-size + #:mcast-loop + #:noblock + #:noflush + #:p2p + #:poll + #:pollin + #:pollout + #:pub + #:rate + #:recovery-ivl + #:rep + #:req + #:sub + #:subscribe + #:swap + #:unsubscribe + #:upstream + #:vsm + + #:events + + ;; structures + #:msg + #:pollitem + + ;; functions + #:bind + #:close + #:connect + #:flush + #:init + #:msg-close + #:msg-copy + #:msg-data-as-array + #:msg-data-as-is + #:msg-data-as-string + #:msg-init + #:msg-init-data + #:msg-init-size + #:msg-move + #:msg-size + #:msg-type + #:poll + #:pollitem-events + #:pollitem-fd + #:pollitem-revents + #:pollitem-socket + #:recv + #:send + #:setsockopt + #:sleep + #:socket + #:stopwatch-start + #:stopwatch-stop + #:strerror + #:term + + ;; macros + #:with-context + #:with-polls + #:with-socket + #:with-stopwatch + + ;; conditions + #:error-again)) + +(in-package :zeromq) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (define-foreign-library zeromq + (:unix (:or "libzmq.so.0.0.0" "libzmq.so")) + (t "libzmq"))) + +(use-foreign-library zeromq) diff --git a/bindings/cl/zeromq-api.lisp b/bindings/cl/zeromq-api.lisp new file mode 100644 index 0000000..953b98b --- /dev/null +++ b/bindings/cl/zeromq-api.lisp @@ -0,0 +1,155 @@ +;; Copyright (c) 2009 Vitaly Mayatskikh <v.mayatskih@gmail.com> +;; +;; This file is part of 0MQ. +;; +;; 0MQ is free software; you can redistribute it and/or modify it under +;; the terms of the Lesser GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; 0MQ is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; Lesser GNU General Public License for more details. +;; +;; You should have received a copy of the Lesser GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +(in-package :zeromq) + +(defclass msg () + ((raw :accessor msg-raw :initform nil) + (shared :accessor msg-shared :initform 0 :initarg :shared))) + +(defmethod initialize-instance :after ((inst msg) &key size data) + (let ((obj (foreign-alloc 'msg))) + (with-slots (raw shared) inst + (setf raw obj) + (tg:finalize inst (lambda () + (%msg-close raw) + (foreign-free raw))) + (when shared + (setf (foreign-slot-value obj 'msg 'shared) (if shared 1 0))) + (cond (size (%msg-init-size raw size)) + (data + (multiple-value-bind (ptr len) + (etypecase data + (string (foreign-string-alloc data)) + (array (values (foreign-alloc :uchar :initial-contents data) + (length data)))) + (msg-init-data raw ptr len (callback zmq-free)))) + (t (msg-init raw)))))) + +(defclass pollitem () + ((raw :accessor pollitem-raw :initform nil) + (socket :accessor pollitem-socket :initform nil :initarg :socket) + (fd :accessor pollitem-fd :initform -1 :initarg :fd) + (events :accessor pollitem-events :initform 0 :initarg :events) + (revents :accessor pollitem-revents :initform 0))) + +(defmethod initialize-instance :after ((inst pollitem) &key) + (let ((obj (foreign-alloc 'pollitem))) + (setf (pollitem-raw inst) obj) + (tg:finalize inst (lambda () (foreign-free obj))))) + +(defun bind (s address) + (with-foreign-string (addr address) + (%bind s addr))) + +(defun connect (s address) + (with-foreign-string (addr address) + (%connect s addr))) + +(defmacro with-context ((context app-threads io-threads &optional flags) &body body) + `(let ((,context (init ,app-threads ,io-threads (or ,flags 0)))) + ,@body + (term ,context))) + +(defmacro with-socket ((socket context type) &body body) + `(let ((,socket (socket ,context ,type))) + ,@body + (close ,socket))) + +(defmacro with-stopwatch (&body body) + (let ((watch (gensym))) + `(with-foreign-object (,watch :long 2) + (setq ,watch (stopwatch-start)) + ,@body + (stopwatch-stop ,watch)))) + +(defun msg-data-as-is (msg) + (%msg-data (msg-raw msg))) + +(defun msg-data-as-string (msg) + (let ((data (%msg-data (msg-raw msg)))) + (unless (zerop (pointer-address data)) + (convert-from-foreign data :string)))) + +(defun msg-data-as-array (msg) + (let ((data (%msg-data (msg-raw msg)))) + (unless (zerop (pointer-address data)) + (let* ((len (msg-size msg)) + (arr (make-array len :element-type '(unsigned-byte)))) + (dotimes (i len) + (setf (aref arr i) (mem-aref data :uchar i))) + arr)))) + +(defun send (s msg &optional flags) + (%send s (msg-raw msg) (or flags 0))) + +(defun recv (s msg &optional flags) + (%recv s (msg-raw msg) (or flags 0))) + +(defun msg-init-size (msg size) + (%msg-init-size (msg-raw msg) size)) + +(defun msg-close (msg) + (%msg-close (msg-raw msg))) + +(defun msg-size (msg) + (%msg-size (msg-raw msg))) + +(defun msg-move (dst src) + (%msg-move (msg-raw dst) (msg-raw src))) + +(defun msg-copy (dst src) + (%msg-copy (msg-raw dst) (msg-raw src))) + +(defun setsockopt (socket option value) + (etypecase value + (string (with-foreign-string (string value) + (%setsockopt socket option string (length value)))) + (integer (with-foreign-object (int :long 2) + (setf (mem-aref int :long 0) value) + (%setsockopt socket option int (foreign-type-size :long)))))) + +(defun poll (items) + (let ((len (length items))) + (with-foreign-object (%items 'pollitem len) + (dotimes (i len) + (let ((item (nth i items)) + (%item (mem-aref %items 'pollitem i))) + (with-foreign-slots ((socket fd events revents) %item pollitem) + (setf socket (pollitem-socket item) + fd (pollitem-fd item) + events (pollitem-events item))))) + (let ((ret (%poll %items len))) + (if (> ret 0) + (loop for i below len + for revent = (foreign-slot-value (mem-aref %items 'pollitem i) + 'pollitem + 'revents) + collect (setf (pollitem-revents (nth i items)) revent)) + (error (convert-from-foreign (%strerror *errno*) :string))))))) + +(defmacro with-polls (list &body body) + `(let ,(loop for (name . polls) in list + collect `(,name + (list + ,@(loop for (socket . events) in polls + collect `(make-instance 'pollitem + :socket ,socket + :events ,events))))) + ,@body)) + +; diff --git a/bindings/cl/zeromq.asd b/bindings/cl/zeromq.asd new file mode 100644 index 0000000..3aa8d5e --- /dev/null +++ b/bindings/cl/zeromq.asd @@ -0,0 +1,38 @@ +;; Copyright (c) 2009 Vitaly Mayatskikh <v.mayatskih@gmail.com> +;; +;; This file is part of 0MQ. +;; +;; 0MQ is free software; you can redistribute it and/or modify it under +;; the terms of the Lesser GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; 0MQ is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; Lesser GNU General Public License for more details. +;; +;; You should have received a copy of the Lesser GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +(cl:eval-when (:load-toplevel :execute) + (asdf:operate 'asdf:load-op :cffi) + (asdf:operate 'asdf:load-op :trivial-garbage) + (asdf:operate 'asdf:load-op :iolib.syscalls)) + +(defpackage #:zeromq-asd + (:use :cl :asdf)) + +(in-package #:zeromq-asd) + +(defsystem zeromq + :name "zeromq" + :version "0.1" + :author "Vitaly Mayatskikh <v.mayatskih@gmail.com>" + :licence "LGPLv3" + :description "Zero MQ 2 bindings" + :serial t + :components ((:file "package") + (:file "meta") + (:file "zeromq") + (:file "zeromq-api"))) diff --git a/bindings/cl/zeromq.lisp b/bindings/cl/zeromq.lisp new file mode 100644 index 0000000..94f7672 --- /dev/null +++ b/bindings/cl/zeromq.lisp @@ -0,0 +1,244 @@ +;; Copyright (c) 2009 Vitaly Mayatskikh <v.mayatskih@gmail.com> +;; +;; This file is part of 0MQ. +;; +;; 0MQ is free software; you can redistribute it and/or modify it under +;; the terms of the Lesser GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. +;; +;; 0MQ is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; Lesser GNU General Public License for more details. +;; +;; You should have received a copy of the Lesser GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +(in-package :zeromq) + +(defcvar "errno" :int) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 0MQ errors. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconstant hausnumero 156384712) + +;; On Windows platform some of the standard POSIX errnos are not defined. +;; #ifndef ENOTSUP +;; #define ENOTSUP (ZMQ_HAUSNUMERO + 1) +;; #endif +;; #ifndef EPROTONOSUPPORT +;; #define EPROTONOSUPPORT (ZMQ_HAUSNUMERO + 2) +;; #endif +;; #ifndef ENOBUFS +;; #define ENOBUFS (ZMQ_HAUSNUMERO + 3) +;; #endif +;; #ifndef ENETDOWN +;; #define ENETDOWN (ZMQ_HAUSNUMERO + 4) +;; #endif +;; #ifndef EADDRINUSE +;; #define EADDRINUSE (ZMQ_HAUSNUMERO + 5) +;; #endif +;; #ifndef EADDRNOTAVAIL +;; #define EADDRNOTAVAIL (ZMQ_HAUSNUMERO + 6) +;; #endif + +;; Native 0MQ error codes. +(defconstant emthread (+ hausnumero 50)) +(defconstant efsm (+ hausnumero 51)) +(defconstant enocompatproto (+ hausnumero 52)) + +(defcfun ("zmq_strerror" %strerror) :pointer + (errnum :int)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 0MQ message definition. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconstant max-vsm-size 30) + +;; Message types. These integers may be stored in 'content' member of the +;; message instead of regular pointer to the data. +(defconstant delimiter 31) +(defconstant vsm 32) + +(defcstruct (msg) + (content :pointer) + (shared :uchar) + (vsm-size :uchar) + (vsm-data :uchar :count 30)) ;; FIXME max-vsm-size + +(defcfun ("zmq_msg_init" msg-init) :int + (msg msg)) + +(defcfun* ("zmq_msg_init_size" %msg-init-size) :int + (msg msg) + (size :long)) + +(defcallback zmq-free :void ((ptr :pointer)) + (foreign-free ptr)) + +;;typedef void (zmq_free_fn) (void *data); +(defcfun ("zmq_msg_init_data" msg-init-data) :int + (msg msg) + (data :pointer) + (size :long) + (ffn :pointer)) ; zmq_free_fn + +(defcfun* ("zmq_msg_close" %msg-close) :int + (msg msg)) + +(defcfun ("zmq_msg_move" %msg-move) :int + (dest msg) + (src msg)) + +(defcfun ("zmq_msg_copy" %msg-copy) :int + (dest msg) + (src msg)) + +(defcfun ("zmq_msg_data" %msg-data) :pointer + (msg msg)) + +(defcfun ("zmq_msg_size" %msg-size) :int + (msg msg)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 0MQ infrastructure (a.k.a. context) initialisation & termination. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconstant poll 1) + +(defcfun* ("zmq_init" init) :pointer + (app-threads :int) + (io-threads :int) + (flags :int)) + +(defcfun ("zmq_term" term) :int + (context :pointer)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 0MQ socket definition. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Creating a 0MQ socket. +;; ********************** + +(defconstant p2p 0) +(defconstant pub 1) +(defconstant sub 2) +(defconstant req 3) +(defconstant rep 4) +(defconstant upstream 5) +(defconstant downstream 6) + +(defcfun* ("zmq_socket" socket) :pointer + (context :pointer) + (type :int)) + +;; Destroying the socket. +;; ********************** + +(defcfun ("zmq_close" close) :int + (s :pointer)) + +;; Manipulating socket options. +;; **************************** + +;; Available socket options, their types and default values. + +(defconstant hwm 1) +(defconstant lwm 2) +(defconstant swap 3) +(defconstant affinity 4) +(defconstant identity 5) +(defconstant subscribe 6) +(defconstant unsubscribe 7) +(defconstant rate 8) +(defconstant recovery-ivl 9) +(defconstant mcast-loop 10) + +(defcfun* ("zmq_setsockopt" %setsockopt) :int + (s :pointer) + (option :int) + (optval :pointer) + (optvallen :long)) + +;; Creating connections. +;; ********************* + +;; Addresses are composed of the name of the protocol to use followed by :// +;; and a protocol-specific address. Available protocols: +;; +;; tcp - the address is composed of IP address and port delimited by colon +;; sign (:). The IP address can be a hostname (with 'connect') or +;; a network interface name (with 'bind'). Examples "tcp://eth0:5555", +;; "tcp://192.168.0.1:20000", "tcp://hq.mycompany.com:80". +;; +;; pgm & udp - both protocols have same address format. It's network interface +;; to use, semicolon (;), multicast group IP address, colon (:) and +;; port. Examples: "pgm://eth2;224.0.0.1:8000", +;; "udp://192.168.0.111;224.1.1.1:5555". + +(defcfun* ("zmq_bind" %bind) :int + (s :pointer) + (addr :pointer :char)) + +(defcfun* ("zmq_connect" %connect) :int + (s :pointer) + (addr :pointer :char)) + +;; Sending and receiving messages. +;; ******************************* + +(defconstant noblock 1) + +(defconstant noflush 2) + +(defcfun* ("zmq_send" %send) :int + (s :pointer) + (msg msg) + :optional + (flags :int)) + +(defcfun* ("zmq_flush" flush) :int + (s :pointer)) + +(defcfun* ("zmq_recv" %recv) :int + (s :pointer) + (msg msg) + :optional + (flags :int)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; I/O multiplexing. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconstant pollin 1) +(defconstant pollout 2) + +(defcstruct pollitem + (socket :pointer) + (fd :int) + (events :short) + (revents :short)) + +(defcfun ("zmq_poll" %poll) :int + (items :pointer) + (nitems :int)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Helper functions. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Helper functions used by perf tests so that they don't have to care +;; about minutiae of time-related functions on different OS platforms. + +(defcfun ("zmq_stopwatch_start" stopwatch-start) :pointer) + +(defcfun ("zmq_stopwatch_stop" stopwatch-stop) :ulong + (watch :pointer)) + +(defcfun ("zmq_sleep" sleep) :void + (seconds :int)) |