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

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

29 Jan '07

Author: psmith Date: Sun Jan 28 21:35:58 2007 New Revision: 55 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/buffer/nio-buffer-package.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp Log: large packet support first working version 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 28 21:35:58 2007 @@ -1,4 +1,4 @@ -;(push :nio-debug *features*) +(push :nio-debug *features*) (require :asdf) (require :nio-yarpc) Modified: branches/home/psmith/restructure/run-yarpc.lisp ============================================================================== --- branches/home/psmith/restructure/run-yarpc.lisp (original) +++ branches/home/psmith/restructure/run-yarpc.lisp Sun Jan 28 21:35:58 2007 @@ -1,6 +1,6 @@ ;Runs a multithreaded system with an IO thread dealing with IO only and a 'job' thread taking and executing jobs -;(push :nio-debug *features*) +(push :nio-debug *features*) (require :asdf) (require :nio-yarpc) 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 28 21:35:58 2007 @@ -175,14 +175,25 @@ (inc-position bb 4) val)) +;write an 8 bit value and up date position in buffer (defmethod bytebuffer-write-8 ((bb byte-buffer) value) (setf (cffi:mem-ref (buffer-buf bb) :unsigned-char (buffer-position bb)) value) (inc-position bb 1)) +;write a 32 bit value and up date position in buffer (defmethod bytebuffer-write-32 ((bb byte-buffer) value) (setf (cffi:mem-ref (buffer-buf bb) :unsigned-int (buffer-position bb)) value) (inc-position bb 4)) +;insert an 8 bit value +(defmethod bytebuffer-insert-8 ((bb byte-buffer) value byte-position) + (setf (cffi:mem-ref (buffer-buf bb) :unsigned-char byte-position) value)) + +;insert a 32 bit value +(defmethod bytebuffer-insert-32 ((bb byte-buffer) value byte-position) + (setf (cffi:mem-ref (buffer-buf bb) :unsigned-int byte-position) value)) + + ;; Write bytes from vector vec to bytebuffer Modified: branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp ============================================================================== --- branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp (original) +++ branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp Sun Jan 28 21:35:58 2007 @@ -29,6 +29,7 @@ (:export byte-buffer free-buffer remaining inc-position get-string buffer-buf bytebuffer-write-vector bytebuffer-write-string - bytebuffer-read-vector bytebuffer-read-string bytebuffer-read-8 bytebuffer-read-32 + bytebuffer-read-vector bytebuffer-read-string + bytebuffer-read-8 bytebuffer-read-32 bytebuffer-write-8 bytebuffer-write-32 bytebuffer-insert-8 bytebuffer-insert-32 flip unflip clear buffer-position copy-buffer buffer-capacity )) 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 28 21:35:58 2007 @@ -35,8 +35,14 @@ (defun yarpc-packet-factory () (make-instance 'yarpc-packet-factory)) -(defconstant CALL-METHOD-PACKET-ID #x0) -(defconstant METHOD-RESPONSE-PACKET-ID #x1) +(defconstant +CALL-METHOD-PACKET-ID+ #x0) +(defconstant +METHOD-RESPONSE-PACKET-ID+ #x1) + +(defconstant +PACKET-ID-SIZE+ 1) +(defconstant +PACKET-LENGTH-SIZE+ 4) + +(defconstant +yarpc-packet-header-size+ + (+ +PACKET-ID-SIZE+ +PACKET-LENGTH-SIZE+)) (defmethod get-packet ((pf yarpc-packet-factory) buf) (flip buf) @@ -56,13 +62,6 @@ (defclass call-method-packet (packet)((call-string :initarg :call-string :accessor call-string))) - -(defconstant +PACKET-ID-SIZE+ 1) -(defconstant +PACKET-LENGTH-SIZE+ 4) - -(defconstant +yarpc-packet-header-size+ - (+ +PACKET-ID-SIZE+ +PACKET-LENGTH-SIZE+)) - (defun call-method-packet (call-string) (make-instance 'call-method-packet :call-string call-string)) @@ -70,11 +69,13 @@ (format stream "#<CALL-METHOD-PACKET ~A >" (call-string packet))) (defmethod write-bytes((packet call-method-packet) buf) -#+nio-debug (format-log t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf) - (nio-buffer:bytebuffer-write-vector buf #(#x0)) + #+nio-debug (format-log t "yarpc-packet-factory:write-bytes(call-method-packet) - writing ~%~A to ~%~A~%" packet buf) + (nio-buffer:bytebuffer-write-8 buf +CALL-METHOD-PACKET-ID+) + (nio-buffer:bytebuffer-write-32 buf 0) ; come back and write length later (nio-buffer:bytebuffer-write-string buf (call-string packet)) -#+nio-debug (format-log t "yarpc-packet-factory:write-bytes - written ~A~%" buf) -) + (nio-buffer:bytebuffer-insert-32 buf (buffer-position buf) 1) + #+nio-debug (format-log t "yarpc-packet-factory:write-bytes(call-method-packet) - written ~%~A ~%" buf) + ) (defclass method-response-packet (packet) @@ -89,7 +90,9 @@ (defmethod write-bytes((packet method-response-packet) buf) #+nio-debug (format-log t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf) - (nio-buffer:bytebuffer-write-vector buf #(#x1)) + (nio-buffer:bytebuffer-write-8 buf +METHOD-RESPONSE-PACKET-ID+) + (nio-buffer:bytebuffer-write-32 buf 0) ; come back and write length later (nio-buffer:bytebuffer-write-string buf (write-to-string (response packet))) + (nio-buffer:bytebuffer-insert-32 buf (buffer-position buf) 1) #+nio-debug (format-log t "yarpc-packet-factory:write-bytes - written ~A~%" buf) )

1 0

[nio-cvs] r54 - branches/home/psmith/restructure/src/buffer
by psmith＠common-lisp.net 29 Jan '07

29 Jan '07

Author: psmith Date: Sun Jan 28 20:54:10 2007 New Revision: 54 Modified: branches/home/psmith/restructure/src/buffer/buffer.lisp Log: Added 8 & 32 accessors for the bytebuffer 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 28 20:54:10 2007 @@ -68,6 +68,12 @@ ;;-- end utils +(defun get-readable-char (char-code) + (if (<= char-code 32) + (code-char 46) + (if (> char-code 127) + (code-char 46) + (code-char char-code)))) (defun pretty-hex-dump (start-address length) ; (format t "start: ~A length ~A~%" start-address length) @@ -86,7 +92,7 @@ (format readable "--")) (progn (format str (if (eql column-index 7) "~A " "~A ") (hex-dump-byte address)) - (format readable "~A" (code-char (byte-value address))))))))))))) + (format readable "~A" (get-readable-char (byte-value address))))))))))))) (defun make-uint8-seq (size) "Make uint8 sequence." @@ -100,7 +106,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 @@ -171,9 +177,14 @@ (defmethod bytebuffer-write-8 ((bb byte-buffer) value) (setf (cffi:mem-ref (buffer-buf bb) :unsigned-char (buffer-position bb)) value) -; (cffi:mem-set value (buffer-buf bb) :unsigned-char position) (inc-position bb 1)) +(defmethod bytebuffer-write-32 ((bb byte-buffer) value) + (setf (cffi:mem-ref (buffer-buf bb) :unsigned-int (buffer-position bb)) value) + (inc-position bb 4)) + + + ;; Write bytes from vector vec to bytebuffer (defmethod bytebuffer-write-vector((bb byte-buffer) vec) :documentation "Returns number of bytes written to bytebuffer" @@ -244,6 +255,23 @@ (format t "Mybuf (after clear): ~A~%" (clear mybuf)) + ;test accessors + (setf (buffer-position mybuf) 11) + (bytebuffer-write-8 mybuf 243) + (assert (eql (buffer-position mybuf) 12)) + (setf (buffer-position mybuf) 11) + (assert (eql (bytebuffer-read-8 mybuf) 243)) + (format t "Mybuf (after r/w 8bit): ~A~%" mybuf) + + (setf (buffer-position mybuf) 11) + (bytebuffer-write-32 mybuf 2147483649) + (assert (eql (buffer-position mybuf) 15)) + (setf (buffer-position mybuf) 11) + (assert (eql (bytebuffer-read-32 mybuf) 2147483649)) + (format t "Mybuf (after r/w 32bit): ~A~%" mybuf) + + + (free-buffer mybuf) (format t "Mybuf after free: ~A~%" mybuf)))

