Update of /project/elephant/cvsroot/elephant/src/memutil In directory clnet:/tmp/cvs-serv1882/src/memutil
Modified Files: libmemutil.c memutil.lisp Log Message: Added 64-bit support, verified for 32-bit lisp via Allegro/Mac OS X. Thanks to Henrik Hjelte
--- /project/elephant/cvsroot/elephant/src/memutil/libmemutil.c 2006/11/11 18:41:11 1.2 +++ /project/elephant/cvsroot/elephant/src/memutil/libmemutil.c 2007/02/01 04:03:27 1.3 @@ -57,48 +57,47 @@
#include <string.h> #include <wchar.h> +#include <stdint.h>
/* Pointer arithmetic utility functions */ -/* should these be in network-byte order? probably not..... */ -int read_int(char *buf, int offset) { - int i; - memcpy(&i, buf+offset, sizeof(int)); - return i; -} - -unsigned int read_uint(char *buf, int offset) { - unsigned int ui; - memcpy(&ui, buf+offset, sizeof(unsigned int)); - return ui; -}
-float read_float(char *buf, int offset) { - float f; - memcpy(&f, buf+offset, sizeof(float)); - return f; -} +/* NOTE: Byte order is on a per-machine basis, serialized streams using this + library will not be compatable between little-endian and big-endian platforms */
-double read_double(char *buf, int offset) { - double d; - memcpy(&d, buf+offset, sizeof(double)); - return d; -} +/*------------------------------------------------------------------------------ + reader_and_writer
-void write_int(char *buf, int num, int offset) { - memcpy(buf+offset, &num, sizeof(int)); -} + Generates the following code:
-void write_uint(char *buf, unsigned int num, int offset) { - memcpy(buf+offset, &num, sizeof(unsigned int)); -} - -void write_float(char *buf, float num, int offset) { - memcpy(buf+offset, &num, sizeof(float)); -} - -void write_double(char *buf, double num, int offset) { - memcpy(buf+offset, &num, sizeof(double)); -} + double read_double(char *buf, int offset) { + double d; + memcpy(&d, buf+offset, sizeof(double)); + return d; + } + void write_double(char *buf, double num, int offset) { + memcpy(buf+offset, &num, sizeof(double)); + } + When called like this: + reader_and_writer(double) +-------------------------------------------------------------------------------- +*/ + +#define reader_and_writer( DATATYPE ) \ +DATATYPE read_##DATATYPE (char *buf, int offset) { \ + DATATYPE i; \ + memcpy(&i, buf+offset, sizeof( DATATYPE )); \ + return i; \ +} \ +void write_##DATATYPE (char *buf, DATATYPE num, int offset) { \ + memcpy(buf+offset, &num, sizeof( DATATYPE )); \ +} + +reader_and_writer(int32_t) +reader_and_writer(uint32_t) +reader_and_writer(int64_t) +reader_and_writer(uint64_t) +reader_and_writer(float) +reader_and_writer(double)
char *offset_charp(char *p, int offset) { return p + offset; --- /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2007/01/31 20:05:38 1.15 +++ /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2007/02/01 04:03:28 1.16 @@ -40,11 +40,17 @@ #:resize-buffer-stream #:resize-buffer-stream-no-copy #:reset-buffer-stream #:buffer-stream-buffer #:buffer-stream-length #:buffer-stream-size - #:buffer-write-byte #:buffer-write-int - #:buffer-write-uint #:buffer-write-float #:buffer-write-double - #:buffer-write-string #:buffer-read-byte #:buffer-read-fixnum - #:buffer-read-int #:buffer-read-uint #:buffer-read-float - #:buffer-read-double + + #:buffer-write-byte #:buffer-write-float + #:buffer-write-double #:buffer-write-string + #:buffer-write-int32 #:buffer-write-uint32 + #:buffer-write-int64 #:buffer-write-uint64 + + #:buffer-read-byte #:buffer-read-fixnum32 #:buffer-read-fixnum64 + #:buffer-read-int32 #:buffer-read-uint32 + #:buffer-read-int64 #:buffer-read-uint64 + #:buffer-read-float #:buffer-read-double + #:buffer-read-ucs1-string #+(or lispworks (and allegro ics)) #:buffer-read-ucs2-string #+(and sbcl sb-unicode) #:buffer-read-ucs4-string @@ -92,11 +98,12 @@ ;;buffer-stream-buffer buffer-stream-size buffer-stream-position ;;buffer-stream-length reset-buffer-stream - buffer-write-byte buffer-write-int buffer-write-uint + 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-int - buffer-read-uint buffer-read-float buffer-read-double - buffer-read-ucs1-string + buffer-read-byte buffer-read-fixnum buffer-read-int32 + buffer-read-uint32 buffer-read-int64 buffer-read-uint64 + buffer-read-float buffer-read-double buffer-read-ucs1-string #+(or lispworks (and allegro ics)) buffer-read-ucs2-string #+(and sbcl sb-unicode) buffer-read-ucs4-string)) ) @@ -174,7 +181,7 @@ ;; TODO: #+openmcl versions which do macptr arith.
#+(or cmu sbcl) -(defun read-int (buf offset) +(defun read-int32 (buf offset) "Read a 32-bit signed integer from a foreign char buffer." (declare (type (alien (* char)) buf) (type fixnum offset)) @@ -183,7 +190,16 @@ (* (signed 32))))))
#+(or cmu sbcl) -(defun read-uint (buf offset) +(defun read-int64 (buf offset) + "Read a 64-bit signed integer from a foreign char buffer." + (declare (type (alien (* char)) buf) + (type fixnum offset)) + (the (signed-byte 64) + (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (* (signed 64)))))) + +#+(or cmu sbcl) +(defun read-uint32 (buf offset) "Read a 32-bit unsigned integer from a foreign char buffer." (declare (type (alien (* char)) buf) (type fixnum offset)) @@ -191,6 +207,16 @@ (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) (* (unsigned 32))))))
+ +#+(or cmu sbcl) +(defun read-uint64 (buf offset) + "Read a 64-bit unsigned integer from a foreign char buffer." + (declare (type (alien (* char)) buf) + (type fixnum offset)) + (the (signed-byte 64) + (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (* (signed 64)))))) + #+(or cmu sbcl) (defun read-float (buf offset) "Read a single-float from a foreign char buffer." @@ -210,7 +236,7 @@ (* double-float)))))
#+(or cmu sbcl) -(defun write-int (buf num offset) +(defun write-int32 (buf num offset) "Write a 32-bit signed integer to a foreign char buffer." (declare (type (alien (* char)) buf) (type (signed-byte 32) num) @@ -219,7 +245,16 @@ (* (signed 32)))) num))
#+(or cmu sbcl) -(defun write-uint (buf num offset) +(defun write-int64 (buf num offset) + "Write a 64-bit signed integer to a foreign char buffer." + (declare (type (alien (* char)) buf) + (type (signed-byte 64) num) + (type fixnum offset)) + (setf (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (* (signed 64)))) num)) + +#+(or cmu sbcl) +(defun write-uint32 (buf num offset) "Write a 32-bit unsigned integer to a foreign char buffer." (declare (type (alien (* char)) buf) (type (unsigned-byte 32) num) @@ -228,6 +263,14 @@ (* (unsigned 32)))) num))
#+(or cmu sbcl) +(defun write-uint64 (buf num offset) + "Write a 64-bit unsigned integer to a foreign char buffer." + (declare (type (alien (* char)) buf) + (type (unsigned-byte 64) num) + (type fixnum offset)) + (setf (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (* (unsigned 64)))) num)) +#+(or cmu sbcl) (defun write-float (buf num offset) "Write a single-float to a foreign char buffer." (declare (type (alien (* char)) buf) @@ -253,18 +296,30 @@ (sap-alien (sap+ (alien-sap p) offset) (* char)))
#-(or cmu sbcl) -(def-function ("read_int" read-int) +(def-function ("read_int32" read-int32) ((buf array-or-pointer-char) (offset :int)) :returning :int)
#-(or cmu sbcl) -(def-function ("read_uint" read-uint) +(def-function ("read_uint32" read-uint32) ((buf array-or-pointer-char) (offset :int)) :returning :unsigned-int)
#-(or cmu sbcl) +(def-function ("read_int64" read-int64) + ((buf array-or-pointer-char) + (offset :int)) + :returning :long) + +#-(or cmu sbcl) +(def-function ("read_uint64" read-uint64) + ((buf array-or-pointer-char) + (offset :int)) + :returning :unsigned-long) + +#-(or cmu sbcl) (def-function ("read_float" read-float) ((buf array-or-pointer-char) (offset :int)) @@ -277,20 +332,34 @@ :returning :double)
#-(or cmu sbcl) -(def-function ("write_int" write-int) +(def-function ("write_int32" write-int32) ((buf array-or-pointer-char) (num :int) (offset :int)) :returning :void)
#-(or cmu sbcl) -(def-function ("write_uint" write-uint) +(def-function ("write_uint32" write-uint32) ((buf array-or-pointer-char) (num :unsigned-int) (offset :int)) :returning :void)
#-(or cmu sbcl) +(def-function ("write_int64" write-int64) + ((buf array-or-pointer-char) + (num :long) + (offset :int)) + :returning :void) + +#-(or cmu sbcl) +(def-function ("write_uint64" write-uint64) + ((buf array-or-pointer-char) + (num :unsigned-long) + (offset :int)) + :returning :void) + +#-(or cmu sbcl) (def-function ("write_float" write-float) ((buf array-or-pointer-char) (num :float) @@ -482,7 +551,7 @@ (setf (deref-array buf '(:array :char) size) b) (setf size needed))))
-(defun buffer-write-int (i bs) +(defun buffer-write-int32 (i bs) "Write a 32-bit signed integer." (declare (type buffer-stream bs) (type (signed-byte 32) i)) @@ -493,11 +562,11 @@ (let ((needed (+ size 4))) (when (> needed len) (resize-buffer-stream bs needed)) - (write-int buf i size) + (write-int32 buf i size) (setf size needed) nil)))
-(defun buffer-write-uint (u bs) +(defun buffer-write-uint32 (u bs) "Write a 32-bit unsigned integer." (declare (type buffer-stream bs) (type (unsigned-byte 32) u)) @@ -508,7 +577,37 @@ (let ((needed (+ size 4))) (when (> needed len) (resize-buffer-stream bs needed)) - (write-uint buf u size) + (write-uint32 buf u size) + (setf size needed) + nil))) + +(defun buffer-write-int64 (i bs) + "Write a 64-bit signed integer." + (declare (type buffer-stream bs) + (type (signed-byte 64) i)) + (with-struct-slots ((buf buffer-stream-buffer) + (size buffer-stream-size) + (len buffer-stream-length)) + bs + (let ((needed (+ size 8))) + (when (> needed len) + (resize-buffer-stream bs needed)) + (write-int64 buf i size) + (setf size needed) + nil))) + +(defun buffer-write-uint64 (u bs) + "Write a 64-bit unsigned integer." + (declare (type buffer-stream bs) + (type (unsigned-byte 64) u)) + (with-struct-slots ((buf buffer-stream-buffer) + (size buffer-stream-size) + (len buffer-stream-length)) + bs + (let ((needed (+ size 8))) + (when (> needed len) + (resize-buffer-stream bs needed)) + (write-uint64 buf u size) (setf size needed) nil)))
@@ -600,28 +699,73 @@ (writable (max vlen (- size position)))) (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)) + +(defun buffer-read-int (bs) + ;; deprecated, better to use explicit int32 or int64 version + (buffer-read-int32 bs))
(defun buffer-read-fixnum (bs) + ;; deprecated, better to use explicit int32 or int64 version + (the fixnum (buffer-read-fixnum32 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) + ;; deprecated, better to use explicit int32 or int64 version + (buffer-write-uint32 bs int)) + +(defconstant +2^32+ 4294967296) +(defconstant +2^64+ 18446744073709551616) + +(defun buffer-read-fixnum32 (bs) "Read a 32-bit signed integer, which is assumed to be a fixnum." (declare (type buffer-stream bs)) (let ((position (buffer-stream-position bs))) (setf (buffer-stream-position bs) (+ position 4)) (the fixnum (read-int (buffer-stream-buffer bs) position))))
-(defun buffer-read-int (bs) +(defun buffer-read-int32 (bs) "Read a 32-bit signed integer." (declare (type buffer-stream bs)) (let ((position (buffer-stream-position bs))) (setf (buffer-stream-position bs) (+ position 4)) - (the (signed-byte 32) (read-int (buffer-stream-buffer bs) position)))) + (the (signed-byte 32) (read-int32 (buffer-stream-buffer bs) position))))
-(defun buffer-read-uint (bs) +(defun buffer-read-uint32 (bs) "Read a 32-bit unsigned integer." (declare (type buffer-stream bs)) (let ((position (buffer-stream-position bs))) (setf (buffer-stream-position bs) (+ position 4)) - (the (unsigned-byte 32)(read-uint (buffer-stream-buffer bs) position)))) + (the (unsigned-byte 32)(read-uint32 (buffer-stream-buffer bs) position)))) + +(defun buffer-read-fixnum64 (bs) + (declare (type buffer-stream bs)) + (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)))) + (the fixnum (read-int64 (buffer-stream-buffer bs) position))))) + +(defun buffer-read-int64 (bs) + "Read a 64-bit signed integer." + (declare (type buffer-stream bs)) + (let ((position (buffer-stream-position bs))) + (setf (buffer-stream-position bs) (+ position 8)) + (the (signed-byte 64) (read-int64 (buffer-stream-buffer bs) position)))) + +(defun buffer-read-uint64 (bs) + "Read a 64-bit unsigned integer." + (declare (type buffer-stream bs)) + (let ((position (buffer-stream-position bs))) + (setf (buffer-stream-position bs) (+ position 8)) + (the (unsigned-byte 64) (read-uint64 (buffer-stream-buffer bs) position))))
(defun buffer-read-float (bs) "Read a single-float."
-
ieslick