Under the MIT/X11 license. -- --ska
From 19702d2ea70d056e06d0d84b9041932509c5cd78 Mon Sep 17 00:00:00 2001 From: Kamil Shakirov <[email protected]> Date: Thu, 14 Oct 2010 19:15:25 +0700 Subject: [PATCH] Add lruqueue.lisp example.
--- examples/Common Lisp/.gitignore | 1 + examples/Common Lisp/lruqueue.asd | 22 ++++++ examples/Common Lisp/lruqueue.lisp | 143 +++++++++++++++++++++++++++++++++--- examples/Common Lisp/zhelpers.lisp | 34 ++++++++- 4 files changed, 186 insertions(+), 14 deletions(-) create mode 100644 examples/Common Lisp/lruqueue.asd diff --git a/examples/Common Lisp/.gitignore b/examples/Common Lisp/.gitignore index d7afe5a..a005b64 100644 --- a/examples/Common Lisp/.gitignore +++ b/examples/Common Lisp/.gitignore @@ -1,5 +1,6 @@ # ignore file +/lruqueue /rtpapa /rtmama /rtdealer diff --git a/examples/Common Lisp/lruqueue.asd b/examples/Common Lisp/lruqueue.asd new file mode 100644 index 0000000..1d83f7c --- /dev/null +++ b/examples/Common Lisp/lruqueue.asd @@ -0,0 +1,22 @@ +;;; -*- Mode:Lisp; Syntax:ANSI-Common-Lisp; -*- +;;; +;;; Least-recently used (LRU) queue device in Common Lisp +;;; +;;; Kamil Shakirov <[email protected]> +;;; + +(defpackage #:zguide.lruqueue.asd + (:use #:cl #:asdf)) + +(in-package :zguide.lruqueue.asd) + +(defsystem lruqueue + :version "0.0.0" + :description "Least-recently used (LRU) queue device in Common Lisp." + :maintainer "Kamil Shakirov <[email protected]>" + :author "Kamil Shakirov <[email protected]>" + :licence "MIT/X11" + :depends-on (:zeromq :bordeaux-threads) + :serial t + :components ((:file "zhelpers") + (:file "lruqueue" :depends-on ("zhelpers")))) diff --git a/examples/Common Lisp/lruqueue.lisp b/examples/Common Lisp/lruqueue.lisp index 985f342..37dd31e 100644 --- a/examples/Common Lisp/lruqueue.lisp +++ b/examples/Common Lisp/lruqueue.lisp @@ -1,13 +1,136 @@ -No-one has translated the lruqueue example into Common Lisp yet. Be the first to create -lruqueue in Common Lisp and get one free Internet! If you're the author of the Common Lisp -binding, this is a great way to get people to use 0MQ in Common Lisp. +;;; -*- Mode:Lisp; Syntax:ANSI-Common-Lisp; -*- +;;; +;;; Least-recently used (LRU) queue device in Common Lisp +;;; Clients and workers are shown here in-process +;;; +;;; Kamil Shakirov <[email protected]> +;;; -To submit a new translation email it to [email protected]. Please: +(defpackage #:zguide.lruqueue + (:nicknames #:lruqueue) + (:use #:cl #:zhelpers) + (:export #:main)) -* Stick to identical functionality and naming used in examples so that readers - can easily compare languages. -* You MUST place your name as author in the examples so readers can contact you. -* You MUST state in the email that you license your code under the MIT/X11 - license. +(in-package :zguide.lruqueue) -Subscribe to this list at http://lists.zeromq.org/mailman/listinfo/zeromq-dev. +(defparameter *number-clients* 10) +(defparameter *number-workers* 3) + +;; Basic request-reply client using REQ socket +(defun client-thread (context) + (zmq:with-socket (client context zmq:req) + (set-socket-id client) ; Makes tracing easier + (zmq:connect client "ipc://frontend.ipc") + + ;; Send request, get reply + (send-text client "HELLO") + (let ((reply (recv-text client))) + (message "Client: ~A~%" reply)))) + +;; Worker using REQ socket to do LRU routing +(defun worker-thread (context) + (zmq:with-socket (worker context zmq:req) + (set-socket-id worker) ; Makes tracing easier + (zmq:connect worker "ipc://backend.ipc") + + ;; Tell broker we're ready for work + (send-text worker "READY") + + ;; Ignore errors and exit when the context gets terminated + (ignore-errors + (loop + ;; Read and save all frames until we get an empty frame + ;; In this example there is only 1 but it could be more + (let ((address (recv-text worker))) + (recv-text worker) ; empty + + ;; Get request, send reply + (let ((request (recv-text worker))) + (message "Worker: ~A~%" request) + + (send-more-text worker address) + (send-more-text worker "") + (send-text worker "OK"))))))) + +(defun main () + ;; Prepare our context and sockets + (zmq:with-context (context 1) + (zmq:with-socket (frontend context zmq:xrep) + (zmq:with-socket (backend context zmq:xrep) + (zmq:bind frontend "ipc://frontend.ipc") + (zmq:bind backend "ipc://backend.ipc") + + (dotimes (i *number-clients*) + (bt:make-thread (lambda () (client-thread context)) + :name (format nil "client-thread-~D" i))) + (dotimes (i *number-workers*) + (bt:make-thread (lambda () (worker-thread context)) + :name (format nil "worker-thread-~D" i))) + + ;; Logic of LRU loop + ;; - Poll backend always, frontend only if 1+ worker ready + ;; - If worker replies, queue worker as ready and forward reply + ;; to client if necessary + ;; - If client requests, pop next worker and send request to it + + ;; Queue of available workers + (let ((number-clients *number-clients*) + (available-workers 0) + (worker-queue (make-queue))) + (loop + ;; Initialize poll set + (zmq:with-polls + ((items2 . + ;; Always poll for worker activity on backend + ((backend . zmq:pollin) + (frontend . zmq:pollin))) + (items1 . + ;; Poll front-end only if we have available workers + ((backend . zmq:pollin)))) + (let ((revents + (if (zerop available-workers) + (zmq:poll items1) + (zmq:poll items2)))) + + ;; Handle worker activity on backend + (when (= (first revents) zmq:pollin) + ;; Queue worker address for LRU routing + (let ((worker-addr (recv-text backend))) + (assert (< available-workers *number-workers*)) + (enqueue worker-queue worker-addr) + (incf available-workers)) + + ;; Second frame is empty + (recv-text backend) ; empty + + ;; Third frame is READY or else a client reply address + (let ((client-addr (recv-text backend))) + (when (string/= client-addr "READY") + (recv-text backend) ; empty + + (let ((reply (recv-text backend))) + (send-more-text frontend client-addr) + (send-more-text frontend "") + (send-text frontend reply)) + + (when (zerop (decf number-clients)) + (return))))) + + (when (and (cdr revents) + (= (second revents) zmq:pollin)) + ;; Now get next client request, route to LRU worker + ;; Client request is [address][empty][request] + (let ((client-addr (recv-text frontend))) + (recv-text frontend) ; empty + + (let ((request (recv-text frontend))) + (send-more-text backend (dequeue worker-queue)) + (send-more-text backend "") + (send-more-text backend client-addr) + (send-more-text backend "") + (send-text backend request)) + + (decf available-workers))))))))) + (sleep 2)) + + (cleanup)) diff --git a/examples/Common Lisp/zhelpers.lisp b/examples/Common Lisp/zhelpers.lisp index b1b234d..8021969 100644 --- a/examples/Common Lisp/zhelpers.lisp +++ b/examples/Common Lisp/zhelpers.lisp @@ -2,8 +2,12 @@ ;;; ;;; Helpers for example applications ;;; -;;; 'with-stopwatch' macro is taken from 'cl-zmq' -;;; by Vitaly Mayatskikh <[email protected]> +;;; 'with-stopwatch' macro is taken from 'cl-zmq' by Vitaly Mayatskikh +;;; <[email protected]> +;;; +;;; A simple, but efficient, queue implementation was originally written by +;;; Peter Keller ([email protected]) and is released under the same license +;;; as IOLib. ;;; ;;; Kamil Shakirov <[email protected]> ;;; @@ -23,7 +27,11 @@ #:send-more-text #:dump-message #:dump-socket - #:with-stopwatch)) + #:with-stopwatch + #:make-queue + #:enqueue + #:dequeue + #:empty-queue-p)) (in-package :zguide.zhelpers) @@ -39,7 +47,9 @@ nil))) (defun message (fmt &rest args) - (apply #'format t fmt args) + (let ((new-fmt (format nil "[~A] ~A" + (bt:thread-name (bt:current-thread)) fmt))) + (apply #'format t new-fmt args)) (finish-output)) (defun cleanup () @@ -131,3 +141,19 @@ (isys:gettimeofday) (+ (* 1e6 (- ,sec1 ,sec0)) ,usec1 (- ,usec0)))))) + +(defun make-queue () + (cons nil nil)) + +(defun enqueue (q obj) + (if (null (car q)) + (setf (cdr q) (setf (car q) (list obj))) + (setf (cdr (cdr q)) (list obj) + (cdr q) (cdr (cdr q)))) + (car q)) + +(defun dequeue (q) + (pop (car q))) + +(defun empty-queue-p (q) + (null (car q))) -- 1.7.0.4
_______________________________________________ zeromq-dev mailing list [email protected] http://lists.zeromq.org/mailman/listinfo/zeromq-dev