1 0

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

28 Jan '07

Author: psmith Date: Sat Jan 27 20:43:47 2007 New Revision: 53 Modified: branches/home/psmith/restructure/src/buffer/buffer.lisp branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp branches/home/psmith/restructure/src/io/async-fd.lisp branches/home/psmith/restructure/src/io/nio-package.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp branches/home/psmith/restructure/src/statemachine/state-machine.lisp Log: start of large packet support 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 Sat Jan 27 20:43:47 2007 @@ -35,7 +35,6 @@ (declaim (optimize (debug 3) (speed 3) (space 0))) - (defclass buffer () ((capacity :initarg :capacity :initform 0 @@ -93,14 +92,12 @@ "Make uint8 sequence." (make-sequence '(vector (unsigned-byte 8)) size :initial-element 0)) - ;;A buffer that deals with bytes (defclass byte-buffer (buffer)()) (defun byte-buffer (capacity) (make-instance 'byte-buffer :capacity capacity :limit capacity :position 0 :buf (cffi:foreign-alloc :uint8 :count capacity))) - (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)))) @@ -113,11 +110,15 @@ (setf limit 0) (setf position 0))) - +;bytes between the position and the limit (defmethod remaining((byte-buffer byte-buffer)) (with-slots (position limit) byte-buffer (- limit position))) +;bytes between the current position and capacity +(defmethod remaining-capacity((byte-buffer byte-buffer)) + (with-slots (position capacity) byte-buffer + (- capacity position))) (defmethod inc-position((byte-buffer byte-buffer) num-bytes) (with-slots (position limit) byte-buffer @@ -131,6 +132,12 @@ (setf limit position) (setf position 0))) +(defmethod unflip((byte-buffer byte-buffer)) + :documentation "make buffer ready for relative write operation. Used on partial read to reset the buffer for writing" + (with-slots (position limit capacity) byte-buffer + (setf position limit) + (setf limit capacity))) + (defmethod clear((byte-buffer byte-buffer)) :documentation "Reset the position to 0 and the limit to capacity" (with-slots (position limit capacity) byte-buffer @@ -150,11 +157,22 @@ (defmethod bytebuffer-read-string((bb byte-buffer) &optional (num-bytes-to-read (remaining bb)) (external-format :ascii)) (sb-ext:octets-to-string (bytebuffer-read-vector bb num-bytes-to-read) :external-format external-format)) - -;grrr... -;(defmethod bytebuffer-write-byte ((bb byte-buffer) value) -; (cffi:%mem-set value (buffer-buf bb) :unsigned-char position) -; (inc-position bb 1)) +; Read a byte from bytebuffer and return it incrementing the byte-buffers position +(defmethod bytebuffer-read-8((bb byte-buffer)) + (let ((val (cffi:mem-ref (cffi:make-pointer (+ (cffi:pointer-address (buffer-buf bb)) (buffer-position bb))) :unsigned-char ))) + (inc-position bb 1) + val)) + +; Read a 32 bit integer from bytebuffer and return it incrementing the byte-buffers position +(defmethod bytebuffer-read-32((bb byte-buffer)) + (let ((val (cffi:mem-ref (cffi:make-pointer (+ (cffi:pointer-address (buffer-buf bb)) (buffer-position bb))) :unsigned-int ))) + (inc-position bb 4) + val)) + +(defmethod bytebuffer-write-8 ((bb byte-buffer) value) + (setf (cffi:mem-ref (buffer-buf bb) :unsigned-char (buffer-position bb)) value) +; (cffi:mem-set value (buffer-buf bb) :unsigned-char position) + (inc-position bb 1)) ;; Write bytes from vector vec to bytebuffer (defmethod bytebuffer-write-vector((bb byte-buffer) vec) @@ -200,8 +218,8 @@ (let ((mybuf (byte-buffer 32))) (format t "Mybuf: ~A~%" mybuf) (assert (eql 32 (remaining mybuf))) - (inc-position mybuf 2) - (assert (eql 30 (remaining mybuf))) + (inc-position mybuf 4) + (assert (eql 28 (remaining mybuf))) (format t "Mybuf: ~A~%" mybuf) (%memset (buffer-buf mybuf) 78 4) @@ -221,6 +239,9 @@ (copy-buffer mybuf test-copy) (format t "new copy: ~A~%" test-copy)) + (setf (buffer-position mybuf) 0) + (format t "bytebuffer-read-32 ~X~%" (bytebuffer-read-32 mybuf)) + (format t "Mybuf (after clear): ~A~%" (clear mybuf)) (free-buffer mybuf) Modified: branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp ============================================================================== --- branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp (original) +++ branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp Sat Jan 27 20:43:47 2007 @@ -27,5 +27,8 @@ (defpackage :nio-buffer (:use :cl) (:export - byte-buffer free-buffer remaining inc-position get-string buffer-buf bytebuffer-write-vector bytebuffer-write-string bytebuffer-read-vector bytebuffer-read-string flip clear buffer-position copy-buffer + byte-buffer free-buffer remaining inc-position get-string buffer-buf + bytebuffer-write-vector bytebuffer-write-string + bytebuffer-read-vector bytebuffer-read-string bytebuffer-read-8 bytebuffer-read-32 + flip unflip clear buffer-position copy-buffer buffer-capacity )) 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 Sat Jan 27 20:43:47 2007 @@ -161,7 +161,7 @@ (setf (foreign-read-buffer async-fd) new-buffer)))) -;(recom +;TODO actually deal with cuffer allocation failure (defmethod recommend-buffer-size((async-fd async-fd) mode size) (if (> size +MAX-BUFFER-SIZE-BYTES+) nil (ecase mode Modified: branches/home/psmith/restructure/src/io/nio-package.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/nio-package.lisp (original) +++ branches/home/psmith/restructure/src/io/nio-package.lisp Sat Jan 27 20:43:47 2007 @@ -30,6 +30,7 @@ ;; async-fd.lisp async-fd process-read process-write foreign-read-buffer foreign-write-buffer close-sm + recommend-buffer-size ;; async-socket.lisp 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 Sat Jan 27 20:43:47 2007 @@ -40,18 +40,29 @@ (defmethod get-packet ((pf yarpc-packet-factory) buf) (flip buf) - (let ((ret (if (> (remaining buf) 0) ;; First byte denotes packet ID - (ecase (elt (bytebuffer-read-vector buf 1) 0) - (0 (progn (format-log t "yarpc-packet-factory:get-packet - got CALL-METHOD-PACKET-ID~%") (call-method-packet (bytebuffer-read-string buf (remaining buf))))) - (1 (progn (format-log t "yarpc-packet-factory:get-packet - 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)) + (if (>= (remaining buf) +yarpc-packet-header-size+) ;; First byte denotes packet ID ;;bytes 2,3,4,5 denote packet size + (let ((packet-id (bytebuffer-read-8 buf)) + (packet-length (bytebuffer-read-32 buf))) + (if (<= (- packet-length +yarpc-packet-header-size+) (remaining buf)) ;is the whole packet available in the buffer? + (ecase packet-id + (0 (progn (format-log t "yarpc-packet-factory:get-packet - got CALL-METHOD-PACKET-ID~%") (call-method-packet (bytebuffer-read-string buf (- packet-length +yarpc-packet-header-size+))))) + (1 (progn (format-log t "yarpc-packet-factory:get-packet - got METHOD-RESPONSE-PACKET-ID~%") (method-response-packet (bytebuffer-read-string buf (- packet-length +yarpc-packet-header-size+)))))) + (let ((buffer-capacity (buffer-capacity buf))) + ;Failed to read a whole packet unflip and check size + (unflip buf) + (if (> packet-length buffer-capacity) (error 'buffer-too-small-error :recommended-size packet-length))))))) + + (defclass call-method-packet (packet)((call-string :initarg :call-string :accessor call-string))) +(defconstant +PACKET-ID-SIZE+ 1) +(defconstant +PACKET-LENGTH-SIZE+ 4) + +(defconstant +yarpc-packet-header-size+ + (+ +PACKET-ID-SIZE+ +PACKET-LENGTH-SIZE+)) + (defun call-method-packet (call-string) (make-instance 'call-method-packet :call-string call-string)) 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 Sat Jan 27 20:43:47 2007 @@ -78,3 +78,12 @@ ; Get the packet in buf using the packet factory (defgeneric get-packet (packet-factory buf)) + +;Used to signal that the packet wants a larger buffer to complete this packet +(define-condition buffer-too-small-error (error) + ((recommended-size :initarg :recommended-size))) + +(defun buffer-too-small-error(recommended-size) + (make-instance 'buffer-too-small-error :recommended-size recommended-size)) + +

1 0

[nio-cvs] r52 - branches/home/psmith/restructure/src/buffer
by psmith＠common-lisp.net 25 Jan '07

25 Jan '07

Author: psmith Date: Wed Jan 24 22:38:10 2007 New Revision: 52 Modified: branches/home/psmith/restructure/src/buffer/buffer.lisp Log: added copy-buffer test 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 24 22:38:10 2007 @@ -103,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 (pretty-hex-dump (cffi:pointer-address buf) limit) nil)))) + (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)))) (defmethod free-buffer((byte-buffer byte-buffer)) (with-slots (capacity position limit buf) byte-buffer @@ -180,7 +180,9 @@ (defmethod copy-buffer ((old byte-buffer) (new byte-buffer)) (assert (<= (buffer-capacity old) (buffer-capacity new))) - (%memcpy (buffer-buf new) (buffer-buf old) (buffer-capacity old))) + (%memcpy (buffer-buf new) (buffer-buf old) (buffer-capacity old)) + (setf (buffer-position new) (buffer-position old)) + (setf (buffer-limit new) (buffer-limit old))) ;void *memcpy(void *dest, const void *src, size_t n); (cffi:defcfun ("memcpy" %memcpy) :pointer @@ -205,8 +207,8 @@ (%memset (buffer-buf mybuf) 78 4) (format t "Mybuf (after memset): ~A~%" mybuf) -; (flip mybuf) -; (format t "Mybuf (after flip): ~A~%" mybuf) + (flip mybuf) + (format t "Mybuf (after flip): ~A~%" mybuf) (format t "Remaining ~A~%" (remaining mybuf))

1 0

[nio-cvs] r51 - in branches/home/psmith/restructure/src: buffer io
by psmith＠common-lisp.net 23 Jan '07

23 Jan '07

Author: psmith Date: Tue Jan 23 00:52:09 2007 New Revision: 51 Modified: branches/home/psmith/restructure/src/buffer/buffer.lisp branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp branches/home/psmith/restructure/src/io/async-fd.lisp Log: Added copy-buffer and recommend-buffer-size 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 Tue Jan 23 00:52:09 2007 @@ -177,6 +177,18 @@ (bytebuffer-write-vector bb (sb-ext:string-to-octets str :external-format external-format))) + +(defmethod copy-buffer ((old byte-buffer) (new byte-buffer)) + (assert (<= (buffer-capacity old) (buffer-capacity new))) + (%memcpy (buffer-buf new) (buffer-buf old) (buffer-capacity old))) + +;void *memcpy(void *dest, const void *src, size_t n); +(cffi:defcfun ("memcpy" %memcpy) :pointer + (dest :pointer) + (src :pointer) + (len :int)) + +;void *memset(void *s, int c, size_t n); (cffi:defcfun ("memset" %memset) :pointer (buffer :pointer) (byte :int) @@ -203,6 +215,10 @@ (format t "Mybuf (after get-string): ~A~%" mybuf) + (let ((test-copy (byte-buffer 1024))) + (copy-buffer mybuf test-copy) + (format t "new copy: ~A~%" test-copy)) + (format t "Mybuf (after clear): ~A~%" (clear mybuf)) (free-buffer mybuf) Modified: branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp ============================================================================== --- branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp (original) +++ branches/home/psmith/restructure/src/buffer/nio-buffer-package.lisp Tue Jan 23 00:52:09 2007 @@ -27,5 +27,5 @@ (defpackage :nio-buffer (:use :cl) (:export - byte-buffer free-buffer remaining inc-position get-string buffer-buf bytebuffer-write-vector bytebuffer-write-string bytebuffer-read-vector bytebuffer-read-string flip clear buffer-position + byte-buffer free-buffer remaining inc-position get-string buffer-buf bytebuffer-write-vector bytebuffer-write-string bytebuffer-read-vector bytebuffer-read-string flip clear buffer-position copy-buffer )) 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 Tue Jan 23 00:52:09 2007 @@ -28,49 +28,24 @@ (declaim (optimize (debug 3) (speed 3) (space 0))) -;;; FFI - - - -;;; CLASSES - - - - - - (defclass async-fd () ((write-fd :initarg :write-fd :accessor write-fd) -;; (write-queue :initform nil) - (read-fd :initarg :read-fd :accessor read-fd) - (foreign-read-buffer :initform (byte-buffer 1024) :accessor foreign-read-buffer) (foreign-write-buffer :initform (byte-buffer 1024) :accessor foreign-write-buffer) - -;; (lisp-read-buffer :initform (make-uint8-seq 1024)) -;; (lisp-read-buffer-write-ptr :initform 0) - (read-ready :initform nil :accessor read-ready :documentation "Have we been notified as read ready and not received EAGAIN from %read?") (write-ready :initform nil :accessor write-ready :documentation "Have we been notified as write ready and not received EAGAIN from %write?") - (close-pending :initform nil) - -;; (accept-filter :initform nil) -;; (read-callback :initform nil) - (socket :initarg :socket - :accessor socket) - - )) + :accessor socket))) (defmethod print-object ((async-fd async-fd) stream) @@ -93,7 +68,6 @@ sm)) ;;override this in concrete SM for close -;(defmethod process-close((async-fd async-fd)reason)()) (defmethod process-close((async-fd async-fd)reason)()) @@ -103,30 +77,23 @@ (with-slots (close-pending) async-fd (setf close-pending t))) -;;; FUNCTIONS - (define-condition read-error (error) ()) ;; "Read more data from STATE-MACHINE." (defun read-more (state-machine) (with-slots (foreign-read-buffer read-fd) 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)))) #+nio-debug (format t "read-more : Read ~A bytes into ~A~%" new-bytes foreign-read-buffer) (cond ((< new-bytes 0) (progn - ;;TODO if ret is -1 and errno is EAGAIN save state and wait for notification - (format t "read-error - Errno: ~A~%" (get-errno)) (error 'read-error))) - ((= new-bytes 0) nil);;(throw 'end-of-file nil) - (t ;;Update buffer position (inc-position foreign-read-buffer new-bytes) @@ -146,7 +113,6 @@ (define-condition read-error (error) ()) - (defun write-more (async-fd) "Write data from ASYNC-FD's write bytebuffer" (format-log t "async-fd:write-more - called with ~A~%" async-fd) @@ -154,23 +120,17 @@ #+nio-debug (format t "async-fd:write-more - foreign-write-buffer b4 flip ~A~%" foreign-write-buffer) (nio-buffer:flip foreign-write-buffer) #+nio-debug (format t "async-fd:write-more -foreign-write-buffer after flip ~A~%" foreign-write-buffer) - (let ((now-written 0)) (do ((total-written 0)) ((or (eql now-written -1) (eql (remaining foreign-write-buffer) 0)) total-written) (progn (setf now-written (%write write-fd (buffer-buf foreign-write-buffer) (remaining foreign-write-buffer))) - - (when (not (eql now-written -1)) (inc-position foreign-write-buffer now-written) (incf total-written now-written))) -#+nio-debug (format t "async-fd:write-more - after write :foreign-write-buffer ~A :now-written ~A :total-written ~A ~%" foreign-write-buffer now-written total-written) - ) - - +#+nio-debug (format t "async-fd:write-more - after write :foreign-write-buffer ~A :now-written ~A :total-written ~A ~%" foreign-write-buffer now-written total-written)) (if (eql now-written -1) - ;;Deal with failure + ;;Deal with failure (let ((err (get-errno))) (format t "write-more - write returned -1 :errno ~A~%" err) (unless (eql err 11) ;; eagain - failed to write whole buffer need to wait for next notify @@ -181,15 +141,33 @@ (if (eql (remaining foreign-write-buffer) 0) (clear foreign-write-buffer) (error 'not-implemented-yet)))) - + #+nio-debug (format t "write buffer after write :~A~%" foreign-write-buffer) (when (eql (remaining foreign-write-buffer) 0) (when close-pending (close-async-fd async-fd))))) - +(defconstant +MAX-BUFFER-SIZE-BYTES+ (* 1024 1024)) +(defmacro check-buffer-size (buffer size) + `(>= (length ,buffer) ,size)) +(defun realloc-buffer (async-fd buffer size) + (if (check-buffer-size buffer size) + t + (let ((new-buffer (byte-buffer size))) + (copy-buffer buffer new-buffer) + (free-buffer buffer) + (setf (foreign-read-buffer async-fd) new-buffer)))) + + +;(recom +(defmethod recommend-buffer-size((async-fd async-fd) mode size) + (if (> size +MAX-BUFFER-SIZE-BYTES+) nil + (ecase mode + (:read (realloc-buffer (foreign-read-buffer async-fd) size)) + (:write (realloc-buffer (foreign-write-buffer async-fd) size))))) + (defun force-close-async-fd (async-fd) @@ -200,10 +178,7 @@ (defun add-async-fd (event-queue async-fd mode) (ecase mode -;; (:read (add-fd event-queue (slot-value async-fd 'read-fd) :read :trigger :level)) -;; (:write (add-fd event-queue (slot-value async-fd 'write-fd) :write :trigger :level)) - (:read-write (add-fd event-queue (slot-value async-fd 'write-fd) :read-write)) -)) + (:read-write (add-fd event-queue (slot-value async-fd 'write-fd) :read-write)))) (defun remove-async-fd (event-queue async-fd mode)

1 0

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

22 Jan '07

Author: psmith Date: Mon Jan 22 00:54:43 2007 New Revision: 50 Modified: 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/yarpc-client-state-machine.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Log: logging tidyup 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 Mon Jan 22 00:54:43 2007 @@ -87,7 +87,7 @@ ;;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))) - (format t "create-state-machine - Created ~S~%" sm) + (format-log t "async-fd:create-state-machine - Created ~S~%" sm) (nio-buffer:clear (foreign-read-buffer sm)) (nio-buffer:clear (foreign-write-buffer sm)) sm)) 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 Mon Jan 22 00:54:43 2007 @@ -137,7 +137,7 @@ (init-inet-socket sa port addr) (let ((res (%connect socket-fd sa +sockaddr-in-len+))) - (format t "connect ~A ~A~%" res (get-errno)) + (format-log t "async-socket:connect-inet-socket library connect call returned ~A, and errno ~A~%" res (get-errno)) (if (= res -1) nil t)))) 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 Mon Jan 22 00:54:43 2007 @@ -40,8 +40,8 @@ ;loop over hashtable (defun process-async-fds (client-hash) (maphash #'(lambda (k async-fd) - (format t "Dealing with ~a => ~a~%" k async-fd) - + (format-log t "Dealing with ~a => ~a~%" k async-fd) + ;process reads (when (read-ready async-fd) (read-more async-fd)) (when (> (buffer-position (foreign-read-buffer async-fd)) 0) @@ -115,7 +115,7 @@ ;; no accept, close (t - (format t "start-server - accept-connection closed~%") + (format-log t "start-server - accept-connection closed~%") (close-async-fd async-fd))))) @@ -136,12 +136,11 @@ (when (read-event-p event) (setf (read-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 - (format t "start-server::sockets enqueued ~A~%" +connected-sockets+) + (format-log t "nio-server:start-server - Processing client add ~A~%" +connected-sockets+) (loop for new-fd in +connected-sockets+ do - (format t "Dealing with ~A~%" new-fd) + (format-log t "nio-server:start-server - Dealing with ~A~%" new-fd) (setf (gethash (async-fd-read-fd new-fd) client-hash) new-fd) (add-async-fd event-queue new-fd :read-write)) @@ -168,7 +167,7 @@ (if (connect-inet-socket sock host port) (let ((sm (create-state-machine connection-type sock sock sock))) (push sm +connected-sockets+) - (format t "add-connection::sockets enqueued ~A~%" +connected-sockets+) + (format-log t "nio-server:add-connection - Socket enqueued: ~A~%" +connected-sockets+) (return-from add-connection sm)) (format t "Connect failed!!~A ~%" (get-errno))))) \ No newline at end of file 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 Mon Jan 22 00:54:43 2007 @@ -56,16 +56,16 @@ (defconstant STATE-SENT-REQUEST 1) (defmethod process-outgoing-packet((sm yarpc-client-state-machine)) - (format t "process-outgoing-packet called, polling the job-queue ~%") + (format-log t "yarpc-client-state-machine: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) + (format-log t "yarpc-client-state-machine:process-outgoing-packet got job ~A ~%" packet) (setf (state sm) STATE-SENT-REQUEST)) packet)) (defmethod process-incoming-packet ((sm yarpc-client-state-machine) (response method-response-packet)) (assert (eql (state sm) STATE-SENT-REQUEST)) - (format t "yarpc-client-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm response) + (format-log 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)))) (setf (state sm) STATE-INITIALISED) 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 22 00:54:43 2007 @@ -42,8 +42,8 @@ (flip buf) (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))))))))) + (0 (progn (format-log t "yarpc-packet-factory:get-packet - got CALL-METHOD-PACKET-ID~%") (call-method-packet (bytebuffer-read-string buf (remaining buf))))) + (1 (progn (format-log t "yarpc-packet-factory:get-packet - got METHOD-RESPONSE-PACKET-ID~%") (method-response-packet (bytebuffer-read-string buf (remaining buf))))))))) (if (> (remaining buf) 0) (error 'not-implemented-yet) (clear buf)) @@ -59,10 +59,10 @@ (format stream "#<CALL-METHOD-PACKET ~A >" (call-string packet))) (defmethod write-bytes((packet call-method-packet) buf) -#+nio-debug (format t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf) +#+nio-debug (format-log 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)) -#+nio-debug (format t "yarpc-packet-factory:write-bytes - written ~A~%" buf) +#+nio-debug (format-log t "yarpc-packet-factory:write-bytes - written ~A~%" buf) ) @@ -77,8 +77,8 @@ (format stream "#<METHID-RESPONSE-PACKET ~A >" (response packet))) (defmethod write-bytes((packet method-response-packet) buf) -#+nio-debug (format t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf) +#+nio-debug (format-log 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))) -#+nio-debug (format t "yarpc-packet-factory:write-bytes - written ~A~%" buf) +#+nio-debug (format-log 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 22 00:54:43 2007 @@ -59,23 +59,23 @@ (defun run-job(&key (wait-on-job-pdw t)) - (format-log t "Server toplevel waiting for job~%") + (format-log t "yarpc-state-machine:run-job - Server toplevel waiting for job~%") (destructuring-bind (job result-queue) (nio-compat:take nio-yarpc:job-queue :blocking-call wait-on-job-pdw) - (format-log t "Server received job ~A~%" job) + (format-log t "yarpc-state-machine:run-job - Server received job ~A~%" job) (nio-compat:add result-queue (nio-yarpc:execute-call job)))) (defmethod process-outgoing-packet((sm yarpc-state-machine)) - (format-log t "yarpc-state-machine: process-outgoing-packet called, polling the results-queue ~%" ) + (format-log t "yarpc-state-machine:process-outgoing-packet - called, polling the results-queue ~%" ) (let ((result (nio-compat:take (result-queue sm) :blocking-call nil))) - (format t "yarpc-state-machine: process-outgoing-packet got result ~A ~%" result) + (format-log t "yarpc-state-machine:process-outgoing-packet - got result ~A ~%" result) (when result (method-response-packet result)))) ;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 sm) STATE-INITIALISED)) - (format-log t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm call) + (format-log 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))) (when +process-jobs-inline+ (run-job :wait-on-job-pdw nil))) @@ -104,7 +104,7 @@ (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) + (format-log t "yarpc-state-machine:execute-call - 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))))

1 0

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

22 Jan '07

Author: psmith Date: Sun Jan 21 23:12:43 2007 New Revision: 49 Added: branches/home/psmith/restructure/src/utils/nio-utils-package.lisp - copied, changed from r48, branches/home/psmith/restructure/src/compat/nio-compat-package.lisp branches/home/psmith/restructure/src/utils/nio-utils.asd - copied, changed from r44, branches/home/psmith/restructure/src/compat/nio-compat.asd branches/home/psmith/restructure/src/utils/utils.lisp - copied, changed from r48, branches/home/psmith/restructure/src/compat/utils.lisp Removed: branches/home/psmith/restructure/src/compat/utils.lisp Modified: branches/home/psmith/restructure/run-yarpc-client.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/nio-package.lisp branches/home/psmith/restructure/src/io/nio.asd branches/home/psmith/restructure/src/protocol/yarpc/nio-yarpc-package.lisp branches/home/psmith/restructure/src/statemachine/nio-sm-package.lisp branches/home/psmith/restructure/src/statemachine/nio-sm.asd Log: Moved utils to own package 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 21 23:12:43 2007 @@ -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))) - (format-log t "toplevel adding conn ~A~%" sm) + (nio-utils:format-log t "toplevel adding conn ~A~%" sm) (loop - (format-log t "Toplevel Submitting job~%" ) - (format-log t "Result of remote-execute ~A~%" (nio-yarpc:remote-execute sm "(nio-yarpc:test-rpc-list)")))) + (nio-utils:format-log t "Toplevel Submitting job~%" ) + (nio-utils:format-log t "Result of remote-execute ~A~%" (nio-yarpc:remote-execute sm "(nio-yarpc:test-rpc-list)")))) 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 Sun Jan 21 23:12:43 2007 @@ -33,7 +33,4 @@ ;;concurrent-queue concurrent-queue add take - - ;;utils - format-log )) 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 Sun Jan 21 23:12:43 2007 @@ -7,7 +7,6 @@ :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 ()) Modified: branches/home/psmith/restructure/src/io/nio-package.lisp ============================================================================== --- branches/home/psmith/restructure/src/io/nio-package.lisp (original) +++ branches/home/psmith/restructure/src/io/nio-package.lisp Sun Jan 21 23:12:43 2007 @@ -24,7 +24,7 @@ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |# -(defpackage :nio (:use :cl :cffi :event-notification :nio-buffer :nio-compat) +(defpackage :nio (:use :cl :cffi :nio-utils :event-notification :nio-buffer :nio-compat) (:export Modified: branches/home/psmith/restructure/src/io/nio.asd ============================================================================== --- branches/home/psmith/restructure/src/io/nio.asd (original) +++ branches/home/psmith/restructure/src/io/nio.asd Sun Jan 21 23:12:43 2007 @@ -12,5 +12,5 @@ (:file "nio-server" :depends-on ("async-socket")) ) - :depends-on (:cffi :event-notification :nio-buffer :nio-compat)) + :depends-on (:cffi :event-notification :nio-buffer :nio-compat :nio-utils)) 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 Sun Jan 21 23:12:43 2007 @@ -24,7 +24,7 @@ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |# -(defpackage :nio-yarpc (:use :cl :nio :nio-sm :nio-buffer) +(defpackage :nio-yarpc (:use :cl :nio :nio-sm :nio-buffer :nio-utils) (:export 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 Sun Jan 21 23:12:43 2007 @@ -24,7 +24,7 @@ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |# -(defpackage :nio-sm (:use :cl :nio :nio-buffer) +(defpackage :nio-sm (:use :cl :nio :nio-buffer :nio-utils) (:export Modified: branches/home/psmith/restructure/src/statemachine/nio-sm.asd ============================================================================== --- branches/home/psmith/restructure/src/statemachine/nio-sm.asd (original) +++ branches/home/psmith/restructure/src/statemachine/nio-sm.asd Sun Jan 21 23:12:43 2007 @@ -8,4 +8,4 @@ (:file "state-machine" :depends-on ("nio-sm-package")) ) - :depends-on (:nio)) \ No newline at end of file + :depends-on (:nio :nio-utils)) \ No newline at end of file Copied: branches/home/psmith/restructure/src/utils/nio-utils-package.lisp (from r48, 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/utils/nio-utils-package.lisp Sun Jan 21 23:12:43 2007 @@ -1,5 +1,5 @@ #| -Copyright (c) 2006 Risto Laakso +Copyright (c) 2007 All rights reserved. Redistribution and use in source and binary forms, with or without @@ -24,16 +24,10 @@ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |# -(defpackage :nio-compat (:use :cl) +(defpackage :nio-utils (:use :cl) (:export - ;; errno.lisp - get-errno +ERRNO_EAGAIN+ - - ;;concurrent-queue - concurrent-queue add take - ;;utils format-log )) Copied: branches/home/psmith/restructure/src/utils/nio-utils.asd (from r44, branches/home/psmith/restructure/src/compat/nio-compat.asd) ============================================================================== --- branches/home/psmith/restructure/src/compat/nio-compat.asd (original) +++ branches/home/psmith/restructure/src/utils/nio-utils.asd Sun Jan 21 23:12:43 2007 @@ -2,12 +2,10 @@ (in-package :asdf) -(defsystem :nio-compat +(defsystem :nio-utils - :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")) + :components ((:file "nio-utils-package") + (:file "utils" :depends-on ("nio-utils-package")) ) :depends-on ()) Copied: branches/home/psmith/restructure/src/utils/utils.lisp (from r48, branches/home/psmith/restructure/src/compat/utils.lisp) ============================================================================== --- branches/home/psmith/restructure/src/compat/utils.lisp (original) +++ branches/home/psmith/restructure/src/utils/utils.lisp Sun Jan 21 23:12:43 2007 @@ -25,7 +25,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |# -(in-package :nio-compat) +(in-package :nio-utils) (declaim (optimize (debug 3) (speed 3) (space 0)))

