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 | 180 | ||||
| -rw-r--r-- | bindings/cl/zeromq.asd | 38 | ||||
| -rw-r--r-- | bindings/cl/zeromq.lisp | 250 |
6 files changed, 0 insertions, 644 deletions
diff --git a/bindings/cl/Makefile.am b/bindings/cl/Makefile.am deleted file mode 100644 index 034d1f4..0000000 --- a/bindings/cl/Makefile.am +++ /dev/null @@ -1,9 +0,0 @@ -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 deleted file mode 100644 index 751a089..0000000 --- a/bindings/cl/meta.lisp +++ /dev/null @@ -1,59 +0,0 @@ -;; 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 deleted file mode 100644 index 89713b1..0000000 --- a/bindings/cl/package.lisp +++ /dev/null @@ -1,108 +0,0 @@ -;; 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 deleted file mode 100644 index 44d725b..0000000 --- a/bindings/cl/zeromq-api.lisp +++ /dev/null @@ -1,180 +0,0 @@ -;; 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) - -;; Stolen from CFFI. Uses custom allocator (alloc-fn) instead of foreign-alloc -(defun copy-lisp-string-octets (string alloc-fn &key (encoding cffi::*default-foreign-encoding*) - (null-terminated-p t) (start 0) end) - "Allocate a foreign string containing Lisp string STRING. -The string must be freed with FOREIGN-STRING-FREE." - (check-type string string) - (cffi::with-checked-simple-vector ((string (coerce string 'babel:unicode-string)) - (start start) (end end)) - (declare (type simple-string string)) - (let* ((mapping (cffi::lookup-mapping cffi::*foreign-string-mappings* encoding)) - (count (funcall (cffi::octet-counter mapping) string start end 0)) - (length (if null-terminated-p - (+ count (cffi::null-terminator-len encoding)) - count)) - (ptr (funcall alloc-fn length))) - (funcall (cffi::encoder mapping) string start end ptr 0) - (when null-terminated-p - (dotimes (i (cffi::null-terminator-len encoding)) - (setf (mem-ref ptr :char (+ count i)) 0))) - (values ptr length)))) - -(defclass msg () - ((raw :accessor msg-raw :initform nil))) - -(defmethod initialize-instance :after ((inst msg) &key size data) - (let ((obj (foreign-alloc 'msg))) - (tg:finalize inst (lambda () - (%msg-close obj) - (foreign-free obj))) - (cond (size (%msg-init-size obj size)) - (data - (etypecase data - (string (copy-lisp-string-octets - data (lambda (sz) - (%msg-init-size obj sz) - (%msg-data obj)))) - (array (progn - (%msg-init-size obj (length data)) - (let ((ptr (%msg-data obj)) - (i -1)) - (map nil (lambda (x) - (setf (mem-aref ptr :uchar (incf i)) x)) - data)))))) - (t (msg-init obj))) - (setf (msg-raw inst) obj))) - -(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 &optional (timeout -1)) - (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 timeout))) - (cond - ((zerop ret) nil) - ((> 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))) - (t (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 deleted file mode 100644 index 3aa8d5e..0000000 --- a/bindings/cl/zeromq.asd +++ /dev/null @@ -1,38 +0,0 @@ -;; 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 deleted file mode 100644 index 217b97c..0000000 --- a/bindings/cl/zeromq.lisp +++ /dev/null @@ -1,250 +0,0 @@ -;; 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) (hint :pointer)) - (declare (ignorable hint)) - (foreign-free ptr)) - -(defcfun ("zmq_msg_init_data" msg-init-data) :int - (msg msg) - (data :pointer) - (size :long) - (ffn :pointer) ; zmq_free_fn - (hint :pointer)) - -(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 xreq 5) -(defconstant xrep 6) -(defconstant upstream 7) -(defconstant downstream 8) - -(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) -(defconstant sndbuf 11) -(defconstant rcvbuf 12) - -(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) - (timeout :long)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 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)) |