[elephant-cvs] CVS elephant/src/elephant

[ieslick]

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)