wire-format.lisp

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;;                                                                  ;;;
   3 ;;; Confidential and proprietary information of ITA Software, Inc.   ;;;
   4 ;;;                                                                  ;;;
   5 ;;; Copyright (c) 2012 ITA Software, Inc.  All rights reserved.      ;;;
   6 ;;;                                                                  ;;;
   7 ;;; Original author: Scott McKay                                     ;;;
   8 ;;;                                                                  ;;;
   9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10
  11 (in-package "PROTO-IMPL")
  12
  13
  14 ;;; Protocol buffers wire format
  15
  16 ;;; Serializers
  17
  18 ;; Serialize 'val' of primitive type 'type' into the buffer
  19 (defun serialize-prim (val type field buffer index)
  20   "Serializes a protobufs primitive (scalar) value into the buffer at the given index.
  21    The value is given by 'val', the primitive type by 'type'.
  22    'field' is the protobuf-field describing the value.
  23    Modifies the buffer in place, and returns the new index into the buffer."
  24   (declare (type fixnum index)
  25            (type (simple-array (unsigned-byte 8)) buffer))
  26   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
  27     (ecase type
  28       ((:int32 :uint32)
  29        (let* ((tag (ilogior $wire-type-varint (iash (proto-index field) 3)))
  30               (idx (encode-uint32 tag buffer index)))
  31          (declare (type fixnum tag idx))
  32          (encode-uint32 val buffer idx)))
  33       ((:int64 :uint64)
  34        (let* ((tag (ilogior $wire-type-varint (iash (proto-index field) 3)))
  35               (idx (encode-uint32 tag buffer index)))
  36          (declare (type fixnum tag idx))
  37          (encode-uint64 val buffer idx)))
  38       ((:sint32)
  39        (let* ((tag (ilogior $wire-type-varint (iash (proto-index field) 3)))
  40               (idx (encode-uint32 tag buffer index)))
  41          (declare (type fixnum tag idx))
  42          (encode-uint32 (zig-zag-encode32 val) buffer idx)))
  43       ((:sint64)
  44        (let* ((tag (ilogior $wire-type-varint (iash (proto-index field) 3)))
  45               (idx (encode-uint32 tag buffer index)))
  46          (declare (type fixnum tag idx))
  47          (encode-uint64 (zig-zag-encode64 val) buffer idx)))
  48       ((:fixed32 :sfixed32)
  49        (let* ((tag (ilogior $wire-type-32bit (iash (proto-index field) 3)))
  50               (idx (encode-uint32 tag buffer index)))
  51          (declare (type fixnum tag idx))
  52          (encode-uint32 val buffer idx)))
  53       ((:fixed64 :sfixed64)
  54        (let* ((tag (ilogior $wire-type-64bit (iash (proto-index field) 3)))
  55               (idx (encode-uint32 tag buffer index)))
  56          (declare (type fixnum tag idx))
  57          (encode-uint64 val buffer idx)))
  58       ((:string)
  59        (let* ((tag (ilogior $wire-type-string (iash (proto-index field) 3)))
  60               (idx (encode-uint32 tag buffer index)))
  61                (declare (type fixnum tag idx))
  62          (encode-octets (babel:string-to-octets val :encoding :utf-8) buffer idx)))
  63       ((:bytes)
  64        (let* ((tag (ilogior $wire-type-string (iash (proto-index field) 3)))
  65               (idx (encode-uint32 tag buffer index)))
  66          (declare (type fixnum tag idx))
  67          (encode-octets val buffer idx)))
  68       ((:bool)
  69        (let* ((tag (ilogior $wire-type-varint (iash (proto-index field) 3)))
  70               (idx (encode-uint32 tag buffer index)))
  71          (declare (type fixnum tag idx))
  72          (encode-uint32 (if val 1 0) buffer idx)))
  73       ((:float)
  74        (let* ((tag (ilogior $wire-type-32bit (iash (proto-index field) 3)))
  75               (idx (encode-uint32 tag buffer index)))
  76          (declare (type fixnum tag idx))
  77          (encode-single val buffer idx)))
  78       ((:double)
  79        (let* ((tag (ilogior $wire-type-64bit (iash (proto-index field) 3)))
  80               (idx (encode-uint32 tag buffer index)))
  81          (declare (type fixnum tag idx))
  82          (encode-double val buffer idx)))
  83       ;; A few of our homegrown types
  84       ((:symbol)
  85        (let* ((tag (ilogior $wire-type-string (iash (proto-index field) 3)))
  86               (idx (encode-uint32 tag buffer index))
  87               (val (format nil "~A:~A" (package-name (symbol-package val)) (symbol-name val))))
  88          ;; Call 'string' in case we are trying to serialize a symbol name
  89          (declare (type fixnum tag idx))
  90          (encode-octets (babel:string-to-octets val :encoding :utf-8) buffer idx)))
  91       ((:date :time :datetime :timestamp)
  92        (let* ((tag (ilogior $wire-type-64bit (iash (proto-index field) 3)))
  93               (idx (encode-uint32 tag buffer index)))
  94          (declare (type fixnum tag idx))
  95          (encode-uint64 val buffer idx))))))
  96
  97 (defun serialize-packed (values type field buffer index)
  98   "Serializes a set of packed values into the buffer at the given index.
  99    The values are given by 'values', the primitive type by 'type'.
 100    'field' is the protobuf-field describing the value.
 101    Modifies the buffer in place, and returns the new index into the buffer."
 102   (declare (type fixnum index)
 103            (type (simple-array (unsigned-byte 8)) buffer))
 104   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 105     (let* ((wtype (ecase type
 106                     ((:int32 :int64)   $wire-type-varint)
 107                     ((:uint32 :uint64) $wire-type-varint)
 108                     ((:sint32 :sint64) $wire-type-varint)
 109                     ((:fixed32 :sfixed32) $wire-type-32bit)
 110                     ((:fixed64 :sfixed64) $wire-type-64bit)
 111                     ((:float)  $wire-type-32bit)
 112                     ((:double) $wire-type-64bit)))
 113            (tag (ilogior wtype (iash (proto-index field) 3)))
 114            (idx (encode-uint32 tag buffer index)))
 115       (declare (type fixnum wtype tag idx))
 116       (multiple-value-bind (full-len len)
 117           (packed-size values type field)
 118         (declare (type fixnum len) (ignore full-len))
 119         (setq idx (encode-uint32 len buffer idx)))
 120       (ecase type
 121         ((:int32 :uint32)
 122          (dolist (val values idx)
 123            (setq idx (encode-uint32 val buffer idx))))
 124         ((:int64 :uint64)
 125          (dolist (val values idx)
 126            (setq idx (encode-uint64 val buffer idx))))
 127         ((:sint32)
 128          (dolist (val values idx)
 129            (setq idx (encode-uint32 (zig-zag-encode32 val) buffer idx))))
 130         ((:sint64)
 131          (dolist (val values idx)
 132            (setq idx (encode-uint64 (zig-zag-encode64 val) buffer idx))))
 133         ((:fixed32 :sfixed32)
 134          (dolist (val values idx)
 135            (setq idx (encode-uint32 val buffer idx))))
 136         ((:fixed64 :sfixed64)
 137          (dolist (val values idx)
 138            (setq idx (encode-uint64 val buffer idx))))
 139         ((:float)
 140          (dolist (val values idx)
 141            (setq idx (encode-single val buffer idx))))
 142         ((:double)
 143          (dolist (val values idx)
 144            (setq idx (encode-double val buffer idx))))))))
 145
 146 ;; Serialize 'val' of enum type 'type' into the buffer
 147 (defun serialize-enum (val enum field buffer index)
 148   "Serializes a protobufs enum value into the buffer at the given index.
 149    The value is given by 'val', the enum type by 'enum'.
 150    'field' is the protobuf-field describing the value.
 151    Modifies the buffer in place, and returns the new index into the buffer."
 152   (declare (type fixnum index)
 153            (type (simple-array (unsigned-byte 8)) buffer))
 154   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 155     (let* ((val (let ((e (find val (proto-values enum) :key #'proto-value)))
 156                   (and e (proto-index e))))
 157            (tag (ilogior $wire-type-varint (iash (proto-index field) 3)))
 158            (idx (encode-uint32 tag buffer index)))
 159       (declare (type fixnum val tag idx))
 160       (encode-uint32 val buffer idx))))
 161
 162
 163 ;;; Deserializers
 164
 165 ;; Deserialize the next object of type 'type', described by the protobuf field 'field'
 166 (defun deserialize-prim (type field buffer index)
 167   "Deserializes the next object of primitive type 'type', described by the protobuf-field 'field'.
 168    Deserializes from the byte vector 'buffer' starting at 'index'.
 169    Returns the value and and the new index into the buffer."
 170   (declare (type fixnum index)
 171            (type (simple-array (unsigned-byte 8)) buffer))
 172   (declare (ignore field))
 173   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 174     (ecase type
 175       ((:int32 :uint32)
 176        (decode-uint32 buffer index))
 177       ((:int64 :uint64)
 178        (decode-uint64 buffer index))
 179       ((:sint32)
 180        (multiple-value-bind (val idx)
 181            (decode-uint32 buffer index)
 182          (values (zig-zag-decode32 val) idx)))
 183       ((:sint64)
 184        (multiple-value-bind (val idx)
 185            (decode-uint64 buffer index)
 186          (values (zig-zag-decode64 val) idx)))
 187       ((:fixed32 :sfixed32)
 188        (decode-uint32 buffer index))
 189       ((:fixed64 :sfixed64)
 190        (decode-uint64 buffer index))
 191       ((:string)
 192        (multiple-value-bind (val idx)
 193            (decode-octets buffer index)
 194          (values (babel:octets-to-string val :encoding :utf-8) idx)))
 195       ((:bytes)
 196        (decode-octets buffer index))
 197       ((:bool)
 198        (multiple-value-bind (val idx)
 199            (decode-uint32 buffer index)
 200          (values (if (zerop val) nil t) idx)))
 201       ((:float)
 202        (decode-single buffer index))
 203       ((:double)
 204        (decode-double buffer index))
 205       ;; A few of our homegrown types
 206       ((:symbol)
 207        (multiple-value-bind (val idx)
 208            (decode-octets buffer index)
 209          (let* ((val   (babel:octets-to-string val :encoding :utf-8))
 210                 (colon (position #\: val))
 211                 (pkg   (subseq val 0 colon))
 212                 (sym   (subseq val (i+ colon 1))))
 213            (values (intern sym pkg) idx))))
 214       ((:date :time :datetime :timestamp)
 215        (decode-uint64 buffer index)))))
 216
 217 (defun deserialize-packed (type field buffer index)
 218   "Deserializes the next packed values of type 'type', described by the protobuf-field 'field'.
 219    Deserializes from the byte vector 'buffer' starting at 'index'.
 220    Returns the value and and the new index into the buffer."
 221   (declare (type fixnum index)
 222            (type (simple-array (unsigned-byte 8)) buffer))
 223   (declare (ignore field))
 224   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 225     (multiple-value-bind (len idx)
 226         (decode-uint32 buffer index)
 227       (declare (type fixnum len idx))
 228       (let ((end (i+ idx len)))
 229         (declare (type fixnum end))
 230         (with-collectors ((values collect-value))
 231           (loop
 232             (when (>= idx end)
 233               (return-from deserialize-packed (values values idx)))
 234             (multiple-value-bind (val nidx)
 235                 (ecase type
 236                   ((:int32 :uint32)
 237                    (decode-uint32 buffer idx))
 238                   ((:int64 :uint64)
 239                    (decode-uint64 buffer idx))
 240                   ((:sint32)
 241                    (multiple-value-bind (val idx)
 242                        (decode-uint32 buffer idx)
 243                      (values (zig-zag-decode32 val) idx)))
 244                   ((:sint64)
 245                    (multiple-value-bind (val idx)
 246                        (decode-uint64 buffer idx)
 247                      (values (zig-zag-decode64 val) idx)))
 248                   ((:fixed32 :sfixed32)
 249                    (decode-uint32 buffer idx))
 250                   ((:fixed64 :sfixed64)
 251                    (decode-uint64 buffer idx))
 252                   ((:float)
 253                    (decode-single buffer idx))
 254                   ((:double)
 255                    (decode-double buffer idx)))
 256               (collect-value val)
 257               (setq idx nidx))))))))
 258
 259 (defun deserialize-enum (enum field buffer index)
 260   "Deserializes the next enum of type 'type', described by the protobuf-field 'field'.
 261    Deserializes from the byte vector 'buffer' starting at 'index'.
 262    Returns the value and and the new index into the buffer."
 263   (declare (type fixnum index)
 264            (type (simple-array (unsigned-byte 8)) buffer))
 265   (declare (ignore field))
 266   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 267     (multiple-value-bind (val idx)
 268         (decode-uint32 buffer index)
 269       (let ((val (let ((e (find val (proto-values enum) :key #'proto-index)))
 270                    (and e (proto-value e)))))
 271         (values val idx)))))
 272
 273
 274 ;;; Object sizing
 275
 276 (defun prim-size (val type field)
 277   "Returns the size in bytes that the primitive object will take when serialized."
 278   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 279     (ecase type
 280       ((:int32 :uint32)
 281        (let ((tag (ilogior $wire-type-varint (iash (proto-index field) 3))))
 282          (i+ (length32 tag) (length32 val))))
 283       ((:int64 :uint64)
 284        (let ((tag (ilogior $wire-type-varint (iash (proto-index field) 3))))
 285          (i+ (length32 tag) (length64 val))))
 286       ((:sint32)
 287        (let ((tag (ilogior $wire-type-varint (iash (proto-index field) 3))))
 288          (i+ (length32 tag) (length32 (zig-zag-encode32 val)))))
 289       ((:sint64)
 290        (let ((tag (ilogior $wire-type-varint (iash (proto-index field) 3))))
 291          (i+ (length32 tag) (length64 (zig-zag-encode64 val)))))
 292       ((:fixed32 :sfixed32)
 293        (let ((tag (ilogior $wire-type-32bit (iash (proto-index field) 3))))
 294          (i+ (length32 tag) 4)))
 295       ((:fixed64 :sfixed64)
 296        (let ((tag (ilogior $wire-type-64bit (iash (proto-index field) 3))))
 297          (i+ (length32 tag) 8)))
 298       ((:string)
 299        (let ((tag (ilogior $wire-type-string (iash (proto-index field) 3)))
 300              (len (babel:string-size-in-octets val :encoding :utf-8)))
 301          (i+ (length32 tag) (length32 len) len)))
 302       ((:bytes)
 303        (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 304          (let ((tag (ilogior $wire-type-string (iash (proto-index field) 3)))
 305                (len (length val)))
 306            (i+ (length32 tag) (length32 len) len))))
 307       ((:bool)
 308        (let ((tag (ilogior $wire-type-varint (iash (proto-index field) 3))))
 309          (i+ (length32 tag) 1)))
 310       ((:float)
 311        (let ((tag (ilogior $wire-type-32bit (iash (proto-index field) 3))))
 312          (i+ (length32 tag) 4)))
 313       ((:double)
 314        (let ((tag (ilogior $wire-type-64bit (iash (proto-index field) 3))))
 315          (i+ (length32 tag) 8)))
 316       ;; A few of our homegrown types
 317       ((:symbol)
 318        (let* ((tag (ilogior $wire-type-string (iash (proto-index field) 3)))
 319               (len (i+ (length (package-name (symbol-package val))) 1 (length (symbol-name val)))))
 320          (i+ (length32 tag) (length32 len) len)))
 321       ((:date :time :datetime :timestamp)
 322        (let ((tag (ilogior $wire-type-64bit (iash (proto-index field) 3))))
 323          (i+ (length32 tag) 8))))))
 324
 325 (defun packed-size (values type field)
 326   "Returns the size in bytes that the packed object will take when serialized."
 327   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 328     (let ((tag (ilogior $wire-type-varint (iash (proto-index field) 3)))
 329           (len (loop for val in values
 330                      summing (ecase type
 331                                ((:int32 :uint32) (length32 val))
 332                                ((:int64 :uint64) (length64 val))
 333                                ((:sint32) (length32 (zig-zag-encode32 val)))
 334                                ((:sint64) (length64 (zig-zag-encode64 val)))
 335                                ((:fixed32 :sfixed32) 4)
 336                                ((:fixed64 :sfixed64) 8)
 337                                ((:float) 4)
 338                                ((:double) 8)))))
 339       (declare (type fixnum tag len))
 340       ;; Two value: the full size of the packed object, and the size
 341       ;; of just the payload
 342       (values (i+ (length32 tag) (length32 len) len) len))))
 343
 344 (defun enum-size (val enum field)
 345   "Returns the size in bytes that the enum object will take when serialized."
 346   (let ((val (let ((e (find val (proto-values enum) :key #'proto-value)))
 347                (and e (proto-index e))))
 348         (tag (ilogior $wire-type-varint (iash (proto-index field) 3))))
 349     (i+ (length32 tag) (length32 val))))
 350
 351
 352 ;;; Raw encoders
 353
 354 (defun encode-uint32 (val buffer index)
 355   "Encodes the 32-bit integer 'val' into the buffer at the given index.
 356    Modifies the buffer, and returns the new index into the buffer."
 357   (declare (type fixnum index)
 358            (type (simple-array (unsigned-byte 8)) buffer))
 359   (assert (< val #.(ash 1 32)) ()
 360           "The value ~D is longer than 32 bits" val)
 361   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 362     ;; Seven bits at a time, least significant bits first
 363     (loop do (let ((bits (ldb #.(byte 7 0) val)))
 364                (declare (type fixnum bits))
 365                (setq val (ash val -7))
 366                (setf (aref buffer index) (ilogior bits (if (zerop val) 0 128)))
 367                (iincf index))
 368           until (zerop val)))
 369   (values index buffer))                        ;return the buffer to improve 'trace'
 370
 371 (defun encode-uint64 (val buffer index)
 372   "Encodes the 64-bit integer 'val' into the buffer at the given index.
 373    Modifies the buffer, and returns the new index into the buffer."
 374   (declare (type fixnum index)
 375            (type (simple-array (unsigned-byte 8)) buffer))
 376   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 377     (loop do (let ((bits (ldb #.(byte 7 0) val)))
 378                (declare (type fixnum bits))
 379                (setq val (ash val -7))
 380                (setf (aref buffer index) (ilogior bits (if (zerop val) 0 128)))
 381                (iincf index))
 382           until (zerop val)))
 383   (values index buffer))
 384
 385 (defun encode-single (val buffer index)
 386   "Encodes the single float 'val' into the buffer at the given index.
 387    Modifies the buffer, and returns the new index into the buffer."
 388   (declare (type fixnum index)
 389            (type (simple-array (unsigned-byte 8)) buffer))
 390   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 391     ;;---*** DO ENCODING OF SINGLE FLOATS
 392     val buffer index))
 393
 394 (defun encode-double (val buffer index)
 395   "Encodes the double float 'val' into the buffer at the given index.
 396    Modifies the buffer, and returns the new index into the buffer."
 397   (declare (type fixnum index)
 398            (type (simple-array (unsigned-byte 8)) buffer))
 399   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 400     ;;---*** DO ENCODING OF DOUBLE FLOATS
 401     val buffer index))
 402
 403 (defun encode-octets (octets buffer index)
 404   "Encodes the octets into the buffer at the given index.
 405    Modifies the buffer, and returns the new index into the buffer."
 406   (declare (type fixnum index)
 407            (type (simple-array (unsigned-byte 8)) buffer))
 408   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 409     (let* ((len (length octets))
 410            (idx (encode-uint32 len buffer index)))
 411       (declare (type fixnum len idx))
 412       (replace buffer octets :start1 idx)
 413       (values (i+ idx len) buffer))))
 414
 415 (defun zig-zag-encode32 (val)
 416   (assert (< (integer-length val) 32))
 417   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 418     (logxor (ash val 1) (ash val -31))))
 419
 420 (defun zig-zag-encode64 (val)
 421   (assert (< (integer-length val) 64))
 422   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 423     (logxor (ash val 1) (ash val -63))))
 424
 425
 426 ;;; Raw decoders
 427
 428 ;; Decode the value from the buffer at the given index,
 429 ;; then return the value and new index into the buffer
 430 (defun decode-uint32 (buffer index)
 431   "Decodes the next 32-bit integer in the buffer at the given index.
 432    Returns both the decoded value and the new index into the buffer."
 433   (declare (type fixnum index)
 434            (type (simple-array (unsigned-byte 8)) buffer))
 435   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 436     ;; Seven bits at a time, least significant bits first
 437     (loop with val fixnum = 0
 438           for places fixnum upfrom 0 by 7
 439           for byte fixnum = (prog1 (aref buffer index) (iincf index))
 440           do (setq val (ilogior val (ash (ldb #.(byte 7 0) byte) places)))
 441           until (i< byte 128)
 442           finally (progn
 443                     (assert (< val #.(ash 1 32)) ()
 444                             "The value ~D is longer than 32 bits" val)
 445                     (return (values val index))))))
 446
 447 (defun decode-uint64 (buffer index)
 448   "Decodes the next 64-bit integer in the buffer at the given index.
 449    Returns both the decoded value and the new index into the buffer."
 450   (declare (type fixnum index)
 451            (type (simple-array (unsigned-byte 8)) buffer))
 452   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 453     ;; Seven bits at a time, least significant bits first
 454     (loop with val fixnum = 0
 455           for places fixnum upfrom 0 by 7
 456           for byte fixnum = (prog1 (aref buffer index) (iincf index))
 457           do (setq val (ilogior val (ash (ldb #.(byte 7 0) byte) places)))
 458           until (i< byte 128)
 459           finally (return (values val index)))))
 460
 461 (defun decode-single (buffer index)
 462   "Decodes the next single float in the buffer at the given index.
 463    Returns both the decoded value and the new index into the buffer."
 464   (declare (type fixnum index)
 465            (type (simple-array (unsigned-byte 8)) buffer))
 466   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 467     ;;---*** DO DECODING OF SINGLE FLOATS
 468     buffer index))
 469
 470 (defun decode-double (buffer index)
 471   "Decodes the next double float in the buffer at the given index.
 472    Returns both the decoded value and the new index into the buffer."
 473   (declare (type fixnum index)
 474            (type (simple-array (unsigned-byte 8)) buffer))
 475   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 476     ;;---*** DO DECODING OF DOUBLE FLOATS
 477     buffer index))
 478
 479 (defun decode-octets (buffer index)
 480   "Decodes the next octets in the buffer at the given index.
 481    Returns both the decoded value and the new index into the buffer."
 482   (declare (type fixnum index)
 483            (type (simple-array (unsigned-byte 8)) buffer))
 484   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 485     (multiple-value-bind (len idx)
 486         (decode-uint32 buffer index)
 487       (declare (type fixnum len idx))
 488       (values (subseq buffer idx (i+ idx len)) (i+ idx len)))))
 489
 490 (defun zig-zag-decode32 (val)
 491   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 492     (logxor (ash val -1) (- (logand val 1)))))
 493
 494 (defun zig-zag-decode64 (val)
 495   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 496     (logxor (ash val -1) (- (logand val 1)))))
 497
 498
 499 ;;; Raw lengths
 500
 501 (defun length32 (val)
 502   "Returns the length that 'val' will take when encoded as a 32-bit integer."
 503   (assert (< val #.(ash 1 32)) ()
 504           "The value ~D is longer than 32 bits" val)
 505   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 506     (let ((size 0))
 507       (declare (type fixnum size))
 508       (loop do (progn
 509                  (setq val (ash val -7))
 510                  (iincf size))
 511             until (zerop val))
 512       size)))
 513
 514 (defun length64 (val)
 515   "Returns the length that 'val' will take when encoded as a 64-bit integer."
 516   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 517     (let ((size 0))
 518       (declare (type fixnum size))
 519       (loop do (progn
 520                  (setq val (ash val -7))
 521                  (iincf size))
 522             until (zerop val))
 523       size)))