Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv18919/src/elephant

Modified Files: serializer2.lisp Log Message: Finish 64-bit update; clean up memutil; fix array flag type error in SBCL; more efficient and correct hash serialization in new serializer

--- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/01 04:03:27 1.8 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/01 15:19:50 1.9 @@ -80,8 +80,8 @@ (defconstant +nil+ #x3F)

;; Arrays -(defconstant +fill-pointer-p+ #x40) -(defconstant +adjustable-p+ #x80) +(defconstant +fill-pointer-p+ #x20) +(defconstant +adjustable-p+ #x40)

;; ;; NOTE: Used bad coding practice here: without-interrupts is a single-CPU @@ -158,16 +158,20 @@ (incf *lisp-obj-id*)) (%serialize (frob) (etypecase frob - (fixnum ;; (integer #.most-negative-fixnum #.most-positive-fixnum) - ;; Should be compiled away... - (if (< #.most-positive-fixnum +2^32+) + (fixnum + (if (< #.most-positive-fixnum +2^32+) ;; should be compiled away (progn (buffer-write-byte +fixnum32+ bs) (buffer-write-int32 frob bs)) (progn (assert (< #.most-positive-fixnum +2^64+)) - (buffer-write-byte +fixnum64+ bs) - (buffer-write-int64 frob bs)))) + (if (< frob +2^32+) + (progn + (buffer-write-byte +fixnum32+ bs) + (buffer-write-int32 frob bs)) + (progn + (buffer-write-byte +fixnum64+ bs) + (buffer-write-int64 frob bs)))))) (null (buffer-write-byte +nil+ bs)) (symbol @@ -397,14 +401,18 @@ (declare (dynamic-extent id maybe-cons) (type fixnum id)) (if maybe-hash maybe-hash - (let ((h (make-hash-table :test (%deserialize bs) - :rehash-size (%deserialize bs) - :rehash-threshold - (%deserialize bs)))) + (let* ((test (%deserialize bs)) + (rehash-size (%deserialize bs)) + (rehash-threshold (%deserialize bs)) + (size (%deserialize bs)) + (h (make-hash-table :test test + :rehash-size rehash-size + :rehash-threshold rehash-threshold + :size (ceiling (* (ceiling (/ (+ size 10) rehash-threshold)) rehash-size))))) (add-object h) - (loop for i fixnum from 0 below (%deserialize bs) + (loop for i fixnum from 0 below size do - (setf (gethash (%deserialize bs) h) + (setf (gethash (%deserialize bs) h) (%deserialize bs))) h)))) ((= tag +object+) @@ -448,7 +456,7 @@ (buffer-read-int32 bs) collect (%deserialize bs)) :element-type (array-type-from-byte - (logand #x3f flags)) + (logand #x1f flags)) :fill-pointer (/= 0 (logand +fill-pointer-p+ flags)) :adjustable (/= 0 (logand +adjustable-p+ @@ -469,8 +477,7 @@ result))))))

(defun deserialize-bignum (bs length positive) - (declare (optimize (speed 3) (safety 2)) - (type buffer-stream bs) + (declare (type buffer-stream bs) (type fixnum length) (type boolean positive)) (loop for i from 0 below (/ length 4)