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)) + +