utilities: Introduce ILOGBITP, a LOGBITP for FIXNUMS

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

diff --git a/wire-format.lisp b/wire-format.lisp
index 3c295b77c42a51c58a24313da5a1396518711c97..449c1e6742233797fbfa4d16506bef6d04be1a72 100644 (file)
--- a/wire-format.lisp
+++ b/wire-format.lisp
@@ -173,7 +173,7 @@
                       (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)
@@ -324,7 +324,7 @@
            (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.
@@ -346,7 +346,7 @@
                   (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)))
 
 
@@ -773,17 +773,18 @@
                    ~&    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
@@ -826,19 +827,20 @@
    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)
-  (let ((val (ldb (byte 64 0) val))) ;clamp val to 64-bits maximum
-    (declare (type (unsigned-byte 64) 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'
+  (declare (type (simple-array (unsigned-byte 8)) buffer)
+           (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.
@@ -891,7 +893,7 @@
   (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)
@@ -1077,15 +1079,10 @@
 (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