common lisp binding & perf tests added

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))