-(defun decode-uint32 (buffer index)
- "Decodes the next 32-bit varint integer in the buffer at the given index.
- Returns both the decoded value and the new index into the buffer.
- Watch out, this function turns off all type checking and array bounds checking."
- (declare (optimize (speed 3) (safety 0) (debug 0)))
- (declare (type (simple-array (unsigned-byte 8)) buffer)
- (type fixnum index))
- ;; Seven bits at a time, least significant bits first
- (let ((val 0))
- (declare (type (unsigned-byte 32) val))
- (loop for places fixnum upfrom 0 by 7
- for byte fixnum = (prog1 (aref buffer index) (iincf index))
- do (setq val (ilogior val (iash (ildb (byte 7 0) byte) places)))
- until (i< byte 128)
- finally (progn
- (assert (< val #.(ash 1 32)) ()
- "The value ~D is longer than 32 bits" val)
- (return (values val index))))))
-
-(defun decode-uint64 (buffer index)
- "Decodes the next 64-bit varint integer in the buffer at the given index.
- Returns both the decoded value and the new index into the buffer.
- Watch out, this function turns off all type checking and array bounds checking."
- (declare (optimize (speed 3) (safety 0) (debug 0)))
- (declare (type (simple-array (unsigned-byte 8)) buffer)
- (type fixnum index))
- ;; Seven bits at a time, least significant bits first
- (let ((val 0))
- (declare (type (unsigned-byte 64) val))
- (loop for places fixnum upfrom 0 by 7
- for byte fixnum = (prog1 (aref buffer index) (iincf index))
- do (setq val (logior val (ash (ildb (byte 7 0) byte) places)))
- until (i< byte 128)
- finally (return (values val index)))))
-
-(defun decode-int32 (buffer index)
- "Decodes the next 32-bit varint integer in the buffer at the given index.
- Returns both the decoded value and the new index into the buffer.
- Watch out, this function turns off all type checking and array bounds checking."
- (declare (optimize (speed 3) (safety 0) (debug 0)))
- (declare (type (simple-array (unsigned-byte 8)) buffer)
- (type fixnum index))
- (multiple-value-bind (val index)
- (decode-uint32 buffer index)
- (declare (type fixnum val))
- (when (i= (ildb (byte 1 31) val) 1)
- (idecf val #.(ash 1 32)))
- (values val index)))
-
-(defun decode-int64 (buffer index)
- "Decodes the next 64-bit varint integer in the buffer at the given index.
+(defmacro generate-integer-decoders (bits)
+ "Generate 32- or 64-bit versions of integer decoders."
+ (assert (and (plusp bits) (zerop (mod bits 8))))
+ (let* ((decode-uint (fintern "~A~A" 'decode-uint bits))
+ (decode-fixed (fintern "~A~A" 'decode-fixed bits))
+ (decode-sfixed (fintern "~A~A" 'decode-sfixed bits))
+ (bytes (/ bits 8))
+ ;; Given bits, can we use fixnums safely?
+ (fixnump (<= bits (integer-length most-negative-fixnum)))
+ (ash (if fixnump 'iash 'ash))
+ (decf (if fixnump 'idecf 'decf))
+ (logior (if fixnump 'ilogior 'logior))
+ (logbitp (if fixnump 'ilogbitp 'logbitp)))
+ `(progn
+ (defun ,decode-uint (buffer index)
+ ,(format nil
+ "Decodes the next ~A-bit varint integer in the buffer at the given index.~
+ ~& Returns both the decoded value and the new index into the buffer.~
+ ~& Watch out, this function turns off all type checking and array bounds checking." bits)
+ (declare #.$optimize-serialization)
+ (declare (type (simple-array (unsigned-byte 8)) buffer)
+ (type fixnum index))
+ ;; Seven bits at a time, least significant bits first
+ (let ((val 0))
+ (declare (type (unsigned-byte ,bits) val))
+ (loop for places fixnum upfrom 0 by 7
+ for byte fixnum = (prog1 (aref buffer index) (iincf index))
+ do (let ((bits (ildb (byte 7 0) byte)))
+ (declare (type (unsigned-byte 8) bits))
+ (setq val (,logior val (,ash bits places))))
+ while (ilogbitp 7 byte)
+ finally (progn
+ (unless (< val ,(ash 1 bits))
+ (serialization-error "The value ~D is longer than ~A bits" val ,bits))
+ (return (values val index))))))
+ (defun ,decode-fixed (buffer index)
+ ,(format nil
+ "Decodes the next ~A-bit unsigned fixed integer in the buffer at the given index.~
+ ~& Returns both the decoded value and the new index into the buffer.~
+ ~& Watch out, this function turns off all type checking and array bounds checking." bits)
+ (declare #.$optimize-serialization)
+ (declare (type (simple-array (unsigned-byte 8)) buffer)
+ (type fixnum index))
+ ;; Eight bits at a time, least significant bits first
+ (let ((val 0))
+ ,@(when fixnump `((declare (type fixnum val))))
+ (loop repeat ,bytes
+ for places fixnum upfrom 0 by 8
+ for byte fixnum = (prog1 (aref buffer index) (iincf index))
+ do (setq val (,logior val (,ash byte places))))
+ (values val index)))
+ (defun ,decode-sfixed (buffer index)
+ ,(format nil
+ "Decodes the next ~A-bit signed fixed integer in the buffer at the given index.~
+ ~& Returns both the decoded value and the new index into the buffer.~
+ ~& Watch out, this function turns off all type checking and array bounds checking." bits)
+ (declare #.$optimize-serialization)
+ (declare (type (simple-array (unsigned-byte 8)) buffer)
+ (type fixnum index))
+ ;; Eight bits at a time, least significant bits first
+ (let ((val 0))
+ ,@(when fixnump `((declare (type fixnum val))))
+ (loop repeat ,bytes
+ for places fixnum upfrom 0 by 8
+ for byte fixnum = (prog1 (aref buffer index) (iincf index))
+ do (setq val (,logior val (,ash byte places))))
+ (when (,logbitp ,(1- bits) val) ;sign bit set, so negative value
+ (,decf val ,(ash 1 bits)))
+ (values val index))))))
+
+(generate-integer-decoders 32)
+(generate-integer-decoders 64)
+
+(defun decode-int (buffer index)
+ "Decodes the next varint integer in the buffer at the given index.