1 0

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

22 Jan '07

Author: psmith Date: Sun Jan 21 22:43:03 2007 New Revision: 48 Added: branches/home/psmith/restructure/src/utils/ Modified: branches/home/psmith/restructure/run-yarpc-client.lisp branches/home/psmith/restructure/src/compat/nio-compat-package.lisp branches/home/psmith/restructure/src/compat/utils.lisp 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-state-machine.lisp branches/home/psmith/restructure/src/statemachine/state-machine.lisp Log: Tidied up logging 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 21 22:43:03 2007 @@ -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))) - (format t "~A toplevel adding conn ~A~%" (nio-compat:get-readable-time) sm) + (format-log t "toplevel adding conn ~A~%" 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)")))) + (format-log t "Toplevel Submitting job~%" ) + (format-log t "Result of remote-execute ~A~%" (nio-yarpc:remote-execute sm "(nio-yarpc:test-rpc-list)")))) 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 Sun Jan 21 22:43:03 2007 @@ -35,5 +35,5 @@ concurrent-queue add take ;;utils - get-readable-time + format-log )) Modified: branches/home/psmith/restructure/src/compat/utils.lisp ============================================================================== --- branches/home/psmith/restructure/src/compat/utils.lisp (original) +++ branches/home/psmith/restructure/src/compat/utils.lisp Sun Jan 21 22:43:03 2007 @@ -52,9 +52,13 @@ (let ((current-internal (get-internal-real-time))) (+ universal-base (/ (- current-internal internal-base) internal-time-units-per-second) ))) - (defun get-readable-high-res() + (defun get-readable-high-res-time() (let ((estimated-universal-float (get-universal-high-res))) (multiple-value-bind (estimated-universal estimated-universal-rem) (floor estimated-universal-float) (format nil "~A.~3,'0d"(get-readable-time estimated-universal) (* 1000 estimated-universal-rem))))) - ) \ No newline at end of file + ) + +;Format the message to destination but prepend a high res time to the message, useful for logging +(defmacro format-log (destination control-string &rest format-arguments) + `(format ,destination (concatenate 'string "~A - " ,control-string) (get-readable-high-res-time) ,@format-arguments)) 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 Sun Jan 21 22:43:03 2007 @@ -149,7 +149,7 @@ (defun write-more (async-fd) "Write data from ASYNC-FD's write bytebuffer" -#+nio-debug (format t "async-fd:write-more - called with ~A~%" async-fd) + (format-log t "async-fd:write-more - called with ~A~%" async-fd) (with-slots (write-fd foreign-write-buffer close-pending) async-fd #+nio-debug (format t "async-fd:write-more - foreign-write-buffer b4 flip ~A~%" foreign-write-buffer) (nio-buffer:flip foreign-write-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 Sun Jan 21 22:43:03 2007 @@ -122,7 +122,7 @@ ;; socket i/o available (t (let ((async-fd (gethash fd client-hash))) -#+nio-debug (format t "IO event ~A on ~A~%" event async-fd) + (format-log t "IO event ~A on ~A~%" event async-fd) (unless (null async-fd) (catch 'error-exit (handler-bind ((read-error #'(lambda (x) 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 21 22:43:03 2007 @@ -59,14 +59,14 @@ (defun run-job(&key (wait-on-job-pdw t)) - (format t "~A Server toplevel waiting for job~%" (nio-compat:get-readable-time)) + (format-log t "Server toplevel waiting for job~%") (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) + (format-log t "Server received job ~A~%" 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 ~%") + (format-log t "yarpc-state-machine: process-outgoing-packet called, polling the results-queue ~%" ) (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 @@ -75,7 +75,7 @@ ;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 sm) STATE-INITIALISED)) - (format t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm call) + (format-log 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))) (when +process-jobs-inline+ (run-job :wait-on-job-pdw nil))) 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 21 22:43:03 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 "~A state-machine::process-read - incoming packet: ~A~%" (nio-compat:get-readable-time) incoming-packet) + (format-log t "state-machine::process-read - incoming packet: ~A~%" 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 "~A state-machine::process-write - outgoing packet: ~A~%" (nio-compat:get-readable-time) outgoing-packet) + (format-log t "state-machine::process-write - outgoing packet: ~A~%" outgoing-packet) (when outgoing-packet (write-bytes outgoing-packet foreign-write-buffer)))))

1 0

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

20 Jan '07

Author: psmith Date: Sat Jan 20 16:18:31 2007 New Revision: 47 Modified: branches/home/psmith/restructure/src/compat/utils.lisp Log: Added high res timer Modified: branches/home/psmith/restructure/src/compat/utils.lisp ============================================================================== --- branches/home/psmith/restructure/src/compat/utils.lisp (original) +++ branches/home/psmith/restructure/src/compat/utils.lisp Sat Jan 20 16:18:31 2007 @@ -36,3 +36,25 @@ (defun get-readable-time ( &optional (time (get-universal-time))) (get-readable "~A/~2,'0d/~2,'0d ~2,'0d:~2,'0d:~2,'0d" time)) + + +;;High res timer + +(let ((internal-base (get-internal-real-time)) + (universal-base (get-universal-time))) +; +; Gets the time including milliseconds by using a base time from universal time and +; tracking high res passing of time using the get-internal-real-time +; Probably not that accurate in absolute terms i.e. may drift from the base, +; but good enough for performance timings +; + (defun get-universal-high-res() + (let ((current-internal (get-internal-real-time))) + (+ universal-base (/ (- current-internal internal-base) internal-time-units-per-second) ))) + + (defun get-readable-high-res() + (let ((estimated-universal-float (get-universal-high-res))) + (multiple-value-bind (estimated-universal estimated-universal-rem) (floor estimated-universal-float) + (format nil "~A.~3,'0d"(get-readable-time estimated-universal) (* 1000 estimated-universal-rem))))) + + ) \ No newline at end of file

1 0

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

19 Jan '07

Author: psmith Date: Fri Jan 19 01:10:52 2007 New Revision: 46 Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp Log: Corrected typo 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 Fri Jan 19 01:10:52 2007 @@ -1,4 +1,4 @@ -\#| +#| Copyright (c) 2007 All rights reserved.

1 0