Update of /project/elephant/cvsroot/elephant/src/memutil In directory clnet:/tmp/cvs-serv25441/src/memutil
Modified Files: memutil.lisp Log Message: Fix SBCL type issues by converting buffer stream from char to unsigned-char
--- /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2007/02/03 04:09:14 1.20 +++ /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2007/02/03 14:07:01 1.21 @@ -140,7 +140,7 @@
(defstruct buffer-stream "A stream-like interface to foreign (alien) char buffers." - (buffer (allocate-foreign-object :char 10) :type array-or-pointer-char) + (buffer (allocate-foreign-object :unsigned-char 10) :type array-or-pointer-char) (size 0 :type fixnum) (position 0 :type fixnum) (length 10 :type fixnum)) @@ -183,117 +183,117 @@ #+(or cmu sbcl) (defun read-int32 (buf offset) "Read a 32-bit signed integer from a foreign char buffer." - (declare (type (alien (* char)) buf) + (declare (type (alien (* unsigned-char)) buf) (type fixnum offset)) (the (signed-byte 32) - (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* unsigned-char)) (* (signed 32))))))
#+(or cmu sbcl) (defun read-int64 (buf offset) "Read a 64-bit signed integer from a foreign char buffer." - (declare (type (alien (* char)) buf) + (declare (type (alien (* unsigned-char)) buf) (type fixnum offset)) (the (signed-byte 64) - (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* unsigned-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) + (declare (type (alien (* unsigned-char)) buf) (type fixnum offset)) (the (unsigned-byte 32) - (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* unsigned-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) + (declare (type (alien (* unsigned-char)) buf) (type fixnum offset)) (the (signed-byte 64) - (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* unsigned-char)) (* (signed 64))))))
#+(or cmu sbcl) (defun read-float (buf offset) "Read a single-float from a foreign char buffer." - (declare (type (alien (* char)) buf) + (declare (type (alien (* unsigned-char)) buf) (type fixnum offset)) (the single-float - (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* unsigned-char)) (* single-float)))))
#+(or cmu sbcl) (defun read-double (buf offset) "Read a double-float from a foreign char buffer." - (declare (type (alien (* char)) buf) + (declare (type (alien (* unsigned-char)) buf) (type fixnum offset)) (the double-float - (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* unsigned-char)) (* double-float)))))
#+(or cmu sbcl) (defun write-int32 (buf num offset) "Write a 32-bit signed integer to a foreign char buffer." - (declare (type (alien (* char)) buf) + (declare (type (alien (* unsigned-char)) buf) (type (signed-byte 32) num) (type fixnum offset)) - (setf (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (setf (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* unsigned-char)) (* (signed 32)))) num))
#+(or cmu sbcl) (defun write-int64 (buf num offset) "Write a 64-bit signed integer to a foreign char buffer." - (declare (type (alien (* char)) buf) + (declare (type (alien (* unsigned-char)) buf) (type (signed-byte 64) num) (type fixnum offset)) - (setf (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (setf (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* unsigned-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) + (declare (type (alien (* unsigned-char)) buf) (type (unsigned-byte 32) num) (type fixnum offset)) - (setf (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (setf (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* unsigned-char)) (* (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) + (declare (type (alien (* unsigned-char)) buf) (type (unsigned-byte 64) num) (type fixnum offset)) - (setf (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (setf (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* unsigned-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) + (declare (type (alien (* unsigned-char)) buf) (type single-float num) (type fixnum offset)) - (setf (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (setf (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* unsigned-char)) (* single-float))) num))
#+(or cmu sbcl) (defun write-double (buf num offset) "Write a double-float to a foreign char buffer." - (declare (type (alien (* char)) buf) + (declare (type (alien (* unsigned-char)) buf) (type double-float num) (type fixnum offset)) - (setf (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (setf (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* unsigned-char)) (* double-float))) num))
#+(or cmu sbcl) (defun offset-char-pointer (p offset) "Pointer arithmetic." - (declare (type (alien (* char)) p) + (declare (type (alien (* unsigned-char)) p) (type fixnum offset)) - (sap-alien (sap+ (alien-sap p) offset) (* char))) + (sap-alien (sap+ (alien-sap p) offset) (* unsigned-char)))
#-(or cmu sbcl) (def-function ("read_int32" read-int32) @@ -502,7 +502,7 @@ (when (> length len) (let ((newlen (max length (* len 2)))) (declare (type fixnum newlen)) - (let ((newbuf (allocate-foreign-object :char newlen))) + (let ((newbuf (allocate-foreign-object :unsigned-char newlen))) ;; technically we just need to copy from position to size..... (when (null-pointer-p newbuf) (error "Failed to allocate buffer stream of length ~A. allocate-foreign-object returned a null pointer" newlen)) @@ -523,7 +523,7 @@ (when (> length len) (let ((newlen (max length (* len 2)))) (declare (type fixnum newlen)) - (let ((newbuf (allocate-foreign-object :char newlen))) + (let ((newbuf (allocate-foreign-object :unsigned-char newlen))) (when (null-pointer-p newbuf) (error "Failed to allocate buffer stream of length ~A. allocate-foreign-object returned a null pointer" newlen)) (free-foreign-object buf)