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