Changeset 37 for branches/home/psmith

Timestamp:

01/15/07 06:49:25 (18 years ago)

Author:

psmith

Message:

yarpc roundtrip complete

Location:

branches/home/psmith/restructure/src/protocol/yarpc

Files:

• yarpc-packet-factory.lisp (modified) (2 diffs)
• yarpc-state-machine.lisp (modified) (2 diffs)

branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp ¶

@@ -37 +37 @@
 
 (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)
@@ -57 +63 @@
 ;  (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)  )

branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp ¶

@@ -99 +99 @@
     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)
@@ -126 +132 @@
 
 (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)))