[elephant-cvs] CVS elephant/src/memutil

[ieslick]

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

Modified Files:
	memutil.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/memutil/memutil.lisp	2007/02/01 04:37:25	1.17
+++ /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp	2007/02/01 15:19:50	1.18
@@ -48,19 +48,18 @@
            #:buffer-write-int #:buffer-write-uint
 
 	   #:buffer-read-byte #:buffer-read-fixnum 
-	   #:buffer-read-fixnum32 
-	   #:buffer-read-fixnum64
+	   #:buffer-read-fixnum32 #:buffer-read-fixnum64
 	   #:buffer-read-int #:buffer-read-uint
 	   #:buffer-read-int32 #:buffer-read-uint32
 	   #:buffer-read-int64 #:buffer-read-uint64
 	   #:buffer-read-float #:buffer-read-double 
 
+	   #:buffer-write-oid #:buffer-read-oid
+
 	   #:buffer-read-ucs1-string
 	   #+(or lispworks (and allegro ics)) #:buffer-read-ucs2-string 
 	   #+(and sbcl sb-unicode) #:buffer-read-ucs4-string 
-	   #:byte-length
-
-	   #:serialize-string #:deserialize-string
+	   #:byte-length #:little-endian-p
 	   
 	   #:pointer-int #:pointer-void #:array-or-pointer-char
 	   +NULL-CHAR+ +NULL-VOID+
@@ -98,11 +97,13 @@
    (inline read-int read-uint read-float read-double 
 	   write-int write-uint write-float write-double
 	   offset-char-pointer copy-str-to-buf %copy-str-to-buf copy-bufs
-	   ;;resize-buffer-stream 
-	   ;;buffer-stream-buffer buffer-stream-size buffer-stream-position
-	   ;;buffer-stream-length 
+	   ;; resize-buffer-stream 
+	   ;; buffer-stream-buffer buffer-stream-size buffer-stream-position
+	   ;; buffer-stream-length 
+	   buffer-write-oid buffer-read-oid
 	   reset-buffer-stream
-	   buffer-write-byte buffer-write-int32 buffer-write-uint32
+	   buffer-write-byte 
+	   buffer-write-int32 buffer-write-uint32
 	   buffer-write-int64 buffer-write-uint64
 	   buffer-write-float buffer-write-double buffer-write-string
 	   buffer-read-byte buffer-read-fixnum buffer-read-int32
@@ -174,7 +175,9 @@
 	,@(loop for name in names 
 		collect (list 'return-buffer-stream name))))))
 
+;;
 ;; Buffer management / pointer arithmetic
+;;
 
 ;; Notes: on Allegro: with-cast-pointer + deref-array is
 ;; faster than FFI + C pointer arithmetic.  however pointer
@@ -694,7 +697,7 @@
  	      (setf (aref v i) (buffer-read-byte bs))))
  	nil)))
  
-(defun buffer-write-byte-vector (bs bv)
+(defun buffer-write-byte-vector (bv bs)
    "Read the whole buffer into  byte vector."
    (declare (type buffer-stream bs))
    (let* ((position (buffer-stream-position bs))
@@ -704,9 +707,19 @@
  	  (dotimes (i writable bs) 
  	      (buffer-write-byte (aref bv i) bs))))
 
-(defun buffer-write-int (bs int)
-  ;; deprecated, better to use explicit int32 or int64 version
-  (buffer-write-int32 bs int))
+;;
+;; Compatibility
+;;
+
+(defun buffer-write-oid (i bs)
+  (buffer-write-int32 i bs))
+
+(defun buffer-read-oid (bs)
+  (buffer-read-fixnum32 bs))
+
+;;
+;; Legacy support
+;;
 
 (defun buffer-read-int (bs)
   ;; deprecated, better to use explicit int32 or int64 version
@@ -716,13 +729,17 @@
   ;; deprecated, better to use explicit int32 or int64 version
   (the fixnum (buffer-read-fixnum32 bs)))
 
+(defun buffer-write-int (int bs)
+  ;; deprecated, better to use explicit int32 or int64 version
+  (buffer-write-int32 int bs))
+
 (defun buffer-read-uint (bs)
   ;; deprecated, better to use explicit int32 or int64 version
   (buffer-read-uint32 bs))
 
-(defun buffer-write-uint (bs int)
+(defun buffer-write-uint (int bs)
   ;; deprecated, better to use explicit int32 or int64 version
-  (buffer-write-uint32 bs int))
+  (buffer-write-uint32 int bs))
   
 (defconstant +2^32+ 4294967296)
 (defconstant +2^64+ 18446744073709551616)
@@ -753,8 +770,13 @@
   (let ((position (buffer-stream-position bs)))
     (setf (buffer-stream-position bs) (+ position 8))
     (if (< #.most-positive-fixnum +2^32+)
-	(+ (read-int32 (buffer-stream-buffer bs) position)
-	   (* +2^32+ (read-int32 (buffer-stream-buffer bs) (+ position 4))))
+	;; 32-bit or less fixnums; need to process as bignums
+	(let ((first (read-int32 (buffer-stream-buffer bs) position))
+	      (second (read-int32 (buffer-stream-buffer bs) (+ position 4))))
+	  (if (little-endian-p)
+	      (+ first (ash second 32))
+	      (+ second (ash first 32))))
+	;; Native 64-bit fixnums (NOTE: issues with non 32/64 bit fixnums?)
 	(the fixnum (read-int64 (buffer-stream-buffer bs) position)))))
 
 (defun buffer-read-int64 (bs)
@@ -865,3 +887,24 @@
        (* sb-vm:vector-data-offset sb-vm:n-word-bits)
        (* byte-length sb-vm:n-byte-bits))
       res)))
+
+;;
+;; What kind of machine are we on?
+;;
+
+(defparameter +little-endian+ nil)
+
+(defun little-endian-p ()
+  #+(or :x86 :x86-64 :LITTLE-ENDIAN) t
+  #+(or :PPC :POWERPC :BIG-ENDIAN) nil
+  #-(or :x86 :x86-64 :LITTLE-ENDIAN :PPC :POWERPC :BIG-ENDIAN)
+  (progn
+    (unless +little-endian+
+      (with-buffer-streams (bs)
+	(buffer-write-int32 #x1 bs)
+	(if (= 0 (buffer-read-byte bs))
+	    (setf +little-endian+ 2)
+	    (setf +little-endian+ 1))))
+    (if (eq +little-endian+ 1) t nil)))
+	    
+