- (let ((val (let ((e (find val (proto-values enum) :key #'proto-value)))
- (and e (proto-index e))))
- (tag (ilogior $wire-type-varint (iash (proto-index field) 3))))
- (i+ (length32 tag) (length32 val))))
-
-
-;;; Raw encoders
-
-(defun encode-uint32 (val buffer index)
- "Encodes the 32-bit integer 'val' into the buffer at the given index.
- Modifies the buffer, and returns the new index into the buffer."
- (declare (type fixnum index)
- (type (simple-array (unsigned-byte 8)) buffer))
- (assert (< val #.(ash 1 32)) ()
- "The value ~D is longer than 32 bits" val)
- (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
- ;; Seven bits at a time, least significant bits first
- (loop do (let ((bits (ldb #.(byte 7 0) val)))
- (declare (type fixnum bits))
- (setq val (ash val -7))
- (setf (aref buffer index) (ilogior bits (if (zerop val) 0 128)))
- (iincf index))
- until (zerop val)))
- (values index buffer)) ;return the buffer to improve 'trace'
-
-(defun encode-uint64 (val buffer index)
- "Encodes the 64-bit integer 'val' into the buffer at the given index.
- Modifies the buffer, and returns the new index into the buffer."
- (declare (type fixnum index)
- (type (simple-array (unsigned-byte 8)) buffer))
- (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
- (loop do (let ((bits (ldb #.(byte 7 0) val)))
- (declare (type fixnum bits))
- (setq val (ash val -7))
- (setf (aref buffer index) (ilogior bits (if (zerop val) 0 128)))
- (iincf index))
- until (zerop val)))
- (values index buffer))
+ (declare (type list enum-values)
+ (type (unsigned-byte 32) tag))
+ (let ((idx (let ((e (find val enum-values :key #'proto-value)))
+ (and e (proto-index e)))))
+ (unless idx
+ (serialization-error "There is no enum value for ~S" val))
+ (i+ (varint-length tag) (varint-length (ldb (byte 32 0) idx)))))
+
+(defun packed-enum-size (values enum-values tag)
+ "Returns the size in bytes that the enum values will take when serialized."
+ (declare (type list enum-values)
+ (type (unsigned-byte 32) tag))
+ (let ((len (let ((len 0))
+ (declare (type fixnum len))
+ (map () #'(lambda (val)
+ (let ((idx (let ((e (find val enum-values :key #'proto-value)))
+ (and e (proto-index e)))))
+ (unless idx
+ (serialization-error "There is no enum value for ~S" val))
+ (iincf len (varint-length (ldb (byte 32 0) idx))))) values)
+ len)))
+ (declare (type (unsigned-byte 32) len))
+ ;; Two value: the full size of the packed object, and the size
+ ;; of just the payload
+ (values (i+ (varint-length tag) (varint-length len) len) len)))
+
+\f
+;;; Wire-level encoders
+;;; These are called at the lowest level, so arg types are assumed to be correct
+
+(defmacro generate-integer-encoders (bits)
+ "Generate 32- or 64-bit versions of integer encoders."
+ (assert (and (plusp bits) (zerop (mod bits 8))))
+ (let* ((encode-uint (fintern "~A~A" 'encode-uint bits))
+ (encode-fixed (fintern "~A~A" 'encode-fixed bits))
+ (encode-sfixed (fintern "~A~A" 'encode-sfixed bits))
+ (bytes (/ bits 8))
+ ;; Given bits, can we use fixnums safely?
+ (fixnump (<= bits (integer-length most-negative-fixnum)))
+ (ldb (if fixnump 'ildb 'ldb))
+ (ash (if fixnump 'iash 'ash))
+ (zerop-val (if fixnump '(i= val 0) '(zerop val))))
+ `(progn
+ (defun ,encode-uint (val buffer index)
+ ,(format nil
+ "Encodes the unsigned ~A-bit integer 'val' as a varint into the buffer at the given index.~
+ ~& Modifies the buffer, and returns the new index into the buffer.~
+ ~& Watch out, this function turns off all type checking and array bounds checking." bits)
+ (declare #.$optimize-serialization)
+ (let ((val (ldb (byte ,bits 0) val)))
+ (declare (type (unsigned-byte ,bits) val)
+ (type (simple-array (unsigned-byte 8)) buffer)
+ (type fixnum index))
+ ;; Seven bits at a time, least significant bits first
+ (loop do (let ((bits (,ldb (byte 7 0) val)))
+ (declare (type (unsigned-byte 8) bits))
+ (setq val (,ash val -7))
+ (setf (aref buffer index)
+ (ilogior bits (if ,zerop-val 0 128)))
+ (iincf index))
+ until ,zerop-val))
+ (values index buffer)) ;return the buffer to improve 'trace'
+ (defun ,encode-fixed (val buffer index)
+ ,(format nil
+ "Encodes the unsigned ~A-bit integer 'val' as a fixed int into the buffer at the given index.~
+ ~& Modifies the buffer, and returns 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 (unsigned-byte ,bits) val)
+ (type (simple-array (unsigned-byte 8)) buffer)
+ (type fixnum index))
+ (loop repeat ,bytes doing
+ (let ((byte (,ldb (byte 8 0) val)))
+ (declare (type (unsigned-byte 8) byte))
+ (setq val (,ash val -8))
+ (setf (aref buffer index) byte)
+ (iincf index)))
+ (values index buffer))
+ (defun ,encode-sfixed (val buffer index)
+ ,(format nil
+ "Encodes the signed ~A-bit integer 'val' as a fixed int into the buffer at the given index.~
+ ~& Modifies the buffer, and returns 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 (signed-byte ,bits) val)
+ (type (simple-array (unsigned-byte 8)) buffer)
+ (type fixnum index))
+ (loop repeat ,bytes doing
+ (let ((byte (,ldb (byte 8 0) val)))
+ (declare (type (unsigned-byte 8) byte))
+ (setq val (,ash val -8))
+ (setf (aref buffer index) byte)
+ (iincf index)))
+ (values index buffer)))))
+
+(generate-integer-encoders 32)
+(generate-integer-encoders 64)
+
+(defun encode-int (val buffer index)
+ "Encodes the signed integer 'val' as a varint into the buffer at the given index.
+ Modifies the buffer, and returns the new index into the buffer.
+ Watch out, this function turns off all type checking and array bounds checking."
+ (declare #.$optimize-serialization)
+ (declare (type (simple-array (unsigned-byte 8)) buffer)
+ (type (signed-byte 64) val)
+ (type fixnum index))
+ ;; Seven bits at a time, least significant bits first
+ (loop repeat 9 ;up to 63 bits
+ do (setf (aref buffer index) (ldb (byte 7 0) val))
+ (setq val (ash val -7))
+ until (zerop val)
+ do (iincf (aref buffer index) #x80)
+ (iincf index)
+ finally (unless (zerop val) ;take the 64th bit as needed
+ (setf (aref buffer index) 1)
+ (unless (= val -1)
+ (serialization-error "Integer too large while encoding VarInt."))))
+ (values (iincf index) buffer)) ;return the buffer to improve 'trace'