common-lisp: tutorial six code

Author: deadtrickster

common-lisp/rpc-client.lisp

@@ -0,0 +1,46 @@
+#!/bin/sh
+
+sbcl --noinform --noprint <<EOF
+
+(ql:quickload :cl-bunny.examples)
+(ql:quickload :nibbles)
+
+(in-package :cl-bunny.examples)
+
+(defun int64-to-octets(val)
+ (let ((obuffer (fast-io:make-output-buffer)))
+ (fast-io:write64-be val obuffer)
+ (fast-io:finish-output-buffer obuffer)))
+
+(defun start-client (n)
+ (with-connection ("amqp://")
+ (with-channel ()
+ (let ((x (exchange.default))
+ (server-queue "rpc_queue")
+ (reply-queue (queue.declare :auto-delete t))
+ (lock (bt:make-lock))
+ (condition (bt:make-condition-variable))
+ (result nil))
+ (format t " [x] Requesting fib(~a)~%" n)
+ (bt:with-lock-held (lock)
+ (subscribe reply-queue (lambda (message)
+ (bt:with-lock-held (lock)
+ (setf result (nibbles:sb64ref/be (message-body message) 0))
+ (bt:condition-notify condition))))
+ (publish x
+ (int64-to-octets n)
+ :routing-key server-queue
+ :properties (list :correlation-id (format nil "~a~a~a" (random 100) (random 100) (random 100))
+ :reply-to reply-queue))
+ (bt:condition-wait condition lock)
+ (format t " [.] Got ~a~%" result)
+ result)))))
+
+(start-client 0)
+(start-client 1)
+(start-client 22)
+(start-client 33)
+(start-client 44)
+(start-client 55)
+
+EOF

common-lisp/rpc-server.lisp

@@ -0,0 +1,54 @@
+#!/bin/sh
+
+sbcl --noinform --noprint <<EOF
+
+(ql:quickload :cl-bunny.examples)
+(ql:quickload :nibbles)
+
+(in-package :cl-bunny.examples)
+
+(defun int64-to-octets(val)
+ (let ((obuffer (fast-io:make-output-buffer)))
+ (fast-io:write64-be val obuffer)
+ (fast-io:finish-output-buffer obuffer)))
+
+;; http://www.cliki.net/fibonacci
+(defun fibonacci (n)
+ "Successive squaring method from SICP"
+ (check-type n (integer 0 *))
+ (labels ((fib-aux (a b p q count)
+ (cond ((= count 0) b)
+ ((evenp count)
+ (fib-aux a
+ b
+ (+ (* p p) (* q q))
+ (+ (* q q) (* 2 p q))
+ (/ count 2)))
+ (t (fib-aux (+ (* b q) (* a q) (* a p))
+ (+ (* b p) (* a q))
+ p
+ q
+ (- count 1))))))
+ (fib-aux 1 0 0 1 n)))
+
+(with-connection ()
+ (with-channel ()
+ (let ((x (exchange.default))
+ (q (queue.declare :name "rpc_queue" :auto-delete t)))
+ (format t " [x] Awaiting RPC requests~%")
+ (handler-case
+ (progn
+ (subscribe q (lambda (message)
+ (let* ((n (nibbles:sb64ref/be (message-body message) 0))
+ (r (fibonacci n)))
+ (format t " [.] fib(~a)~%" r)
+ (publish x
+ (int64-to-octets r)
+ :routing-key (message-reply-to message)
+ :properties (list :correlation-id (message-correlation-id message)))))
+ :type :sync)
+ (consume))
+ (sb-sys:interactive-interrupt ()
+ (sb-ext:exit))))))
+
+EOF