- nio-cvs@common-lisp.net - mailman3.common-lisp.net

[nio-cvs] r45 - in branches/home/psmith/restructure: . src/protocol/yarpc
by psmith＠common-lisp.net 19 Jan '07

19 Jan '07

Author: psmith Date: Thu Jan 18 21:07:22 2007 New Revision: 45 Modified: branches/home/psmith/restructure/TODO branches/home/psmith/restructure/run-yarpc.lisp branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Log: Allowed yarpc server to do RPC calls inline if configured so Modified: branches/home/psmith/restructure/TODO ============================================================================== --- branches/home/psmith/restructure/TODO (original) +++ branches/home/psmith/restructure/TODO Thu Jan 18 21:07:22 2007 @@ -12,3 +12,7 @@ Create UDP server Create RPC server / client + +Non blocking connects + +Allow large packets Modified: branches/home/psmith/restructure/run-yarpc.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc.lisp (original) +++ branches/home/psmith/restructure/run-yarpc.lisp Thu Jan 18 21:07:22 2007 @@ -1,11 +1,11 @@ +;Runs a multithreaded system with an IO thread dealing with IO only and a 'job' thread taking and executing jobs + ;(push :nio-debug *features*) (require :asdf) (require :nio-yarpc) +(setf nio-yarpc:+process-jobs-inline+ nil) (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity 'nio-yarpc:yarpc-state-machine :host "127.0.0.1")) :name "nio-server") (loop ;;block waiting for jobs - (format t "~A Server toplevel waiting for job~%" (nio-compat:get-readable-time)) - (destructuring-bind (job result-queue) (nio-compat:take nio-yarpc:job-queue) - (format t "~A Server received job ~A~%" (nio-compat:get-readable-time) job) - (nio-compat:add result-queue (nio-yarpc:execute-call job)))) + (nio-yarpc:run-job)) Modified: branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp Thu Jan 18 21:07:22 2007 @@ -32,7 +32,7 @@ yarpc-state-machine-factory get-packet-factory ;; yarpc-state-machine - yarpc-state-machine job-queue + yarpc-state-machine job-queue run-job +process-jobs-inline+ ;to be moved test-rpc test-rpc-list test-rpc-string execute-call Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Thu Jan 18 21:07:22 2007 @@ -1,4 +1,4 @@ -#| +\#| Copyright (c) 2007 All rights reserved. @@ -52,6 +52,19 @@ (defconstant STATE-INITIALISED 0) (defconstant STATE-SEND-RESPONSE 1) + +(defparameter +process-jobs-inline+ t + "Set this to make the NIO thread process the RPC calls - warning the procedure should not block!") + + + +(defun run-job(&key (wait-on-job-pdw t)) + (format t "~A Server toplevel waiting for job~%" (nio-compat:get-readable-time)) + (destructuring-bind (job result-queue) (nio-compat:take nio-yarpc:job-queue :blocking-call wait-on-job-pdw) + (format t "~A Server received job ~A~%" (nio-compat:get-readable-time) job) + (nio-compat:add result-queue (nio-yarpc:execute-call job)))) + + (defmethod process-outgoing-packet((sm yarpc-state-machine)) (format t "yarpc-state-machine: process-outgoing-packet called, polling the results-queue ~%") (let ((result (nio-compat:take (result-queue sm) :blocking-call nil))) @@ -63,7 +76,8 @@ (defmethod process-incoming-packet ((sm yarpc-state-machine) (call call-method-packet)) (assert (eql (state sm) STATE-INITIALISED)) (format t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm call) - (nio-compat:add job-queue (list (call-string call) (result-queue sm)))) + (nio-compat:add job-queue (list (call-string call) (result-queue sm))) + (when +process-jobs-inline+ (run-job :wait-on-job-pdw nil)))

1 0

[nio-cvs] r44 - in branches/home/psmith/restructure: . src/buffer src/compat src/io src/protocol/yarpc src/statemachine
by psmith＠common-lisp.net 19 Jan '07

19 Jan '07

Author: psmith Date: Thu Jan 18 19:11:08 2007 New Revision: 44 Added: branches/home/psmith/restructure/src/compat/utils.lisp Modified: branches/home/psmith/restructure/run-yarpc-client.lisp branches/home/psmith/restructure/run-yarpc.lisp branches/home/psmith/restructure/src/buffer/buffer.lisp branches/home/psmith/restructure/src/compat/nio-compat-package.lisp branches/home/psmith/restructure/src/compat/nio-compat.asd branches/home/psmith/restructure/src/io/async-fd.lisp branches/home/psmith/restructure/src/io/nio-server.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp branches/home/psmith/restructure/src/statemachine/state-machine.lisp Log: Moved verbose messages to nio-debug Modified: branches/home/psmith/restructure/run-yarpc-client.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc-client.lisp (original) +++ branches/home/psmith/restructure/run-yarpc-client.lisp Thu Jan 18 19:11:08 2007 @@ -1,4 +1,4 @@ -(push :nio-debug *features*) +;(push :nio-debug *features*) (require :asdf) (require :nio-yarpc) @@ -6,7 +6,7 @@ (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity nil :host "127.0.0.1" :port 9897)) :name "nio-server") (sleep 4) (let ((sm (nio:add-connection "127.0.0.1" 16323 'nio-yarpc:yarpc-client-state-machine))) - -(loop - (format t "toplevel adding conn ~A~%" sm) - (format t "Result of remote-execute ~A~%" (nio-yarpc:remote-execute sm "(nio-yarpc:test-rpc-list)")))) + (format t "~A toplevel adding conn ~A~%" (nio-compat:get-readable-time) sm) + (loop + (format t "~A toplevel Submitting job~%" (nio-compat:get-readable-time) ) + (format t "~A Result of remote-execute ~A~%" (nio-compat:get-readable-time) (nio-yarpc:remote-execute sm "(nio-yarpc:test-rpc-list)")))) Modified: branches/home/psmith/restructure/run-yarpc.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc.lisp (original) +++ branches/home/psmith/restructure/run-yarpc.lisp Thu Jan 18 19:11:08 2007 @@ -1,11 +1,11 @@ -(push :nio-debug *features*) +;(push :nio-debug *features*) (require :asdf) (require :nio-yarpc) (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity 'nio-yarpc:yarpc-state-machine :host "127.0.0.1")) :name "nio-server") (loop ;;block waiting for jobs - (format t "Server toplevel waiting for job~%" ) + (format t "~A Server toplevel waiting for job~%" (nio-compat:get-readable-time)) (destructuring-bind (job result-queue) (nio-compat:take nio-yarpc:job-queue) - (format t "Server received job ~A~%" job) + (format t "~A Server received job ~A~%" (nio-compat:get-readable-time) job) (nio-compat:add result-queue (nio-yarpc:execute-call job)))) Modified: branches/home/psmith/restructure/src/buffer/buffer.lisp ============================================================================== --- branches/home/psmith/restructure/src/buffer/buffer.lisp (original) +++ branches/home/psmith/restructure/src/buffer/buffer.lisp Thu Jan 18 19:11:08 2007 @@ -159,13 +159,13 @@ ;; Write bytes from vector vec to bytebuffer (defmethod bytebuffer-write-vector((bb byte-buffer) vec) :documentation "Returns number of bytes written to bytebuffer" - (format t "bytebuffer-write-vector - called with ~A ~A"bb vec) +#+nio-debug (format t "bytebuffer-write-vector - called with ~A ~A"bb vec) ; (if (> (remaining bb) 0) ; 0 (progn ; (clear bb) (let ((bytes-written (cffi:mem-write-vector vec (buffer-buf bb) :unsigned-char (length vec) (buffer-position bb)))) - (format t "bytebuffer-write-vector - byteswritten: ~A~%" bytes-written) +#+nio-debug (format t "bytebuffer-write-vector - byteswritten: ~A~%" bytes-written) (inc-position bb bytes-written) bytes-written))) ;) Modified: branches/home/psmith/restructure/src/compat/nio-compat-package.lisp ============================================================================== --- branches/home/psmith/restructure/src/compat/nio-compat-package.lisp (original) +++ branches/home/psmith/restructure/src/compat/nio-compat-package.lisp Thu Jan 18 19:11:08 2007 @@ -33,4 +33,7 @@ ;;concurrent-queue concurrent-queue add take + + ;;utils + get-readable-time )) Modified: branches/home/psmith/restructure/src/compat/nio-compat.asd ============================================================================== --- branches/home/psmith/restructure/src/compat/nio-compat.asd (original) +++ branches/home/psmith/restructure/src/compat/nio-compat.asd Thu Jan 18 19:11:08 2007 @@ -7,6 +7,7 @@ :components ((:file "nio-compat-package") (:file "errno" :depends-on ("nio-compat-package")) (:file "concurrent-queue" :depends-on ("nio-compat-package")) + (:file "utils" :depends-on ("nio-compat-package")) ) :depends-on ()) Added: branches/home/psmith/restructure/src/compat/utils.lisp ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/src/compat/utils.lisp Thu Jan 18 19:11:08 2007 @@ -0,0 +1,38 @@ +#| +Copyright (c) 2007 +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. The name of the author may not be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +|# + +(in-package :nio-compat) + +(declaim (optimize (debug 3) (speed 3) (space 0))) + +(defun get-readable (format-string &optional (time (get-universal-time))) + (multiple-value-bind (second minute hour date month year) (decode-universal-time time) + (with-output-to-string (out) + (format out format-string year month date hour minute second)))) + +(defun get-readable-time ( &optional (time (get-universal-time))) + (get-readable "~A/~2,'0d/~2,'0d ~2,'0d:~2,'0d:~2,'0d" time)) Modified: branches/home/psmith/restructure/src/io/async-fd.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/async-fd.lisp (original) +++ branches/home/psmith/restructure/src/io/async-fd.lisp Thu Jan 18 19:11:08 2007 @@ -110,7 +110,7 @@ ;; "Read more data from STATE-MACHINE." (defun read-more (state-machine) (with-slots (foreign-read-buffer read-fd) state-machine - (format t "read-more called with ~A~%" state-machine) +#+nio-debug (format t "read-more called with ~A~%" state-machine) #+nio-debug (format t "read-more - calling read() into ~A~%" foreign-read-buffer) (let ((new-bytes (%read read-fd (buffer-buf foreign-read-buffer) (remaining foreign-read-buffer)))) Modified: branches/home/psmith/restructure/src/io/nio-server.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/nio-server.lisp (original) +++ branches/home/psmith/restructure/src/io/nio-server.lisp Thu Jan 18 19:11:08 2007 @@ -90,7 +90,7 @@ (catch 'poll-error-exit (handler-bind ((poll-error #'(lambda (cond) (declare (ignore cond)) - (format t "Poll-error, exiting..~%") + (format t "Poll-error (errno ~A), exiting..~%" (get-errno)) (throw 'poll-error-exit nil)))) (loop Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp Thu Jan 18 19:11:08 2007 @@ -59,11 +59,11 @@ (format stream "#<CALL-METHOD-PACKET ~A >" (call-string packet))) (defmethod write-bytes((packet call-method-packet) buf) - (format t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf) -; (nio-buffer:flip buf) +#+nio-debug (format t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf) (nio-buffer:bytebuffer-write-vector buf #(#x0)) (nio-buffer:bytebuffer-write-string buf (call-string packet)) - (format t "yarpc-packet-factory:write-bytes - written ~A~%" buf) ) +#+nio-debug (format t "yarpc-packet-factory:write-bytes - written ~A~%" buf) +) (defclass method-response-packet (packet) @@ -77,7 +77,8 @@ (format stream "#<METHID-RESPONSE-PACKET ~A >" (response packet))) (defmethod write-bytes((packet method-response-packet) buf) - (format t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf) +#+nio-debug (format t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf) (nio-buffer:bytebuffer-write-vector buf #(#x1)) (nio-buffer:bytebuffer-write-string buf (write-to-string (response packet))) - (format t "yarpc-packet-factory:write-bytes - written ~A~%" buf) ) +#+nio-debug (format t "yarpc-packet-factory:write-bytes - written ~A~%" buf) +) Modified: branches/home/psmith/restructure/src/statemachine/state-machine.lisp ============================================================================== --- branches/home/psmith/restructure/src/statemachine/state-machine.lisp (original) +++ branches/home/psmith/restructure/src/statemachine/state-machine.lisp Thu Jan 18 19:11:08 2007 @@ -57,7 +57,7 @@ (defmethod process-read((sm state-machine)) (with-slots (foreign-read-buffer) sm (let ((incoming-packet (get-packet (get-packet-factory sm) foreign-read-buffer))) - (format t "state-machine::process-read - incoming packet: ~A~%" incoming-packet) + (format t "~A state-machine::process-read - incoming packet: ~A~%" (nio-compat:get-readable-time) incoming-packet) (when incoming-packet (when (not (process-incoming-packet sm incoming-packet)) (close-sm sm)))))) @@ -67,7 +67,7 @@ (defmethod process-write((sm state-machine)) (with-slots (foreign-write-buffer) sm (let ((outgoing-packet (process-outgoing-packet sm))) - (format t "state-machine::process-write - outgoing packet: ~A~%" outgoing-packet) + (format t "~A state-machine::process-write - outgoing packet: ~A~%" (nio-compat:get-readable-time) outgoing-packet) (when outgoing-packet (write-bytes outgoing-packet foreign-write-buffer)))))

1 0

[nio-cvs] r43 - branches/home/psmith/restructure/src/event
by psmith＠common-lisp.net 19 Jan '07

19 Jan '07

Author: psmith Date: Thu Jan 18 19:09:15 2007 New Revision: 43 Modified: branches/home/psmith/restructure/src/event/epoll.lisp Log: Reduced wait time and ignored EINTR on epoll_wait return Modified: branches/home/psmith/restructure/src/event/epoll.lisp ============================================================================== --- branches/home/psmith/restructure/src/event/epoll.lisp (original) +++ branches/home/psmith/restructure/src/event/epoll.lisp Thu Jan 18 19:09:15 2007 @@ -76,13 +76,18 @@ #+nio-debug (format t "poll-events called with :event-queue ~A~%" event-queue) (with-foreign-object (events 'epoll-event +epoll-size+) (memzero events (* +epoll-event-size+ +epoll-size+)) - (loop for res = (%epoll-wait event-queue events +epoll-size+ 1000) + (loop for res = (%epoll-wait event-queue events +epoll-size+ 100) do (progn #+nio-debug (format t "poll-events - dealing with ~A~%" res) (case res - (-1 (error 'poll-error)) + (-1 + (let ((errno (get-errno))) + (format t "-1 returned from epoll-wait, errno ~A~%" errno) + (if (eql errno 4) ;EINTR - interrupted by a system call + (return nil) + (error 'poll-error)))) (return nil) (t (let ((idents nil))

1 0

[nio-cvs] r42 - in branches/home/psmith/restructure: . src/protocol/yarpc
by psmith＠common-lisp.net 18 Jan '07

18 Jan '07

Author: psmith Date: Wed Jan 17 23:26:42 2007 New Revision: 42 Modified: branches/home/psmith/restructure/run-yarpc-client.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp Log: loop sending rpc's and minor correction Modified: branches/home/psmith/restructure/run-yarpc-client.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc-client.lisp (original) +++ branches/home/psmith/restructure/run-yarpc-client.lisp Wed Jan 17 23:26:42 2007 @@ -6,5 +6,7 @@ (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity nil :host "127.0.0.1" :port 9897)) :name "nio-server") (sleep 4) (let ((sm (nio:add-connection "127.0.0.1" 16323 'nio-yarpc:yarpc-client-state-machine))) -(format t "toplevel adding conn ~A~%" sm) -(format t "Result of remote-execute ~A~%" (nio-yarpc:remote-execute sm "(nio-yarpc:test-rpc-list)"))) + +(loop + (format t "toplevel adding conn ~A~%" sm) + (format t "Result of remote-execute ~A~%" (nio-yarpc:remote-execute sm "(nio-yarpc:test-rpc-list)")))) Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp Wed Jan 17 23:26:42 2007 @@ -68,13 +68,12 @@ (format t "yarpc-client-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm response) (let* ((*package* (find-package :nio-yarpc)) (result (read-from-string (response response)))) - (nio-compat:add (result-queue sm) result) - (setf (state sm) STATE-INITIALISED))) + (setf (state sm) STATE-INITIALISED) + (nio-compat:add (result-queue sm) result))) ;Called from an external thread i.e. *not* the nio thread ;Blocks calling thread on the remote m/c's response (defmethod remote-execute ((sm yarpc-client-state-machine) call-string) -; (queue-outgoing-packet (assert (eql (state sm) STATE-INITIALISED)) (nio-compat:add (job-queue sm) (make-instance 'call-method-packet :call-string call-string)) (nio-compat:take (result-queue sm))) \ No newline at end of file

1 0

[nio-cvs] r41 - in branches/home/psmith/restructure: . src/buffer src/compat src/io src/protocol/yarpc src/statemachine
by psmith＠common-lisp.net 18 Jan '07

18 Jan '07

Author: psmith Date: Wed Jan 17 23:01:11 2007 New Revision: 41 Modified: branches/home/psmith/restructure/run-yarpc.lisp branches/home/psmith/restructure/src/buffer/buffer.lisp branches/home/psmith/restructure/src/compat/concurrent-queue.lisp branches/home/psmith/restructure/src/io/async-fd.lisp branches/home/psmith/restructure/src/io/async-socket.lisp branches/home/psmith/restructure/src/io/nio-server.lisp branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp branches/home/psmith/restructure/src/statemachine/nio-sm-package.lisp branches/home/psmith/restructure/src/statemachine/state-machine.lisp Log: Yarpc working end-to-end Modified: branches/home/psmith/restructure/run-yarpc.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc.lisp (original) +++ branches/home/psmith/restructure/run-yarpc.lisp Wed Jan 17 23:01:11 2007 @@ -2,11 +2,10 @@ (require :asdf) (require :nio-yarpc) -(let ((jobq (nio-compat:concurrent-queue))) - (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity #'(lambda()(nio-yarpc:yarpc-state-machine jobq)) :host "127.0.0.1")) :name "nio-server") - (format t "server toplevel waiting for job~%" ) - (loop +(sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity 'nio-yarpc:yarpc-state-machine :host "127.0.0.1")) :name "nio-server") +(loop ;;block waiting for jobs - (multiple-value-bind (job result-queue) (nio-compat:take jobq) + (format t "Server toplevel waiting for job~%" ) + (destructuring-bind (job result-queue) (nio-compat:take nio-yarpc:job-queue) (format t "Server received job ~A~%" job) - (nio-compat:add result-queue (nio-yarpc:execute-call job))))) + (nio-compat:add result-queue (nio-yarpc:execute-call job)))) Modified: branches/home/psmith/restructure/src/buffer/buffer.lisp ============================================================================== --- branches/home/psmith/restructure/src/buffer/buffer.lisp (original) +++ branches/home/psmith/restructure/src/buffer/buffer.lisp Wed Jan 17 23:01:11 2007 @@ -55,25 +55,45 @@ ;;Utils by slyrus (http://paste.lisp.org/display/11149) (defun hex-dump-byte (address) - (format nil "~2,'0X" - (sb-alien:deref - (sb-alien:sap-alien - (sb-alien::int-sap address) - (* (sb-alien:unsigned 8)))))) + (format nil "~2,'0X" (byte-value address))) + +(defun byte-value (address) + (sb-alien:deref + (sb-alien:sap-alien + (sb-alien::int-sap address) + (* (sb-alien:unsigned 8))))) (defun hex-dump-memory (start-address length) (loop for i from start-address below (+ start-address length) collect (format nil (hex-dump-byte i)))) +;;-- end utils + + +(defun pretty-hex-dump (start-address length) +; (format t "start: ~A length ~A~%" start-address length) + (with-output-to-string (str) + (let ((rows (floor (/ length 16)))) +; (format t "rows: ~A remainder ~A~%" rows remainder) + (dotimes (row-index (+ 1 rows)) + (format str "~A~%" + (with-output-to-string (readable) + (dotimes (column-index 16) + (let ((address (+ start-address (* row-index 16) column-index))) + ; (format t "Current address : ~A~%" address) + (if (>= address (+ start-address length)) + (progn + (format str "--") + (format readable "--")) + (progn + (format str (if (eql column-index 7) "~A " "~A ") (hex-dump-byte address)) + (format readable "~A" (code-char (byte-value address))))))))))))) (defun make-uint8-seq (size) "Make uint8 sequence." (make-sequence '(vector (unsigned-byte 8)) size :initial-element 0)) -;;-- end utils - - ;;A buffer that deals with bytes (defclass byte-buffer (buffer)()) @@ -83,7 +103,7 @@ (defmethod print-object ((byte-buffer byte-buffer) stream) (with-slots (capacity position limit buf) byte-buffer - (format stream "<byte-buffer :capacity ~A :position ~A :limit ~A :buf ~%~A>~%" capacity position limit (if buf (hex-dump-memory (cffi:pointer-address buf) limit) nil)))) + (format stream "<byte-buffer :capacity ~A :position ~A :limit ~A :buf ~%~A>~%" capacity position limit (if buf (pretty-hex-dump (cffi:pointer-address buf) limit) nil)))) (defmethod free-buffer((byte-buffer byte-buffer)) (with-slots (capacity position limit buf) byte-buffer Modified: branches/home/psmith/restructure/src/compat/concurrent-queue.lisp ============================================================================== --- branches/home/psmith/restructure/src/compat/concurrent-queue.lisp (original) +++ branches/home/psmith/restructure/src/compat/concurrent-queue.lisp Wed Jan 17 23:01:11 2007 @@ -47,7 +47,7 @@ `(if ,a-buffer (let ((head (car ,a-buffer))) (setf ,a-buffer (cdr ,a-buffer)) -#+nio-debug (format t "reader ~A woke, read ~A as ~A~%" sb-thread:*current-thread* head ,loc) +#+nio-debug (format t "concurent-queue:take - (~A) read ~A at ~A~%" sb-thread:*current-thread* head ,loc) head) nil)) @@ -64,6 +64,7 @@ ;Append the element to the tail of this queue (defmethod add ((queue concurrent-queue) elt) +#+nio-debug (format t "concurent-queue:add - (~A) adding ~A~%" sb-thread:*current-thread* elt) (sb-thread:with-mutex ((buffer-lock queue)) (setf (buffer queue) (append (buffer queue) (list elt)) ) (sb-thread:condition-notify (buffer-queue queue)))) Modified: branches/home/psmith/restructure/src/io/async-fd.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/async-fd.lisp (original) +++ branches/home/psmith/restructure/src/io/async-fd.lisp Wed Jan 17 23:01:11 2007 @@ -125,11 +125,12 @@ (error 'read-error))) ((= new-bytes 0) - nil);;(throw 'end-of-file nil)) + nil);;(throw 'end-of-file nil) (t ;;Update buffer position - (inc-position foreign-read-buffer new-bytes)))))) + (inc-position foreign-read-buffer new-bytes) + (setf (read-ready state-machine) nil)))))) (defun close-async-fd (async-fd) "Close ASYNC-FD's fd after everything has been written from write-queue." Modified: branches/home/psmith/restructure/src/io/async-socket.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/async-socket.lisp (original) +++ branches/home/psmith/restructure/src/io/async-socket.lisp Wed Jan 17 23:01:11 2007 @@ -178,7 +178,7 @@ -(defun socket-accept (socket-fd connection-factory) +(defun socket-accept (socket-fd connection-type) "Accept connection from SOCKET-FD. Allocates and returns socket structure denoting the connection." (flet ((parse-inet6-addr (addr) @@ -202,7 +202,7 @@ ;; accept connection (let* ((res (%accept socket-fd addr len)) ;; (async-socket-fd (make-instance 'async-socket-fd :read-fd res :write-fd res))) - (async-socket-fd (create-state-machine connection-factory res res (make-instance 'async-socket-fd)))) + (async-socket-fd (create-state-machine connection-type res res (make-instance 'async-socket-fd)))) (unless (< res 0) (let ((len-value (mem-ref len :unsigned-int))) Modified: branches/home/psmith/restructure/src/io/nio-server.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/nio-server.lisp (original) +++ branches/home/psmith/restructure/src/io/nio-server.lisp Wed Jan 17 23:01:11 2007 @@ -55,7 +55,7 @@ -(defun start-server (connection-handler accept-filter connection-factory +(defun start-server (connection-handler accept-filter connection-type &key (protocol :inet) (port (+ (random 60000) 1024)) @@ -99,7 +99,7 @@ (cond ;; new connection ((= fd sock) - (let ((async-fd (socket-accept fd connection-factory))) + (let ((async-fd (socket-accept fd connection-type))) #+nio-debug (format t "start-server - New conn: ~A~%" async-fd) (cond ((null async-fd) Modified: branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp Wed Jan 17 23:01:11 2007 @@ -32,7 +32,7 @@ yarpc-state-machine-factory get-packet-factory ;; yarpc-state-machine - yarpc-state-machine + yarpc-state-machine job-queue ;to be moved test-rpc test-rpc-list test-rpc-string execute-call Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp Wed Jan 17 23:01:11 2007 @@ -38,7 +38,7 @@ :documentation "The queue used to hand off work from an external thread to the io thread") (result-queue :initform (nio-compat:concurrent-queue) :accessor result-queue - :documentation "The queue used to hand off work from an external thread to the io thread"))) + :documentation "The queue used to return results from the io thread to an external thread"))) (defun yarpc-client-state-machine () (make-instance 'yarpc-client-state-machine)) @@ -55,26 +55,26 @@ (defconstant STATE-INITIALISED 0) (defconstant STATE-SENT-REQUEST 1) -(defparameter state STATE-INITIALISED) - (defmethod process-outgoing-packet((sm yarpc-client-state-machine)) (format t "process-outgoing-packet called, polling the job-queue ~%") (let ((packet (nio-compat:take (job-queue sm) :blocking-call nil))) (when packet (format t "process-outgoing-packet got job ~A ~%" packet) - (setf state STATE-SENT-REQUEST)) + (setf (state sm) STATE-SENT-REQUEST)) packet)) (defmethod process-incoming-packet ((sm yarpc-client-state-machine) (response method-response-packet)) - (assert (eql state STATE-SENT-REQUEST)) + (assert (eql (state sm) STATE-SENT-REQUEST)) (format t "yarpc-client-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm response) - (nio-compat:add (result-queue sm) response) - (setf state STATE-INITIALISED)) + (let* ((*package* (find-package :nio-yarpc)) + (result (read-from-string (response response)))) + (nio-compat:add (result-queue sm) result) + (setf (state sm) STATE-INITIALISED))) ;Called from an external thread i.e. *not* the nio thread ;Blocks calling thread on the remote m/c's response (defmethod remote-execute ((sm yarpc-client-state-machine) call-string) ; (queue-outgoing-packet - (assert (eql state STATE-INITIALISED)) + (assert (eql (state sm) STATE-INITIALISED)) (nio-compat:add (job-queue sm) (make-instance 'call-method-packet :call-string call-string)) (nio-compat:take (result-queue sm))) \ No newline at end of file Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Wed Jan 17 23:01:11 2007 @@ -33,20 +33,13 @@ ;; A server that processes remote procedure calls and returns results ;; (defclass yarpc-state-machine (state-machine) - ((job-queue :initarg :job-queue - :initform (error "Must supply a job queue to write work to.") - :accessor job-queue - :documentation "The queue used to hand off work from the NIO thread to an external thread for execution") + ( (result-queue :initform (nio-compat:concurrent-queue) :accessor result-queue :documentation "The queue used to return results from an external thread to the nio thread"))) -(defun yarpc-state-machine (read-fd write-fd socket job-queue) - (let ((sm (make-instance 'yarpc-state-machine :read-fd read-fd :write-fd write-fd :socket socket :job-queue job-queue))) - (nio-buffer:clear (foreign-read-buffer sm)) - (nio-buffer:clear (foreign-write-buffer sm)) - (format t "yarpc-state-machine - Created ~S~%" sm) - sm)) +(defparameter job-queue (nio-compat:concurrent-queue) + "The queue used to hand off work from the NIO thread to an external thread for execution") (defparameter yarpc-pf (yarpc-packet-factory)) @@ -59,27 +52,18 @@ (defconstant STATE-INITIALISED 0) (defconstant STATE-SEND-RESPONSE 1) -(defparameter state STATE-INITIALISED) - - (defmethod process-outgoing-packet((sm yarpc-state-machine)) (format t "yarpc-state-machine: process-outgoing-packet called, polling the results-queue ~%") - (let ((packet (nio-compat:take (result-queue sm) :blocking-call nil))) - (format t "yarpc-state-machine: process-outgoing-packet got result ~A ~%" packet) - packet)) - + (let ((result (nio-compat:take (result-queue sm) :blocking-call nil))) + (format t "yarpc-state-machine: process-outgoing-packet got result ~A ~%" result) + (when result + (method-response-packet result)))) -;Process a call method packet, returns +;Process a call method packet by placing it in the job-queue (defmethod process-incoming-packet ((sm yarpc-state-machine) (call call-method-packet)) - (assert (eql state STATE-INITIALISED)) + (assert (eql (state sm) STATE-INITIALISED)) (format t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm call) - (nio-compat:add (job-queue sm) (cons (call-string call) (result-queue sm)))) - - -;Called from an external thread i.e. *not* the nio thread -;Blocks waiting for a job (call-string,result-queue) to process and return the result into the result queue -;(defmethod get-job ((sm yarpc-state-machine)) -; (values (nio-compat:take (job-queue sm)) (result-queue sm))) + (nio-compat:add job-queue (list (call-string call) (result-queue sm)))) Modified: branches/home/psmith/restructure/src/statemachine/nio-sm-package.lisp ============================================================================== --- branches/home/psmith/restructure/src/statemachine/nio-sm-package.lisp (original) +++ branches/home/psmith/restructure/src/statemachine/nio-sm-package.lisp Wed Jan 17 23:01:11 2007 @@ -29,5 +29,5 @@ (:export ;; state-machine - state-machine packet-factory get-packet-factory get-packet process-outgoing-packet process-incoming-packet + state-machine packet-factory get-packet-factory get-packet process-outgoing-packet process-incoming-packet state )) Modified: branches/home/psmith/restructure/src/statemachine/state-machine.lisp ============================================================================== --- branches/home/psmith/restructure/src/statemachine/state-machine.lisp (original) +++ branches/home/psmith/restructure/src/statemachine/state-machine.lisp Wed Jan 17 23:01:11 2007 @@ -37,7 +37,9 @@ ;This way only the protocols packet heirarchy knows about binary representations and ; the SM can deal with protocol logic and state maintenance ; -(defclass state-machine (async-fd)()) +(defclass state-machine (async-fd) + ((state :initform 0 + :accessor state))) (defmethod print-object ((sm state-machine) stream) (format stream "#<STATE-MACHINE ~A >" (call-next-method sm nil)))

1 0

[nio-cvs] r40 - in branches/home/psmith/restructure: . src/compat src/io src/protocol/yarpc
by psmith＠common-lisp.net 17 Jan '07

17 Jan '07

Author: psmith Date: Wed Jan 17 00:06:13 2007 New Revision: 40 Added: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp - copied, changed from r37, branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Modified: branches/home/psmith/restructure/run-yarpc-client.lisp branches/home/psmith/restructure/run-yarpc.lisp branches/home/psmith/restructure/src/compat/concurrent-queue.lisp branches/home/psmith/restructure/src/io/async-fd.lisp branches/home/psmith/restructure/src/io/async-socket.lisp branches/home/psmith/restructure/src/io/nio-server.lisp branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc.asd branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Log: yarpc work, saving... Modified: branches/home/psmith/restructure/run-yarpc-client.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc-client.lisp (original) +++ branches/home/psmith/restructure/run-yarpc-client.lisp Wed Jan 17 00:06:13 2007 @@ -2,10 +2,9 @@ (require :asdf) (require :nio-yarpc) -(sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity 'nio-yarpc:yarpc-state-machine :host "127.0.0.1" :port 9897)) :name "nio-server") +;;shouldn't be listenting on the client hence nil for accept SM to start-server +(sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity nil :host "127.0.0.1" :port 9897)) :name "nio-server") (sleep 4) -(let ((sm (nio:add-connection "127.0.0.1" 16323 'nio-yarpc:yarpc-state-machine))) +(let ((sm (nio:add-connection "127.0.0.1" 16323 'nio-yarpc:yarpc-client-state-machine))) (format t "toplevel adding conn ~A~%" sm) (format t "Result of remote-execute ~A~%" (nio-yarpc:remote-execute sm "(nio-yarpc:test-rpc-list)"))) - - Modified: branches/home/psmith/restructure/run-yarpc.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc.lisp (original) +++ branches/home/psmith/restructure/run-yarpc.lisp Wed Jan 17 00:06:13 2007 @@ -2,4 +2,11 @@ (require :asdf) (require :nio-yarpc) -(nio:start-server 'identity 'identity 'nio-yarpc:yarpc-state-machine :host "127.0.0.1") +(let ((jobq (nio-compat:concurrent-queue))) + (sb-thread:make-thread #'(lambda()(nio:start-server 'identity 'identity #'(lambda()(nio-yarpc:yarpc-state-machine jobq)) :host "127.0.0.1")) :name "nio-server") + (format t "server toplevel waiting for job~%" ) + (loop + ;;block waiting for jobs + (multiple-value-bind (job result-queue) (nio-compat:take jobq) + (format t "Server received job ~A~%" job) + (nio-compat:add result-queue (nio-yarpc:execute-call job))))) Modified: branches/home/psmith/restructure/src/compat/concurrent-queue.lisp ============================================================================== --- branches/home/psmith/restructure/src/compat/concurrent-queue.lisp (original) +++ branches/home/psmith/restructure/src/compat/concurrent-queue.lisp Wed Jan 17 00:06:13 2007 @@ -51,18 +51,18 @@ head) nil)) - -(defmethod take ((queue concurrent-queue)) +;Do an (optionally blocking) remove of the element at the head of this queue +(defmethod take ((queue concurrent-queue) &key (blocking-call t)) (sb-thread:with-mutex ((buffer-lock queue)) ;if its there, pop it (let ((ret (pop-elt (buffer queue) "1sttry"))) - (if ret + (if (or ret (not blocking-call)) ret (progn (sb-thread:condition-wait (buffer-queue queue) (buffer-lock queue)) (pop-elt (buffer queue) "2ndtry")))))) - +;Append the element to the tail of this queue (defmethod add ((queue concurrent-queue) elt) (sb-thread:with-mutex ((buffer-lock queue)) (setf (buffer queue) (append (buffer queue) (list elt)) ) Modified: branches/home/psmith/restructure/src/io/async-fd.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/async-fd.lisp (original) +++ branches/home/psmith/restructure/src/io/async-fd.lisp Wed Jan 17 00:06:13 2007 @@ -84,10 +84,6 @@ ;;Implement this in concrete SM for read (defgeneric process-write (async-fd)) - - -;Loop over state machines calling process-outgoing-packets via state-machine::process-write - ;;SM factory (defun create-state-machine(sm-type read-fd write-fd socket) (let ((sm (make-instance sm-type :read-fd read-fd :write-fd write-fd :socket socket))) Modified: branches/home/psmith/restructure/src/io/async-socket.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/async-socket.lisp (original) +++ branches/home/psmith/restructure/src/io/async-socket.lisp Wed Jan 17 00:06:13 2007 @@ -178,7 +178,7 @@ -(defun socket-accept (socket-fd connection-type) +(defun socket-accept (socket-fd connection-factory) "Accept connection from SOCKET-FD. Allocates and returns socket structure denoting the connection." (flet ((parse-inet6-addr (addr) @@ -202,7 +202,7 @@ ;; accept connection (let* ((res (%accept socket-fd addr len)) ;; (async-socket-fd (make-instance 'async-socket-fd :read-fd res :write-fd res))) - (async-socket-fd (create-state-machine connection-type res res (make-instance 'async-socket-fd)))) + (async-socket-fd (create-state-machine connection-factory res res (make-instance 'async-socket-fd)))) (unless (< res 0) (let ((len-value (mem-ref len :unsigned-int))) Modified: branches/home/psmith/restructure/src/io/nio-server.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/nio-server.lisp (original) +++ branches/home/psmith/restructure/src/io/nio-server.lisp Wed Jan 17 00:06:13 2007 @@ -55,7 +55,7 @@ -(defun start-server (connection-handler accept-filter connection-type +(defun start-server (connection-handler accept-filter connection-factory &key (protocol :inet) (port (+ (random 60000) 1024)) @@ -99,7 +99,7 @@ (cond ;; new connection ((= fd sock) - (let ((async-fd (socket-accept fd connection-type))) + (let ((async-fd (socket-accept fd connection-factory))) #+nio-debug (format t "start-server - New conn: ~A~%" async-fd) (cond ((null async-fd) Modified: branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp Wed Jan 17 00:06:13 2007 @@ -28,6 +28,14 @@ (:export + ;;base + yarpc-state-machine-factory get-packet-factory + ;; yarpc-state-machine - yarpc-state-machine yarpc-state-machine-factory test-rpc test-rpc-list test-rpc-string get-packet-factory remote-execute + yarpc-state-machine + ;to be moved + test-rpc test-rpc-list test-rpc-string execute-call + + ;;yarpc-client-state-machine + yarpc-client-state-machine remote-execute )) Modified: branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc.asd ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc.asd (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc.asd Wed Jan 17 00:06:13 2007 @@ -7,6 +7,7 @@ :components ((:file "nio-yarpc-package") (:file "yarpc-packet-factory" :depends-on ("nio-yarpc-package")) (:file "yarpc-state-machine" :depends-on ("yarpc-packet-factory")) + (:file "yarpc-client-state-machine" :depends-on ("yarpc-packet-factory")) ) - :depends-on (:nio :nio-sm)) \ No newline at end of file + :depends-on (:nio :nio-sm :nio-compat)) \ No newline at end of file Copied: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp (from r37, branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp) ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-client-state-machine.lisp Wed Jan 17 00:06:13 2007 @@ -28,108 +28,53 @@ (declaim (optimize (debug 3) (speed 3) (space 0))) -;; YetAnotherRPC state machine +;; YetAnotherRPC Client state machine ;; -;; A server that processes remote procedure calls and returns results +;; A client that accepts jobs to be run via a threadsafe queue and then submits them to the remote end for execution ;; -;; Test with: -;; > telnet 127.0.0.1 16323 -;; Trying 127.0.0.1... -;; Connected to 127.0.0.1. -;; Escape character is '^]'. -;; (test-rpc "who" 2 's) -;; response - who 2 'S -;; -(defclass yarpc-state-machine (state-machine) - ((outgoing-packet :initarg :outgoing-packet - :accessor outgoing-packet - :initform nil))) +(defclass yarpc-client-state-machine (state-machine) + ((job-queue :initform (nio-compat:concurrent-queue) + :accessor job-queue + :documentation "The queue used to hand off work from an external thread to the io thread") + (result-queue :initform (nio-compat:concurrent-queue) + :accessor result-queue + :documentation "The queue used to hand off work from an external thread to the io thread"))) -(defun yarpc-state-machine () - (make-instance 'yarpc-state-machine)) +(defun yarpc-client-state-machine () + (make-instance 'yarpc-client-state-machine)) (defparameter yarpc-pf (yarpc-packet-factory)) -(defmethod get-packet-factory((sm yarpc-state-machine)) +(defmethod get-packet-factory((sm yarpc-client-state-machine)) yarpc-pf) -;;TODO move somewhere suitable - -(defparameter *remote-fns* nil) - -(defun register-remote-fn(name) - (push name *remote-fns*)) - -(defmacro defremote (name args &rest body) - `(progn - (defun ,name (,@args) ,@body) - (register-remote-fn #',name))) - -(defremote test-rpc-list() - (list 3 "as" 's (code-char #x2211))) - -(defremote test-rpc-string(a b c) - (format nil "response - ~A ~A ~A ~A~%" a b c (code-char #x2211))) - -;;end move TODO - - -;;;Utils - -(defun print-hashtable (table &optional (stream t)) - (maphash #'(lambda (k v) (format stream "~a -> ~a~%" k v)) table)) -;;; - -(defmethod print-object ((sm yarpc-state-machine) stream) - (format stream "#<YARPC-STATE-MACHINE ~A >" (call-next-method sm nil))) +(defmethod print-object ((sm yarpc-client-state-machine) stream) + (format stream "#<YARPC-CLIENT-STATE-MACHINE ~A >" (call-next-method sm nil))) (defconstant STATE-INITIALISED 0) -(defconstant STATE-SEND-RESPONSE 1) +(defconstant STATE-SENT-REQUEST 1) (defparameter state STATE-INITIALISED) -(define-condition authorization-error (error) ()) - - -(defmethod process-outgoing-packet((sm yarpc-state-machine)) - (format t "process-outgoing-packet called~%") - (let ((packet (outgoing-packet sm))) - (setf (outgoing-packet sm) nil) - packet)) - -;TODO queue and thread stuf -(defmethod queue-outgoing-packet((sm yarpc-state-machine) packet) - (setf (outgoing-packet sm) packet)) - -;Process a call method packet, returns -(defmethod process-incoming-packet ((sm yarpc-state-machine) (call call-method-packet)) - (assert (eql state STATE-INITIALISED)) - (format t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm call) - (handler-case - (let ((result (execute-call (call-string call)))) - (when result - (let ((response-packet (progn - (setf state STATE-SEND-RESPONSE) - (queue-outgoing-packet sm (method-response-packet result))))) - t))) - (reader-error (re) (format t "No such function ~A~%" (call-string call))) - (authorization-error (ae) (format t "Function not declared with defremote ~A~%" (call-string call))))) - -(defmethod process-incoming-packet ((sm yarpc-state-machine) (response method-response-packet)) - (assert (eql state STATE-INITIALISED)) - (format t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm response)) +(defmethod process-outgoing-packet((sm yarpc-client-state-machine)) + (format t "process-outgoing-packet called, polling the job-queue ~%") + (let ((packet (nio-compat:take (job-queue sm) :blocking-call nil))) + (when packet + (format t "process-outgoing-packet got job ~A ~%" packet) + (setf state STATE-SENT-REQUEST)) + packet)) + +(defmethod process-incoming-packet ((sm yarpc-client-state-machine) (response method-response-packet)) + (assert (eql state STATE-SENT-REQUEST)) + (format t "yarpc-client-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm response) + (nio-compat:add (result-queue sm) response) + (setf state STATE-INITIALISED)) - -(defun execute-call (call-string) - (let* ((rpc-call-list (read-from-string call-string )) - (fn (member (symbol-function (first rpc-call-list)) *remote-fns* ))) - (format t "fn - ~A authorised? : ~A~%" (symbol-function (first rpc-call-list)) fn) - (if fn - (apply (first rpc-call-list) (rest rpc-call-list)) - (error 'authorization-error)))) - - -(defmethod remote-execute ((sm yarpc-state-machine) call-string) - (queue-outgoing-packet sm (make-instance 'call-method-packet :call-string call-string))) - \ No newline at end of file +;Called from an external thread i.e. *not* the nio thread +;Blocks calling thread on the remote m/c's response +(defmethod remote-execute ((sm yarpc-client-state-machine) call-string) +; (queue-outgoing-packet + (assert (eql state STATE-INITIALISED)) + (nio-compat:add (job-queue sm) (make-instance 'call-method-packet :call-string call-string)) + (nio-compat:take (result-queue sm))) \ No newline at end of file Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Wed Jan 17 00:06:13 2007 @@ -32,27 +32,57 @@ ;; ;; A server that processes remote procedure calls and returns results ;; -;; Test with: -;; > telnet 127.0.0.1 16323 -;; Trying 127.0.0.1... -;; Connected to 127.0.0.1. -;; Escape character is '^]'. -;; (test-rpc "who" 2 's) -;; response - who 2 'S -;; (defclass yarpc-state-machine (state-machine) - ((outgoing-packet :initarg :outgoing-packet - :accessor outgoing-packet - :initform nil))) - -(defun yarpc-state-machine () - (make-instance 'yarpc-state-machine)) + ((job-queue :initarg :job-queue + :initform (error "Must supply a job queue to write work to.") + :accessor job-queue + :documentation "The queue used to hand off work from the NIO thread to an external thread for execution") + (result-queue :initform (nio-compat:concurrent-queue) + :accessor result-queue + :documentation "The queue used to return results from an external thread to the nio thread"))) + +(defun yarpc-state-machine (read-fd write-fd socket job-queue) + (let ((sm (make-instance 'yarpc-state-machine :read-fd read-fd :write-fd write-fd :socket socket :job-queue job-queue))) + (nio-buffer:clear (foreign-read-buffer sm)) + (nio-buffer:clear (foreign-write-buffer sm)) + (format t "yarpc-state-machine - Created ~S~%" sm) + sm)) (defparameter yarpc-pf (yarpc-packet-factory)) (defmethod get-packet-factory((sm yarpc-state-machine)) yarpc-pf) +(defmethod print-object ((sm yarpc-state-machine) stream) + (format stream "#<YARPC-STATE-MACHINE ~A >" (call-next-method sm nil))) + +(defconstant STATE-INITIALISED 0) +(defconstant STATE-SEND-RESPONSE 1) + +(defparameter state STATE-INITIALISED) + + +(defmethod process-outgoing-packet((sm yarpc-state-machine)) + (format t "yarpc-state-machine: process-outgoing-packet called, polling the results-queue ~%") + (let ((packet (nio-compat:take (result-queue sm) :blocking-call nil))) + (format t "yarpc-state-machine: process-outgoing-packet got result ~A ~%" packet) + packet)) + + +;Process a call method packet, returns +(defmethod process-incoming-packet ((sm yarpc-state-machine) (call call-method-packet)) + (assert (eql state STATE-INITIALISED)) + (format t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm call) + (nio-compat:add (job-queue sm) (cons (call-string call) (result-queue sm)))) + + +;Called from an external thread i.e. *not* the nio thread +;Blocks waiting for a job (call-string,result-queue) to process and return the result into the result queue +;(defmethod get-job ((sm yarpc-state-machine)) +; (values (nio-compat:take (job-queue sm)) (result-queue sm))) + + + ;;TODO move somewhere suitable (defparameter *remote-fns* nil) @@ -71,56 +101,8 @@ (defremote test-rpc-string(a b c) (format nil "response - ~A ~A ~A ~A~%" a b c (code-char #x2211))) -;;end move TODO - - -;;;Utils - -(defun print-hashtable (table &optional (stream t)) - (maphash #'(lambda (k v) (format stream "~a -> ~a~%" k v)) table)) -;;; - - -(defmethod print-object ((sm yarpc-state-machine) stream) - (format stream "#<YARPC-STATE-MACHINE ~A >" (call-next-method sm nil))) - -(defconstant STATE-INITIALISED 0) -(defconstant STATE-SEND-RESPONSE 1) - -(defparameter state STATE-INITIALISED) - (define-condition authorization-error (error) ()) - -(defmethod process-outgoing-packet((sm yarpc-state-machine)) - (format t "process-outgoing-packet called~%") - (let ((packet (outgoing-packet sm))) - (setf (outgoing-packet sm) nil) - packet)) - -;TODO queue and thread stuf -(defmethod queue-outgoing-packet((sm yarpc-state-machine) packet) - (setf (outgoing-packet sm) packet)) - -;Process a call method packet, returns -(defmethod process-incoming-packet ((sm yarpc-state-machine) (call call-method-packet)) - (assert (eql state STATE-INITIALISED)) - (format t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm call) - (handler-case - (let ((result (execute-call (call-string call)))) - (when result - (let ((response-packet (progn - (setf state STATE-SEND-RESPONSE) - (queue-outgoing-packet sm (method-response-packet result))))) - t))) - (reader-error (re) (format t "No such function ~A~%" (call-string call))) - (authorization-error (ae) (format t "Function not declared with defremote ~A~%" (call-string call))))) - -(defmethod process-incoming-packet ((sm yarpc-state-machine) (response method-response-packet)) - (assert (eql state STATE-INITIALISED)) - (format t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm response)) - - (defun execute-call (call-string) (let* ((rpc-call-list (read-from-string call-string )) (fn (member (symbol-function (first rpc-call-list)) *remote-fns* ))) @@ -129,7 +111,18 @@ (apply (first rpc-call-list) (rest rpc-call-list)) (error 'authorization-error)))) +;;end move TODO + + + + -(defmethod remote-execute ((sm yarpc-state-machine) call-string) - (queue-outgoing-packet sm (make-instance 'call-method-packet :call-string call-string))) - \ No newline at end of file +; (handler-case +; (let ((result (execute-call (call-string call)))) +; (when result +; (let ((response-packet (progn +; (setf state STATE-SEND-RESPONSE) +; (queue-outgoing-packet sm (method-response-packet result))))) +; t))) +; (reader-error (re) (format t "No such function ~A~%" (call-string call))) +; (authorization-error (ae) (format t "Function not declared with defremote ~A~%" (call-string call)))) \ No newline at end of file

1 0

[nio-cvs] r39 - branches/home/psmith/restructure/src/compat
by psmith＠common-lisp.net 17 Jan '07

17 Jan '07

Author: psmith Date: Tue Jan 16 20:39:51 2007 New Revision: 39 Modified: branches/home/psmith/restructure/src/compat/concurrent-queue.lisp branches/home/psmith/restructure/src/compat/nio-compat-package.lisp branches/home/psmith/restructure/src/compat/nio-compat.asd Log: asdf updates for queue Modified: branches/home/psmith/restructure/src/compat/concurrent-queue.lisp ============================================================================== --- branches/home/psmith/restructure/src/compat/concurrent-queue.lisp (original) +++ branches/home/psmith/restructure/src/compat/concurrent-queue.lisp Tue Jan 16 20:39:51 2007 @@ -40,6 +40,9 @@ (buffer :initform nil :accessor buffer))) +(defun concurrent-queue() + (make-instance 'concurrent-queue)) + (defmacro pop-elt(a-buffer loc) `(if ,a-buffer (let ((head (car ,a-buffer))) Modified: branches/home/psmith/restructure/src/compat/nio-compat-package.lisp ============================================================================== --- branches/home/psmith/restructure/src/compat/nio-compat-package.lisp (original) +++ branches/home/psmith/restructure/src/compat/nio-compat-package.lisp Tue Jan 16 20:39:51 2007 @@ -31,4 +31,6 @@ ;; errno.lisp get-errno +ERRNO_EAGAIN+ + ;;concurrent-queue + concurrent-queue add take )) Modified: branches/home/psmith/restructure/src/compat/nio-compat.asd ============================================================================== --- branches/home/psmith/restructure/src/compat/nio-compat.asd (original) +++ branches/home/psmith/restructure/src/compat/nio-compat.asd Tue Jan 16 20:39:51 2007 @@ -6,6 +6,7 @@ :components ((:file "nio-compat-package") (:file "errno" :depends-on ("nio-compat-package")) + (:file "concurrent-queue" :depends-on ("nio-compat-package")) ) :depends-on ())

1 0

[nio-cvs] r38 - branches/home/psmith/restructure/src/compat
by psmith＠common-lisp.net 17 Jan '07

17 Jan '07

Author: psmith Date: Tue Jan 16 20:34:39 2007 New Revision: 38 Added: branches/home/psmith/restructure/src/compat/concurrent-queue.lisp Log: Added concurrent queue inter thread communication via a FIFO queue Added: branches/home/psmith/restructure/src/compat/concurrent-queue.lisp ============================================================================== --- (empty file) +++ branches/home/psmith/restructure/src/compat/concurrent-queue.lisp Tue Jan 16 20:34:39 2007 @@ -0,0 +1,85 @@ +#| +Copyright (c) 2007 +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. The name of the author may not be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +|# + +(in-package :nio-compat) + +(declaim (optimize (debug 3) (speed 3) (space 0))) + +;Implements a threadsafe queue where readers wait for elements of a FIFO queue to appear using a waitqueue +;Modified from sbcl manual example + +(defclass concurrent-queue() + ((buffer-queue :initform (sb-thread:make-waitqueue) + :reader buffer-queue) + (buffer-lock :initform (sb-thread:make-mutex :name "buffer lock") + :reader buffer-lock) + (buffer :initform nil + :accessor buffer))) + +(defmacro pop-elt(a-buffer loc) + `(if ,a-buffer + (let ((head (car ,a-buffer))) + (setf ,a-buffer (cdr ,a-buffer)) +#+nio-debug (format t "reader ~A woke, read ~A as ~A~%" sb-thread:*current-thread* head ,loc) + head) + nil)) + + +(defmethod take ((queue concurrent-queue)) + (sb-thread:with-mutex ((buffer-lock queue)) + ;if its there, pop it + (let ((ret (pop-elt (buffer queue) "1sttry"))) + (if ret + ret + (progn + (sb-thread:condition-wait (buffer-queue queue) (buffer-lock queue)) + (pop-elt (buffer queue) "2ndtry")))))) + + +(defmethod add ((queue concurrent-queue) elt) + (sb-thread:with-mutex ((buffer-lock queue)) + (setf (buffer queue) (append (buffer queue) (list elt)) ) + (sb-thread:condition-notify (buffer-queue queue)))) + + + +(defun test-writer(queue) + (loop for i from 0 to 999 do + (sleep 0.1) + (add queue i))) + +(defun test-reader(queue) + (loop + (format t "reader on ~A got elt ~A~%" + sb-thread:*current-thread* (take queue)))) + +(defun test-queue() + (let ((queue (make-instance 'concurrent-queue))) + (sb-thread:make-thread #'(lambda()(test-writer queue))) + (sleep 10) + (sb-thread:make-thread #'(lambda()(test-reader queue))) + (sb-thread:make-thread #'(lambda()(test-reader queue)))))

1 0

[nio-cvs] r37 - branches/home/psmith/restructure/src/protocol/yarpc
by psmith＠common-lisp.net 15 Jan '07

15 Jan '07

Author: psmith Date: Mon Jan 15 01:49:25 2007 New Revision: 37 Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Log: yarpc roundtrip complete Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp Mon Jan 15 01:49:25 2007 @@ -36,30 +36,48 @@ (make-instance 'yarpc-packet-factory)) (defconstant CALL-METHOD-PACKET-ID #x0) -(defconstant METHOD-RESPONSE-PACKET-ID 1) +(defconstant METHOD-RESPONSE-PACKET-ID #x1) (defmethod get-packet ((pf yarpc-packet-factory) buf) (flip buf) -; (format t "get-packet::read string - ~A~%" (bytebuffer-read-string buf (remaining buf))) - (if (>= (remaining buf) 1) ;; First byte denotes packet ID - (ecase (elt (bytebuffer-read-vector buf 1) 0) - (0 (progn (format t "got CALL-METHOD-PACKET-ID~%") (make-instance 'call-method-packet :call (bytebuffer-read-string buf (remaining buf))))) - (1 (format t "got METHOD-RESPONSE-PACKET-ID~%"))))) + (let ((ret (if (> (remaining buf) 0) ;; First byte denotes packet ID + (ecase (elt (bytebuffer-read-vector buf 1) 0) + (0 (progn (format t "got CALL-METHOD-PACKET-ID~%") (call-method-packet (bytebuffer-read-string buf (remaining buf))))) + (1 (progn (format t "got METHOD-RESPONSE-PACKET-ID~%") (method-response-packet (bytebuffer-read-string buf (remaining buf))))))))) + (if (> (remaining buf) 0) + (error 'not-implemented-yet) + (clear buf)) + ret)) -(defclass call-method-packet (packet)((call-string :initarg :call - :accessor get-call-string))) +(defclass call-method-packet (packet)((call-string :initarg :call-string + :accessor call-string))) + +(defun call-method-packet (call-string) + (make-instance 'call-method-packet :call-string call-string)) (defmethod print-object ((packet call-method-packet) stream) - (format stream "#<CALL-METHOD-PACKET ~A >" (get-call-string packet))) + (format stream "#<CALL-METHOD-PACKET ~A >" (call-string packet))) (defmethod write-bytes((packet call-method-packet) buf) (format t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf) ; (nio-buffer:flip buf) (nio-buffer:bytebuffer-write-vector buf #(#x0)) - (nio-buffer:bytebuffer-write-string buf (get-call-string packet)) + (nio-buffer:bytebuffer-write-string buf (call-string packet)) (format t "yarpc-packet-factory:write-bytes - written ~A~%" buf) ) -(defclass method-response-packet (packet)()) +(defclass method-response-packet (packet) + ((response :initarg :response + :accessor response))) + +(defun method-response-packet (response) + (make-instance 'method-response-packet :response response)) +(defmethod print-object ((packet method-response-packet) stream) + (format stream "#<METHID-RESPONSE-PACKET ~A >" (response packet))) +(defmethod write-bytes((packet method-response-packet) buf) + (format t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf) + (nio-buffer:bytebuffer-write-vector buf #(#x1)) + (nio-buffer:bytebuffer-write-string buf (write-to-string (response packet))) + (format t "yarpc-packet-factory:write-bytes - written ~A~%" buf) ) Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Mon Jan 15 01:49:25 2007 @@ -98,22 +98,28 @@ (setf (outgoing-packet sm) nil) packet)) +;TODO queue and thread stuf +(defmethod queue-outgoing-packet((sm yarpc-state-machine) packet) + (setf (outgoing-packet sm) packet)) ;Process a call method packet, returns (defmethod process-incoming-packet ((sm yarpc-state-machine) (call call-method-packet)) - ;todo change state, create method-response packet and return it - ;(assert (eql state 0)) + (assert (eql state STATE-INITIALISED)) (format t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm call) (handler-case - (let ((result (execute-call (get-call-string call)))) + (let ((result (execute-call (call-string call)))) (when result (let ((response-packet (progn (setf state STATE-SEND-RESPONSE) - (method-response-packet result)))) - (values response-packet t)))) - (reader-error (re) (format t "No such function ~A~%" (get-call-string call))) - (authorization-error (ae) (format t "Function not declared with defremote ~A~%" (get-call-string call))))) - + (queue-outgoing-packet sm (method-response-packet result))))) + t))) + (reader-error (re) (format t "No such function ~A~%" (call-string call))) + (authorization-error (ae) (format t "Function not declared with defremote ~A~%" (call-string call))))) + +(defmethod process-incoming-packet ((sm yarpc-state-machine) (response method-response-packet)) + (assert (eql state STATE-INITIALISED)) + (format t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm response)) + (defun execute-call (call-string) (let* ((rpc-call-list (read-from-string call-string )) @@ -125,5 +131,5 @@ (defmethod remote-execute ((sm yarpc-state-machine) call-string) - (setf (outgoing-packet sm) (make-instance 'call-method-packet :call call-string))) + (queue-outgoing-packet sm (make-instance 'call-method-packet :call-string call-string))) \ No newline at end of file

1 0

[nio-cvs] r36 - in branches/home/psmith/restructure: . src/buffer src/io src/protocol/yarpc src/statemachine
by psmith＠common-lisp.net 15 Jan '07

15 Jan '07

Author: psmith Date: Sun Jan 14 23:52:17 2007 New Revision: 36 Modified: branches/home/psmith/restructure/run-yarpc-client.lisp branches/home/psmith/restructure/src/buffer/buffer.lisp branches/home/psmith/restructure/src/io/nio-server.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp branches/home/psmith/restructure/src/statemachine/state-machine.lisp Log: yarpc ready to create response packet Modified: branches/home/psmith/restructure/run-yarpc-client.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc-client.lisp (original) +++ branches/home/psmith/restructure/run-yarpc-client.lisp Sun Jan 14 23:52:17 2007 @@ -6,6 +6,6 @@ (sleep 4) (let ((sm (nio:add-connection "127.0.0.1" 16323 'nio-yarpc:yarpc-state-machine))) (format t "toplevel adding conn ~A~%" sm) -(format t "Result of remote-execute ~A~%" (nio-yarpc:remote-execute sm "(test-rpc-list)"))) +(format t "Result of remote-execute ~A~%" (nio-yarpc:remote-execute sm "(nio-yarpc:test-rpc-list)"))) Modified: branches/home/psmith/restructure/src/buffer/buffer.lisp ============================================================================== --- branches/home/psmith/restructure/src/buffer/buffer.lisp (original) +++ branches/home/psmith/restructure/src/buffer/buffer.lisp Sun Jan 14 23:52:17 2007 @@ -121,8 +121,8 @@ ;reads bytes from byte-buffer and returns a vector (unsigned-byte 8) (defmethod bytebuffer-read-vector((bb byte-buffer) &optional (num-bytes-to-read (remaining bb))) (let ((vec (make-uint8-seq num-bytes-to-read))) - (with-slots (buf) bb - (inc-position bb (cffi:mem-read-vector vec (buffer-buf bb) :unsigned-char num-bytes-to-read))) + (with-slots (buf position) bb + (inc-position bb (cffi:mem-read-vector vec buf :unsigned-char num-bytes-to-read position))) vec)) ; Read bytes from bytebuffer abd return a string using the supplied decoding Modified: branches/home/psmith/restructure/src/io/nio-server.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/nio-server.lisp (original) +++ branches/home/psmith/restructure/src/io/nio-server.lisp Sun Jan 14 23:52:17 2007 @@ -92,11 +92,11 @@ (declare (ignore cond)) (format t "Poll-error, exiting..~%") (throw 'poll-error-exit nil)))) - - (loop for unix-epoll-events = (poll-events event-queue) do + + (loop + (let ((unix-epoll-events (poll-events event-queue))) (loop for (fd . event) in unix-epoll-events do (cond - ;; new connection ((= fd sock) (let ((async-fd (socket-accept fd connection-type))) @@ -135,7 +135,7 @@ (throw 'error-exit nil)))) (when (read-event-p event) (setf (read-ready async-fd) t)) - (when (write-event-p event) (setf (write-ready async-fd) t)))))))) + (when (write-event-p event) (setf (write-ready async-fd) t))))))))) (format t "Process client adds~%") ;add outgoing sockets to event queue Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp Sun Jan 14 23:52:17 2007 @@ -43,7 +43,7 @@ ; (format t "get-packet::read string - ~A~%" (bytebuffer-read-string buf (remaining buf))) (if (>= (remaining buf) 1) ;; First byte denotes packet ID (ecase (elt (bytebuffer-read-vector buf 1) 0) - (0 (progn (format t "got CALL-METHOD-PACKET-ID~%") (make-instance 'call-method-packet (bytebuffer-read-string buf (remaining buf))))) + (0 (progn (format t "got CALL-METHOD-PACKET-ID~%") (make-instance 'call-method-packet :call (bytebuffer-read-string buf (remaining buf))))) (1 (format t "got METHOD-RESPONSE-PACKET-ID~%"))))) (defclass call-method-packet (packet)((call-string :initarg :call Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp ============================================================================== --- branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp (original) +++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Sun Jan 14 23:52:17 2007 @@ -100,9 +100,10 @@ ;Process a call method packet, returns -(defmethod process-incomming-packet ((sm yarpc-state-machine) (call call-method-packet)) +(defmethod process-incoming-packet ((sm yarpc-state-machine) (call call-method-packet)) ;todo change state, create method-response packet and return it ;(assert (eql state 0)) + (format t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm call) (handler-case (let ((result (execute-call (get-call-string call)))) (when result Modified: branches/home/psmith/restructure/src/statemachine/state-machine.lisp ============================================================================== --- branches/home/psmith/restructure/src/statemachine/state-machine.lisp (original) +++ branches/home/psmith/restructure/src/statemachine/state-machine.lisp Sun Jan 14 23:52:17 2007 @@ -31,7 +31,7 @@ ; ;Base class for state machines ; -;Converts incomming data between bytes and packets using the supplied packet-factory. +;Converts incoming data between bytes and packets using the supplied packet-factory. ;Converts outgoing data between packets and bytes using the write-bytes method on packet. ; ;This way only the protocols packet heirarchy knows about binary representations and @@ -42,7 +42,7 @@ (defmethod print-object ((sm state-machine) stream) (format stream "#<STATE-MACHINE ~A >" (call-next-method sm nil))) -(defgeneric process-incomming-packet(state-machine packet)) +(defgeneric process-incoming-packet(state-machine packet)) (defgeneric process-outgoing-packet(state-machine)) @@ -54,10 +54,10 @@ ;Use the packet factory to obtain any valid packet and pass it through (defmethod process-read((sm state-machine)) (with-slots (foreign-read-buffer) sm - (let ((incomming-packet (get-packet (get-packet-factory sm) foreign-read-buffer))) - (format t "state-machine::process-read - incomming packet: ~A~%" incomming-packet) - (when incomming-packet - (when (not (process-incomming-packet sm incomming-packet)) + (let ((incoming-packet (get-packet (get-packet-factory sm) foreign-read-buffer))) + (format t "state-machine::process-read - incoming packet: ~A~%" incoming-packet) + (when incoming-packet + (when (not (process-incoming-packet sm incoming-packet)) (close-sm sm)))))) ;The connection is write ready.

1 0