Don't kluge *asdf-verbose* on asdf3.

[cl-protobufs.git] / wire-format.lisp

diff --git a/wire-format.lisp b/wire-format.lisp
index f2adce4ff8bad800bbda6ed16e0128c785fca648..6d597decced6dc4b9fef97d9c23411ee66ca5ae6 100644 (file)
--- a/wire-format.lisp
+++ b/wire-format.lisp
@@ -234,31 +234,21 @@
           (packed-size values type tag)
         (declare (type fixnum len) (ignore full-len))
         (setq idx (encode-uint32 len buffer idx)))
-      (ecase type
-        ((:int32 :int64)
-         (map () #'(lambda (val) (setq idx (encode-int val buffer idx))) values))
-        ((:uint32)
-         (map () #'(lambda (val) (setq idx (encode-uint32 val buffer idx))) values))
-        ((:uint64)
-         (map () #'(lambda (val) (setq idx (encode-uint64 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
@@ -828,6 +818,7 @@
    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
@@ -851,6 +842,7 @@
            (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))
@@ -869,6 +861,8 @@
            (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))
@@ -1002,9 +996,11 @@
            (type fixnum index))
   (multiple-value-bind (val index)
       (decode-uint64 buffer index)
-    (when (logbitp 63 val)
-      (decf val #.(ash 1 64)))
-    (values val 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.