wire-format: Replace LENGTH32 and LENGTH64 with VARINT-LENGTH

diff --git a/serialize.lisp b/serialize.lisp
index 6160eada058dd65c011d80e399f3089be3814161..178d34b03a7fdc52685bf8d98a033e67b0aa714f 100644 (file)
--- a/serialize.lisp
+++ b/serialize.lisp
@@ -592,16 +592,16 @@
                                      (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))))
                                      (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))
                                          (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))))
                                      (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)
                                          (dolist (f (proto-fields msg))
                                            (do-field v msg f))))))
                                   ((typep msg 'protobuf-enum)


@@ -644,15 +644,15 @@
                                        (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))))
                                        (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))
                                            (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))))
                                          (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)
                                            (dolist (f (proto-fields msg))
                                              (do-field v msg f)))))))
                                   ((typep msg 'protobuf-enum)


@@ -1062,15 +1062,15 @@
                                  `(,iterator (,vval ,reader)
                                     (let ((len (or (cached-object-size ,vval visited)
                                                    (object-size ,vval ,msg visited))))
                                  `(,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 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)))
                                       (iincf ,vsize len)))))))
                            ((typep msg 'protobuf-enum)
                             (let ((tag (make-tag $wire-type-varint index)))


@@ -1120,16 +1120,16 @@
                                   (when ,vval
                                     (let ((len (or (cached-object-size ,vval visited)
                                                    (object-size ,vval ,msg visited))))
                                   (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 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))))
                              (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)))
                                       (iincf ,vsize len))))))))
                          ((typep msg 'protobuf-enum)
                           (let ((tag (make-tag $wire-type-varint index)))

diff --git a/tests/varint-tests.lisp b/tests/varint-tests.lisp
index 4c00c339f5bd03b52b754bb4704273a2e6200f3e..1f1d1903e27330d438b904c217a5befa86e2c5c8 100644 (file)
--- a/tests/varint-tests.lisp
+++ b/tests/varint-tests.lisp
@@ -14,25 +14,17 @@
 
 ;;; Varint unit tests
 
 
 ;;; 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 uint32-test ()


@@ -131,8 +123,7 @@
 
 
 (define-test-suite varint-tests ()
 
 
 (define-test-suite varint-tests ()

-  (length32-test
-   length64-test
+  (varint-length-test

    uint32-test
    uint64-test
    powers-varint-test
    uint32-test
    uint64-test
    powers-varint-test

diff --git a/tests/wire-tests.lisp b/tests/wire-tests.lisp
index 3add1c9feb839915432e4982c8ab12584d85cf49..8b2765a24d7d62d7be5336854d65242eb6145078 100644 (file)
--- a/tests/wire-tests.lisp
+++ b/tests/wire-tests.lisp
@@ -59,13 +59,7 @@
   (flet ((verify (encoder pairs)
            (loop for (input output) in pairs
                  do (assert-true (= (funcall encoder input) output)))))
   (flet ((verify (encoder pairs)
            (loop for (input output) in pairs
                  do (assert-true (= (funcall encoder input) output)))))

-    (verify #'length32
-            '((#x0 1) (#x7f 1)                ; 0-7 bits
-              (#x80 2) (#x3fff 2)             ; 8-14 bits
-              (#x4000 3) (#x1fffff 3)         ; 15-21 bits
-              (#x200000 4) (#xfffffff 4)      ; 22-28 bits
-              (#x10000000 5) (#xffffffff 5))) ; 29-35 bits, though we'll actually stop at 32 bits.
-    (verify #'length64
+    (verify #'varint-length

             '((#x0 1) (#x7f 1)                                    ; 0-7 bits
               (#x80 2) (#x3fff 2)                                 ; 8-14 bits
               (#x4000 3) (#x1fffff 3)                             ; 15-21 bits
             '((#x0 1) (#x7f 1)                                    ; 0-7 bits
               (#x80 2) (#x3fff 2)                                 ; 8-14 bits
               (#x4000 3) (#x1fffff 3)                             ; 15-21 bits

diff --git a/wire-format.lisp b/wire-format.lisp
index 96130f7998bb846831c82926b2813365244ab0b2..b4840a9756a6ae2f9d9bcb52c2a4caab66464f1d 100644 (file)
--- a/wire-format.lisp
+++ b/wire-format.lisp
@@ -616,38 +616,36 @@
   (declare (type (unsigned-byte 32) tag))
   (locally (declare #.$optimize-serialization)
     (ecase type
   (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)
       ((:sint32)

-       (i+ (length32 tag) (length32 (zig-zag-encode32 val))))
+       (i+ (varint-length tag) (varint-length (zig-zag-encode32 val))))

       ((:sint64)
       ((:sint64)

-       (i+ (length32 tag) (length64 (zig-zag-encode64 val))))
+       (i+ (varint-length tag) (varint-length (zig-zag-encode64 val))))

       ((:fixed32 :sfixed32)
       ((:fixed32 :sfixed32)

-       (i+ (length32 tag) 4))
+       (i+ (varint-length tag) 4))

       ((:fixed64 :sfixed64)
       ((:fixed64 :sfixed64)

-       (i+ (length32 tag) 8))
+       (i+ (varint-length tag) 8))

       ((:string)
        (let ((len (babel:string-size-in-octets val :encoding :utf-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)))
       ((:bytes)
        (let ((len (length val)))

-         (i+ (length32 tag) (length32 len) len)))
+         (i+ (varint-length tag) (varint-length len) len)))

       ((:bool)
       ((:bool)

-       (i+ (length32 tag) 1))
+       (i+ (varint-length tag) 1))

       ((:float)
       ((:float)

-       (i+ (length32 tag) 4))
+       (i+ (varint-length tag) 4))

       ((:double)
       ((: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))))))
       ;; 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)
       ((: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)
 
 (define-compiler-macro prim-size (&whole form val type tag)
   (setq type (fold-symbol type)


@@ -657,34 +655,28 @@
                      :string :bytes :bool :float :double))
     `(locally (declare #.$optimize-serialization)
        ,(ecase 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)
           ((:sint32)

-           `(i+ (length32 ,tag) (length32 (zig-zag-encode32 ,val))))
+           `(i+ (varint-length ,tag) (varint-length (zig-zag-encode32 ,val))))

           ((:sint64)
           ((:sint64)

-           `(i+ (length32 ,tag) (length64 (zig-zag-encode64 ,val))))
+           `(i+ (varint-length ,tag) (varint-length (zig-zag-encode64 ,val))))

           ((:fixed32 :sfixed32)
           ((:fixed32 :sfixed32)

-           `(i+ (length32 ,tag) 4))
+           `(i+ (varint-length ,tag) 4))

           ((:fixed64 :sfixed64)
           ((:fixed64 :sfixed64)

-           `(i+ (length32 ,tag) 8))
+           `(i+ (varint-length ,tag) 8))

           ((:string)
            `(let ((len (babel:string-size-in-octets ,val :encoding :utf-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)))
           ((:bytes)
            `(let ((len (length ,val)))

-              (i+ (length32 ,tag) (length32 len) len)))
+              (i+ (varint-length ,tag) (varint-length len) len)))

           ((:bool)
           ((:bool)

-           `(i+ (length32 ,tag) 1))
+           `(i+ (varint-length ,tag) 1))

           ((:float)
           ((:float)

-           `(i+ (length32 ,tag) 4))
+           `(i+ (varint-length ,tag) 4))

           ((:double)
           ((:double)

-           `(i+ (length32 ,tag) 8))))
+           `(i+ (varint-length ,tag) 8))))

     form))
 
 (defun packed-size (values type tag &optional vectorp)
     form))
 
 (defun packed-size (values type tag &optional vectorp)


@@ -697,10 +689,9 @@
                  (declare (type fixnum len))
                  (map () #'(lambda (val)
                              (iincf len (ecase type
                  (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)
                                           ((:fixed32 :sfixed32) 4)
                                           ((:fixed64 :sfixed64) 8)
                                           ((:bool)   1)


@@ -710,7 +701,7 @@
       (declare (type (unsigned-byte 32) len))
       ;; Two value: the full size of the packed object, and the size
       ;; of just the payload
       (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
 
 ;; The optimized serializers supply 'vectorp' so we can generate better code
 (define-compiler-macro packed-size (&whole form values type tag


@@ -726,12 +717,9 @@
                     (declare (type fixnum len))
                     (,(if vectorp 'dovector 'dolist) (val ,values)
                        (iincf len ,(ecase type
                     (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)
                                      ((:fixed32 :sfixed32) `4)
                                      ((:fixed64 :sfixed64) `8)
                                      ((:bool)   `1)


@@ -739,7 +727,7 @@
                                      ((:double) `8))))
                     len)))
          (declare (type (unsigned-byte 32) len))
                                      ((: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)
     form))
 
 (defun enum-size (val enum-values tag)


@@ -750,7 +738,7 @@
                (and e (proto-index e)))))
     (unless idx
       (serialization-error "There is no enum value for ~S" val))
                (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."
 
 (defun packed-enum-size (values enum-values tag)
   "Returns the size in bytes that the enum values will take when serialized."


@@ -763,12 +751,12 @@
                                         (and e (proto-index e)))))
                              (unless idx
                                (serialization-error "There is no enum value for ~S" val))
                                         (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
                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
 
 \f
 ;;; Wire-level encoders