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