]> asedeno.scripts.mit.edu Git - cl-protobufs.git/blobdiff - wire-format.lisp
Don't kluge *asdf-verbose* on asdf3.
[cl-protobufs.git] / wire-format.lisp
index 96130f7998bb846831c82926b2813365244ab0b2..6d597decced6dc4b9fef97d9c23411ee66ca5ae6 100644 (file)
     (let ((idx (encode-uint32 tag buffer index)))
       (declare (type fixnum idx))
       (ecase type
-        ((:int32 :uint32)
-         (encode-uint32 (ldb (byte 32 0) val) buffer idx))
-        ((:int64 :uint64)
-         (encode-uint64 (ldb (byte 64 0) val) buffer idx))
+        ((:int32 :int64)
+         (encode-int val buffer idx))
+        ((:uint32)
+         (encode-uint32 val buffer idx))
+        ((:uint64)
+         (encode-uint64 val buffer idx))
         ((:sint32)
          (encode-uint32 (zig-zag-encode32 val) buffer idx))
         ((:sint64)
                       (format nil "~A:~A" (package-name (symbol-package val)) (symbol-name val)))))
            (encode-string val buffer idx)))
         ((:date :time :datetime :timestamp)
-         (encode-uint64 (ldb (byte 64 0) val) buffer idx))))))
+         (encode-uint64 val buffer idx))))))
 
 (define-compiler-macro serialize-prim (&whole form val type tag buffer index)
   (setq type (fold-symbol type)
        (let ((idx (encode-uint32 ,tag ,buffer ,index)))
          (declare (type fixnum idx))
          ,(ecase type
-            ((:int32)
-             `(encode-uint32 (ldb (byte 32 0) ,val) ,buffer idx))
-            ((:int64)
-             `(encode-uint64 (ldb (byte 64 0) ,val) ,buffer idx))
+            ((:int32 :int64)
+             `(encode-int ,val ,buffer idx))
             ((:uint32)
              `(encode-uint32 ,val ,buffer idx))
             ((:uint64)
           (packed-size values type tag)
         (declare (type fixnum len) (ignore full-len))
         (setq idx (encode-uint32 len buffer idx)))
-      (ecase type
-        ((:int32 :uint32)
-         (map () #'(lambda (val) (setq idx (encode-uint32 (ldb (byte 32 0) val) buffer idx))) values))
-        ((:int64 :uint64)
-         (map () #'(lambda (val) (setq idx (encode-uint64 (ldb (byte 64 0) val) buffer idx))) values))
-        ((:sint32)
-         (map () #'(lambda (val) (setq idx (encode-uint32 (zig-zag-encode32 val) buffer idx))) values))
-        ((:sint64)
-         (map () #'(lambda (val) (setq idx (encode-uint64 (zig-zag-encode64 val) buffer idx))) values))
-        ((:fixed32)
-         (map () #'(lambda (val) (setq idx (encode-fixed32 val buffer idx))) values))
-        ((:sfixed32)
-         (map () #'(lambda (val) (setq idx (encode-sfixed32 val buffer idx))) values))
-        ((:fixed64)
-         (map () #'(lambda (val) (setq idx (encode-fixed64 val buffer idx))) values))
-        ((:sfixed64)
-         (map () #'(lambda (val) (setq idx (encode-sfixed64 val buffer idx))) values))
-        ((:bool)
-         (map () #'(lambda (val) (setq idx (encode-uint32 (if val 1 0) buffer idx))) values))
-        ((:float)
-         (map () #'(lambda (val) (setq idx (encode-single val buffer idx))) values))
-        ((:double)
-         (map () #'(lambda (val) (setq idx (encode-double val buffer idx))) values)))
+      (map ()
+           (ecase type
+             ((:int32 :int64) #'(lambda (val) (setq idx (encode-int val buffer idx))))
+             ((:uint32) #'(lambda (val) (setq idx (encode-uint32 val buffer idx))))
+             ((:uint64) #'(lambda (val) (setq idx (encode-uint64 val buffer idx))))
+             ((:sint32) #'(lambda (val) (setq idx (encode-uint32 (zig-zag-encode32 val) buffer idx))))
+             ((:sint64) #'(lambda (val) (setq idx (encode-uint64 (zig-zag-encode64 val) buffer idx))))
+             ((:fixed32) #'(lambda (val) (setq idx (encode-fixed32 val buffer idx))))
+             ((:sfixed32) #'(lambda (val) (setq idx (encode-sfixed32 val buffer idx))))
+             ((:fixed64) #'(lambda (val) (setq idx (encode-fixed64 val buffer idx))))
+             ((:sfixed64) #'(lambda (val) (setq idx (encode-sfixed64 val buffer idx))))
+             ((:bool) #'(lambda (val) (setq idx (encode-uint32 (if val 1 0) buffer idx))))
+             ((:float) #'(lambda (val) (setq idx (encode-single val buffer idx))))
+             ((:double) #'(lambda (val) (setq idx (encode-double val buffer idx)))))
+           values)
       idx)))
 
 ;; The optimized serializers supply 'vectorp' so we can generate better code
            (setq idx (encode-uint32 len ,buffer idx)))
          (,(if vectorp 'dovector 'dolist) (val ,values)
             ,(ecase type
-               ((:int32)
-                `(setq idx (encode-uint32 (ldb (byte 32 0) val) ,buffer idx)))
-               ((:int64)
-                `(setq idx (encode-uint64 (ldb (byte 64 0) val) ,buffer idx)))
+               ((:int32 :int64)
+                `(setq idx (encode-int val ,buffer idx)))
                ((:uint32)
                 `(setq idx (encode-uint32 val ,buffer idx)))
                ((:uint64)
            (idx (encode-uint32 tag buffer index)))
       (declare (type (unsigned-byte 32) val)
                (type fixnum idx))
-      (encode-uint32 (ldb (byte 32 0) val) buffer idx))))
+      (encode-uint32 val buffer idx))))
 
 (defun serialize-packed-enum (values enum-values tag buffer index)
   "Serializes Protobufs enum values into the buffer at the given index.
                   (let ((val (let ((e (find val enum-values :key #'proto-value)))
                                (and e (proto-index e)))))
                     (declare (type (unsigned-byte 32) val))
-                    (setq idx (encode-uint32 (ldb (byte 32 0) val) buffer idx)))) values)
+                    (setq idx (encode-uint32 val buffer idx)))) values)
       idx)))
 
 
            (type fixnum index))
   (locally (declare #.$optimize-serialization)
     (ecase type
-      ((:int32)
-       (decode-int32 buffer index))
-      ((:int64)
-       (decode-int64 buffer index))
+      ((:int32 :int64)
+       (decode-int buffer index))
       ((:uint32)
        (decode-uint32 buffer index))
       ((:uint64)
                        (type (simple-array (unsigned-byte 8)) ,buffer)
                        (type fixnum ,index))
        ,(ecase type
-          ((:int32)
-           `(decode-int32 ,buffer ,index))
-          ((:int64)
-           `(decode-int64 ,buffer ,index))
+          ((:int32 :int64)
+           `(decode-int ,buffer ,index))
           ((:uint32)
            `(decode-uint32 ,buffer ,index))
           ((:uint64)
               (return-from deserialize-packed (values values idx)))
             (multiple-value-bind (val nidx)
                 (ecase type
-                  ((:int32)
-                   (decode-int32 buffer idx))
-                  ((:int64)
-                   (decode-int64 buffer idx))
+                  ((:int32 :int64)
+                   (decode-int buffer idx))
                   ((:uint32)
                    (decode-uint32 buffer idx))
                   ((:uint64)
                    (return-from deserialize-packed (values values idx)))
                  (multiple-value-bind (val nidx)
                      ,(ecase type
-                        ((:int32)
-                         `(decode-int32 ,buffer idx))
-                        ((:int64)
-                         `(decode-int64 ,buffer idx))
+                        ((:int32 :int64)
+                         `(decode-int ,buffer idx))
                         ((:uint32)
                          `(decode-uint32 ,buffer idx))
                         ((:uint64)
            (type fixnum index))
   (locally (declare #.$optimize-serialization)
     (multiple-value-bind (val idx)
-        (decode-int32 buffer index)
+        (decode-int buffer index)
       (let ((val (let ((e (find val enum-values :key #'proto-index)))
                    (and e (proto-value e)))))
         (values val idx)))))
             (when (>= idx end)
               (return-from deserialize-packed-enum (values values idx)))
             (multiple-value-bind (val nidx)
-                (decode-int32 buffer idx)
+                (decode-int buffer idx)
               (let ((val (let ((e (find val enum-values :key #'proto-index)))
                            (and e (proto-value e)))))
                 (collect-value val)
   (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
                    ~&    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))
-         ;; 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)
+         (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
 (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'
+
 (defun encode-single (val buffer index)
   "Encodes the single float 'val' into the buffer at the given index.
    Modifies the buffer, and returns the new index into the buffer.
            (type (simple-array (unsigned-byte 8)) buffer)
            (type fixnum index))
   (let ((bits (single-float-bits val)))
+    (declare (type (signed-byte 32) bits))
     (loop repeat 4 doing
       (let ((byte (ldb (byte 8 0) bits)))
         (declare (type (unsigned-byte 8) byte))
            (type fixnum index))
   (multiple-value-bind (low high)
       (double-float-bits val)
+    (declare (type (unsigned-byte 32) low)
+             (type (signed-byte 32) high))
     (loop repeat 4 doing
       (let ((byte (ldb (byte 8 0) low)))
         (declare (type (unsigned-byte 8) byte))
   (let* ((octets (babel:string-to-octets string :encoding :utf-8))
          (len (length octets))
          (idx (encode-uint32 len buffer index)))
-    (declare (type (array (unsigned-byte 8)) octets)
+    (declare (type (simple-array (unsigned-byte 8)) octets)
              (type fixnum len)
              (type (unsigned-byte 32) idx))
     (replace buffer octets :start1 idx)
   "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-int  (fintern "~A~A" 'decode-int 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)))
-         (ldb (if fixnump 'ildb 'ldb))
          (ash (if fixnump 'iash 'ash))
          (decf (if fixnump 'idecf 'decf))
-         (logior (if fixnump 'ilogior 'logior)))
+         (logior (if fixnump 'ilogior 'logior))
+         (logbitp (if fixnump 'ilogbitp 'logbitp)))
     `(progn
        (defun ,decode-uint (buffer index)
          ,(format nil
                  do (let ((bits (ildb (byte 7 0) byte)))
                       (declare (type (unsigned-byte 8) bits))
                       (setq val (,logior val (,ash bits places))))
-                 until (i< byte 128)
+                 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-int (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))
-         (multiple-value-bind (val index)
-             (,decode-uint buffer index)
-           ,@(when fixnump `((declare (type fixnum val))))
-           (when (i= (,ldb (byte 1 ,(1- bits)) val) 1)
-             (,decf val ,(ash 1 bits)))
-           (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.~
                  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 (i= (,ldb (byte 1 ,(1- bits)) val) 1)  ;sign bit set, so negative value
+           (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.
+   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-serialization)
+  (declare (type (simple-array (unsigned-byte 8)) buffer)
+           (type fixnum index))
+  (multiple-value-bind (val index)
+      (decode-uint64 buffer index)
+    (declare (type (unsigned-byte 64) val))
+    (values (if (logbitp 63 val)
+                (- val #.(ash 1 64))
+                val)
+            index)))
+
 (defun decode-single (buffer index)
   "Decodes the next single float in the buffer at the given index.
    Returns both the decoded value and the new index into the buffer.
            (type fixnum index))
   ;; Eight bits at a time, least significant bits first
   (let ((bits 0))
+    (declare (type (unsigned-byte 32) bits))
     (loop repeat 4
           for places fixnum upfrom 0 by 8
           for byte fixnum = (prog1 (aref buffer index) (iincf index))
           do (setq bits (logior bits (ash byte places))))
-    (when (i= (ldb (byte 1 31) bits) 1)             ;sign bit set, so negative value
-      (decf bits #.(ash 1 32)))
-    (values (make-single-float bits) index)))
+    (values (make-single-float (if (logbitp 31 bits)    ;sign bit
+                                 (- bits #.(ash 1 32))
+                                 bits))
+            index)))
 
 (defun decode-double (buffer index)
   "Decodes the next double float in the buffer at the given index.
   ;; Eight bits at a time, least significant bits first
   (let ((low  0)
         (high 0))
+    (declare (type (unsigned-byte 32) low)
+             (type (unsigned-byte 32) high))
     (loop repeat 4
           for places fixnum upfrom 0 by 8
           for byte fixnum = (prog1 (aref buffer index) (iincf index))
           for byte fixnum = (prog1 (aref buffer index) (iincf index))
           do (setq high (logior high (ash byte places))))
     ;; High bits are signed, but low bits are unsigned
-    (when (i= (ldb (byte 1 31) high) 1)             ;sign bit set, so negative value
-      (decf high #.(ash 1 32)))
-    (values (make-double-float low high) index)))
+    (values (make-double-float low (if (logbitp 31 high)        ;sign bit
+                                     (- high #.(ash 1 32))
+                                     high))
+            index)))
 
 (defun decode-string (buffer index)
   "Decodes the next UTF-8 encoded string in the buffer at the given index.
 ;;; Wire-level lengths
 ;;; These are called at the lowest level, so arg types are assumed to be correct
 
-(defmacro gen-length (bits)
-  "Generate 32- or 64-bit versions of integer length functions."
-  (assert (and (plusp bits) (zerop (mod bits 8))))
-  (let* (;; Given bits, can we use fixnums safely?
-         (fixnump (<= bits (integer-length most-negative-fixnum)))
-         (ash (if fixnump 'iash 'ash))
-         (zerop-val (if fixnump '(i= val 0) '(zerop val))))
-    `(defun ,(fintern "~A~A" 'length bits) (val)
-       ,(format nil "Returns the length that 'val' will take when encoded as a ~A-bit integer." bits)
-       (declare #.$optimize-serialization)
-       (declare (type (unsigned-byte ,bits) val))
-       (let ((size 0))
-         (declare (type fixnum size))
-         (loop do (progn
-                    (setq val (,ash val -7))
-                    (iincf size))
-               until ,zerop-val)
-         size))))
-
-(gen-length 32)
-(gen-length 64)
-
 (defun varint-length (val)
   "Return the length that 'val' will take when encoded as a varint integer."
   (declare #.$optimize-serialization)
-  (let ((val (ldb (byte 64 0) val))
-        (size 0))
-    (declare (type (unsigned-byte 64) val))
-    (declare (type fixnum size))
-    (loop do (setq val (ash val -7))
-             (iincf size)
-          until (zerop val))
-    size))
-
+  (loop repeat 10                       ;max length of varint
+        do (setq val (ash val -7))
+        count 1
+        until (zerop val)))
 
 ;;; Skipping elements
 ;;; This is called at the lowest level, so arg types are assumed to be correct