[elephant-cvs] CVS elephant/src/memutil
ieslick
ieslick at common-lisp.net
Thu Feb 1 04:03:29 UTC 2007
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."
More information about the Elephant-cvs
mailing list