[elephant-cvs] CVS update: elephant/src/serializer.lisp

[blee at common-lisp.net]

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp.net:/tmp/cvs-serv25896/src

Modified Files:
	serializer.lisp 
Log Message:
doc-strings
buffer-streamified
sanified type tags

Date: Thu Sep 16 06:20:42 2004
Author: blee

Index: elephant/src/serializer.lisp
diff -u elephant/src/serializer.lisp:1.8 elephant/src/serializer.lisp:1.9
--- elephant/src/serializer.lisp:1.8	Sat Sep  4 10:59:40 2004
+++ elephant/src/serializer.lisp	Thu Sep 16 06:20:41 2004
@@ -51,30 +51,46 @@
 
 ;; Constants
 
-(defconstant +fixnum+                (char-code #\f))
-(defconstant +nil+                   (char-code #\N))
-(defconstant +symbol+                (char-code #\S))
-(defconstant +string+                (char-code #\s))
-(defconstant +persistent+            (char-code #\P))
-(defconstant +single-float+          (char-code #\F))
-(defconstant +double-float+          (char-code #\D))
-(defconstant +char+                  (char-code #\c))
-(defconstant +pathname+              (char-code #\p))
-(defconstant +positive-bignum+       (char-code #\B))
-(defconstant +negative-bignum+       (char-code #\b))
-(defconstant +rational+              (char-code #\r))
-(defconstant +cons+                  (char-code #\C))
-(defconstant +hash-table+            (char-code #\H))
-(defconstant +object+                (char-code #\O))
+(defconstant +fixnum+                1)
+(defconstant +char+                  2)
+(defconstant +single-float+          3)
+(defconstant +double-float+          4)
+(defconstant +negative-bignum+       5)
+(defconstant +positive-bignum+       6)
+(defconstant +rational+              7)
+
+(defconstant +nil+                   8)
+
+;; 8-bit
+#-(or lispworks (and allegro ics))
+(defconstant +symbol+                9)
+#-(or lispworks (and allegro ics))
+(defconstant +string+               10)
+#-(or lispworks (and allegro ics))
+(defconstant +pathname+             11)
+
+;; 16-bit
+#+(or lispworks (and allegro ics))
+(defconstant +symbol+               12)
+#+(or lispworks (and allegro ics))
+(defconstant +string+               13)
+#+(or lispworks (and allegro ics))
+(defconstant +pathname+             14)
+
+(defconstant +persistent+           15)
+(defconstant +cons+                 16)
+(defconstant +hash-table+           17)
+(defconstant +object+               18)
+(defconstant +array+                19)
 
-(defconstant +array+                 (char-code #\A))
-
-(defconstant +fill-pointer-p+ #x40)
-(defconstant +adjustable-p+ #x80)
+(defconstant +fill-pointer-p+     #x40)
+(defconstant +adjustable-p+       #x80)
 
 
 (defun serialize (frob bs)
-  (declare (optimize (speed 3) (safety 0)))
+  "Serialize a lisp value into a buffer-stream."
+  (declare (optimize (speed 3) (safety 0))
+	   (type buffer-stream bs))
   (setq *lisp-obj-id* 0)
   (clrhash *circularity-hash*)
   (labels 
@@ -207,7 +223,7 @@
 			  (%serialize (row-major-aref frob i)))))))
 	   )))
     (%serialize frob)
-    (finish-buffer bs)))
+    bs))
 
 (defun slots-and-values (o)
   (declare (optimize (speed 3) (safety 0)))
@@ -222,14 +238,10 @@
 	  (push slot-name ret))
 	finally (return ret)))
 
-(defun deserialize (buf)
+(defun deserialize (buf-str)
+  "Deserialize a lisp value from a buffer-stream."
   (declare (optimize (speed 3) (safety 0))
-	   (type (or null array-or-pointer-char) buf))
-  (unless buf (return-from deserialize nil))
-  (setf (buffer-stream-buffer *in-buf*) buf)
-  (setf (buffer-stream-position *in-buf*) 0)
-  (setq *lisp-obj-id* 0)
-  (clrhash *circularity-hash*)
+	   (type (or null buffer-stream) buf-str))
   (labels 
       ((%deserialize (bs)
 	 (declare (optimize (speed 3) (safety 0))
@@ -325,7 +337,12 @@
 			    (setf (row-major-aref a i) (%deserialize bs)))
 		      a))))		    
 	     (t (error "deserialize fubar!"))))))
-    (%deserialize *in-buf*)))
+  (etypecase buf-str 
+    (null (return-from deserialize nil))
+    (buffer-stream
+     (setq *lisp-obj-id* 0)
+     (clrhash *circularity-hash*)
+     (%deserialize buf-str)))))
 
 (defun deserialize-bignum (bs length positive)
   (declare (optimize (speed 3) (safety 0))
@@ -387,9 +404,9 @@
 (defun int-byte-spec (position)
   (declare (optimize (speed 3) (safety 0))
 	   (type (unsigned-byte 24) position))
-  #+(or cmu scl sbcl allegro)
+  #+(or cmu sbcl allegro)
   (progn (setf (cdr *resourced-byte-spec*) (* 32 position)) 
 	 *resourced-byte-spec*)
-  #-(or cmu scl sbcl allegro)
+  #-(or cmu sbcl allegro)
   (byte 32 (* 32 position))
   )