[nio-cvs] r53 - in branches/home/psmith/restructure/src: buffer io protocol/yarpc statemachine
psmith at common-lisp.net
psmith at common-lisp.net
Sun Jan 28 01:43:48 UTC 2007
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))
+
+
More information about the Nio-cvs
mailing list