+
+(defmacro def-unsigned-int-io (len r-name w-name &key (big-endian nil))
+ "Defines read and write functions for an unsigned integer with LEN bytes from STREAM."
+ (when (< len 1)
+ (error "Number of bytes must be greater than 0.~%"))
+ (let ((endian-string (if big-endian "big" "little")))
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun ,r-name (stream)
+ ,(format nil "Reads an ~A byte unsigned integer (~A-endian)."
+ len endian-string)
+ (declare (optimize (speed 3) (compilation-speed 0) (safety 0)
+ (space 0) (debug 0))
+ (type stream stream))
+ (let ((val 0))
+ (declare (type
+ ,(if (< (expt 256 len) most-positive-fixnum)
+ 'fixnum
+ `(integer 0 ,(1- (expt 256 len))))
+ val))
+ ,@(loop for i from 1 upto len
+ collect
+ `(setf (ldb (byte 8 ,(* (if big-endian (1- i) (- len i))
+ 8)) val) (read-byte stream)))
+ val))
+ (defun ,w-name (val stream &key (bounds-check t))
+ ,(format nil "Writes an ~A byte unsigned integer as binary to STREAM (~A-endian)."
+ len endian-string)
+ (declare (optimize (speed 3) (compilation-speed 0) (safety 0)
+ (space 0) (debug 0))
+ (type stream stream)
+ ,(if (< (expt 256 len) most-positive-fixnum)
+ '(type fixnum val)
+ '(type integer val)))
+ (when bounds-check
+ (when (>= val ,(expt 256 len))
+ (error "Number ~D is too large to fit in ~D bytes.~%" val ,len))
+ (when (minusp val)
+ (error "Number ~D can't be written as unsigned integer." val)))
+ (locally (declare (type (integer 0 ,(1- (expt 256 len))) val))
+ ,@(loop for i from 1 upto len
+ collect
+ `(write-byte (ldb (byte 8 ,(* (if big-endian (1- i) (- len i))
+ 8)) val) stream)))
+ val)
+ nil)))
+
+(defmacro make-unsigned-int-io-fn (len)
+ "Makes reader and writer functions for unsigned byte input/output of
+LEN bytes with both little and big endian order. Function names are in the
+form of {READ,WRITE}-UINT<LEN>-{be,le}."
+ `(progn
+ (def-unsigned-int-io
+ ,len
+ ,(intern (format nil "~A~D-~A" (symbol-name '#:read-uint) len (symbol-name '#:le)))
+ ,(intern (format nil "~A~D-~A" (symbol-name '#:write-uint) len (symbol-name '#:le)))
+ :big-endian nil)
+ (def-unsigned-int-io
+ ,len
+ ,(intern (format nil "~A~D-~A" (symbol-name '#:read-uint) len (symbol-name '#:be)))
+ ,(intern (format nil "~A~D-~A" (symbol-name '#:write-uint) len (symbol-name '#:be)))
+ :big-endian t)))
+
+(make-unsigned-int-io-fn 2)
+(make-unsigned-int-io-fn 3)
+(make-unsigned-int-io-fn 4)
+(make-unsigned-int-io-fn 5)
+(make-unsigned-int-io-fn 6)
+(make-unsigned-int-io-fn 7)
+(make-unsigned-int-io-fn 8)
projects / kmrcl.git / commitdiff