(doseq (v (if slot (read-slot object slot reader) (list object)))
(let ((tag1 (make-tag $wire-type-start-group (proto-index field)))
(tag2 (make-tag $wire-type-end-group (proto-index field))))
- (iincf size (length32 tag1))
+ (iincf size (varint-length tag1))
(dolist (f (proto-fields msg))
(do-field v msg f))
- (iincf size (length32 tag2))))
+ (iincf size (varint-length tag2))))
(doseq (v (if slot (read-slot object slot reader) (list object)))
(let ((tag (make-tag $wire-type-string (proto-index field)))
(len (or (cached-object-size v visited)
(object-size v msg visited))))
- (iincf size (length32 tag))
- (iincf size (length32 len))
+ (iincf size (varint-length tag))
+ (iincf size (varint-length len))
(dolist (f (proto-fields msg))
(do-field v msg f))))))
((typep msg 'protobuf-enum)
(if (eq (proto-message-type msg) :group)
(let ((tag1 (make-tag $wire-type-start-group (proto-index field)))
(tag2 (make-tag $wire-type-end-group (proto-index field))))
- (iincf size (length32 tag1))
+ (iincf size (varint-length tag1))
(dolist (f (proto-fields msg))
(do-field v msg f))
- (iincf size (length32 tag2)))
+ (iincf size (varint-length tag2)))
(let ((tag (make-tag $wire-type-string (proto-index field)))
(len (or (cached-object-size v visited)
(object-size v msg visited))))
- (iincf size (length32 tag))
- (iincf size (length32 len))
+ (iincf size (varint-length tag))
+ (iincf size (varint-length len))
(dolist (f (proto-fields msg))
(do-field v msg f)))))))
((typep msg 'protobuf-enum)
`(,iterator (,vval ,reader)
(let ((len (or (cached-object-size ,vval visited)
(object-size ,vval ,msg visited))))
- (iincf ,vsize (length32 ,tag1))
+ (iincf ,vsize (varint-length ,tag1))
(iincf ,vsize len)
(iincf ,vsize ,tag2))))
(let ((tag (make-tag $wire-type-string index)))
`(,iterator (,vval ,reader)
(let ((len (or (cached-object-size ,vval visited)
(object-size ,vval ,msg visited))))
- (iincf ,vsize (length32 ,tag))
- (iincf ,vsize (length32 len))
+ (iincf ,vsize (varint-length ,tag))
+ (iincf ,vsize (varint-length len))
(iincf ,vsize len)))))))
((typep msg 'protobuf-enum)
(let ((tag (make-tag $wire-type-varint index)))
(when ,vval
(let ((len (or (cached-object-size ,vval visited)
(object-size ,vval ,msg visited))))
- (iincf ,vsize (length32 ,tag1))
+ (iincf ,vsize (varint-length ,tag1))
(iincf ,vsize len)
- (iincf ,vsize (length32 ,tag2))))))
+ (iincf ,vsize (varint-length ,tag2))))))
(let ((tag (make-tag $wire-type-string index)))
`(let ((,vval ,reader))
(when ,vval
(let ((len (or (cached-object-size ,vval visited)
(object-size ,vval ,msg visited))))
- (iincf ,vsize (length32 ,tag))
- (iincf ,vsize (length32 len))
+ (iincf ,vsize (varint-length ,tag))
+ (iincf ,vsize (varint-length len))
(iincf ,vsize len))))))))
((typep msg 'protobuf-enum)
(let ((tag (make-tag $wire-type-varint index)))
;;; Varint unit tests
-(define-test length32-test ()
- (assert-equal (length32 0) 1)
- (assert-equal (length32 1) 1)
- (assert-equal (length32 127) 1)
- (assert-equal (length32 128) 2)
- (assert-equal (length32 16383) 2)
- (assert-equal (length32 16384) 3)
- (assert-equal (length32 (ash 1 31)) 5))
-
-(define-test length64-test ()
- (assert-equal (length64 0) 1)
- (assert-equal (length64 1) 1)
- (assert-equal (length64 127) 1)
- (assert-equal (length64 128) 2)
- (assert-equal (length64 16383) 2)
- (assert-equal (length64 16384) 3)
- (assert-equal (length64 (- (ash 1 21) 1)) 3)
- (assert-equal (length64 (ash 1 21)) 4)
- (assert-equal (length64 (ash 1 63)) 10))
+(define-test varint-length-test ()
+ (assert-equal (varint-length 0) 1)
+ (assert-equal (varint-length 1) 1)
+ (assert-equal (varint-length 127) 1)
+ (assert-equal (varint-length 128) 2)
+ (assert-equal (varint-length 16383) 2)
+ (assert-equal (varint-length 16384) 3)
+ (assert-equal (varint-length (ash 1 31)) 5)
+ (assert-equal (varint-length (- (ash 1 21) 1)) 3)
+ (assert-equal (varint-length (ash 1 21)) 4)
+ (assert-equal (varint-length (ash 1 63)) 10))
(define-test uint32-test ()
(define-test-suite varint-tests ()
- (length32-test
- length64-test
+ (varint-length-test
uint32-test
uint64-test
powers-varint-test
(declare (type (unsigned-byte 32) tag))
(locally (declare #.$optimize-serialization)
(ecase type
- ((:int32 :uint32)
- (i+ (length32 tag) (length32 (ldb (byte 32 0) val))))
- ((:int64 :uint64)
- (i+ (length32 tag) (length64 (ldb (byte 64 0) val))))
+ ((:int32 :uint32 :int64 :uint64)
+ (i+ (varint-length tag) (varint-length val)))
((:sint32)
- (i+ (length32 tag) (length32 (zig-zag-encode32 val))))
+ (i+ (varint-length tag) (varint-length (zig-zag-encode32 val))))
((:sint64)
- (i+ (length32 tag) (length64 (zig-zag-encode64 val))))
+ (i+ (varint-length tag) (varint-length (zig-zag-encode64 val))))
((:fixed32 :sfixed32)
- (i+ (length32 tag) 4))
+ (i+ (varint-length tag) 4))
((:fixed64 :sfixed64)
- (i+ (length32 tag) 8))
+ (i+ (varint-length tag) 8))
((:string)
(let ((len (babel:string-size-in-octets val :encoding :utf-8)))
- (i+ (length32 tag) (length32 len) len)))
+ (i+ (varint-length tag) (varint-length len) len)))
((:bytes)
(let ((len (length val)))
- (i+ (length32 tag) (length32 len) len)))
+ (i+ (varint-length tag) (varint-length len) len)))
((:bool)
- (i+ (length32 tag) 1))
+ (i+ (varint-length tag) 1))
((:float)
- (i+ (length32 tag) 4))
+ (i+ (varint-length tag) 4))
((:double)
- (i+ (length32 tag) 8))
+ (i+ (varint-length tag) 8))
;; A few of our homegrown types
((:symbol)
(let ((len (if (keywordp val)
(length (symbol-name val))
(i+ (length (package-name (symbol-package val))) 1 (length (symbol-name val))))))
- (i+ (length32 tag) (length32 len) len)))
+ (i+ (varint-length tag) (varint-length len) len)))
((:date :time :datetime :timestamp)
- (i+ (length32 tag) 8)))))
+ (i+ (varint-length tag) 8)))))
(define-compiler-macro prim-size (&whole form val type tag)
(setq type (fold-symbol type)
:string :bytes :bool :float :double))
`(locally (declare #.$optimize-serialization)
,(ecase type
- ((:int32)
- `(i+ (length32 ,tag) (length32 (ldb (byte 32 0) ,val))))
- ((:int64)
- `(i+ (length32 ,tag) (length64 (ldb (byte 64 0) ,val))))
- ((:uint32)
- `(i+ (length32 ,tag) (length32 ,val)))
- ((:uint64)
- `(i+ (length32 ,tag) (length64 ,val)))
+ ((:int32 :int64 :uint32 :uint64)
+ `(i+ (varint-length ,tag) (varint-length ,val)))
((:sint32)
- `(i+ (length32 ,tag) (length32 (zig-zag-encode32 ,val))))
+ `(i+ (varint-length ,tag) (varint-length (zig-zag-encode32 ,val))))
((:sint64)
- `(i+ (length32 ,tag) (length64 (zig-zag-encode64 ,val))))
+ `(i+ (varint-length ,tag) (varint-length (zig-zag-encode64 ,val))))
((:fixed32 :sfixed32)
- `(i+ (length32 ,tag) 4))
+ `(i+ (varint-length ,tag) 4))
((:fixed64 :sfixed64)
- `(i+ (length32 ,tag) 8))
+ `(i+ (varint-length ,tag) 8))
((:string)
`(let ((len (babel:string-size-in-octets ,val :encoding :utf-8)))
- (i+ (length32 ,tag) (length32 len) len)))
+ (i+ (varint-length ,tag) (varint-length len) len)))
((:bytes)
`(let ((len (length ,val)))
- (i+ (length32 ,tag) (length32 len) len)))
+ (i+ (varint-length ,tag) (varint-length len) len)))
((:bool)
- `(i+ (length32 ,tag) 1))
+ `(i+ (varint-length ,tag) 1))
((:float)
- `(i+ (length32 ,tag) 4))
+ `(i+ (varint-length ,tag) 4))
((:double)
- `(i+ (length32 ,tag) 8))))
+ `(i+ (varint-length ,tag) 8))))
form))
(defun packed-size (values type tag &optional vectorp)
(declare (type fixnum len))
(map () #'(lambda (val)
(iincf len (ecase type
- ((:int32 :uint32) (length32 (ldb (byte 32 0) val)))
- ((:int64 :uint64) (length64 (ldb (byte 64 0) val)))
- ((:sint32) (length32 (zig-zag-encode32 val)))
- ((:sint64) (length64 (zig-zag-encode64 val)))
+ ((:int32 :uint32 :int64 :uint64) (varint-length val))
+ ((:sint32) (varint-length (zig-zag-encode32 val)))
+ ((:sint64) (varint-length (zig-zag-encode64 val)))
((:fixed32 :sfixed32) 4)
((:fixed64 :sfixed64) 8)
((:bool) 1)
(declare (type (unsigned-byte 32) len))
;; Two value: the full size of the packed object, and the size
;; of just the payload
- (values (i+ (length32 tag) (length32 len) len) len))))
+ (values (i+ (varint-length tag) (varint-length len) len) len))))
;; The optimized serializers supply 'vectorp' so we can generate better code
(define-compiler-macro packed-size (&whole form values type tag
(declare (type fixnum len))
(,(if vectorp 'dovector 'dolist) (val ,values)
(iincf len ,(ecase type
- ((:int32) `(length32 (ldb (byte 32 0) val)))
- ((:int64) `(length64 (ldb (byte 64 0) val)))
- ((:uint32) `(length32 val))
- ((:uint64) `(length64 val))
- ((:sint32) `(length32 (zig-zag-encode32 val)))
- ((:sint64) `(length64 (zig-zag-encode64 val)))
+ ((:int32 :uint32 :int64 :uint64) `(varint-length val))
+ ((:sint32) `(varint-length (zig-zag-encode32 val)))
+ ((:sint64) `(varint-length (zig-zag-encode64 val)))
((:fixed32 :sfixed32) `4)
((:fixed64 :sfixed64) `8)
((:bool) `1)
((:double) `8))))
len)))
(declare (type (unsigned-byte 32) len))
- (values (i+ (length32 (the (unsigned-byte 32) ,tag)) (length32 len) len) len)))
+ (values (i+ (varint-length (the (unsigned-byte 32) ,tag)) (varint-length len) len) len)))
form))
(defun enum-size (val enum-values tag)
(and e (proto-index e)))))
(unless idx
(serialization-error "There is no enum value for ~S" val))
- (i+ (length32 tag) (length32 (ldb (byte 32 0) idx)))))
+ (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."
(and e (proto-index e)))))
(unless idx
(serialization-error "There is no enum value for ~S" val))
- (iincf len (length32 (ldb (byte 32 0) idx))))) values)
+ (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+ (length32 tag) (length32 len) len) len)))
+ (values (i+ (varint-length tag) (varint-length len) len) len)))
\f
;;; Wire-level encoders