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 ;;; Utilities
  17
  18 (eval-when (:compile-toplevel :load-toplevel :execute)
  19
  20 (defconstant $wire-type-varint 0)
  21 (defconstant $wire-type-64bit  1)
  22 (defconstant $wire-type-string 2)
  23 (defconstant $wire-type-start-group 3)          ;supposedly obsolete
  24 (defconstant $wire-type-end-group   4)          ;supposedly obsolete
  25 (defconstant $wire-type-32bit  5)
  26
  27 )       ;eval-when
  28
  29
  30 (defun make-tag (type index)
  31   "Given a wire type or the name of a Protobufs type and a field index,
  32    return the tag that encodes both of them."
  33   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
  34     (if (typep type 'fixnum)
  35       (ilogior type (iash index 3))
  36       (let ((type (ecase type
  37                     ((:int32 :uint32) $wire-type-varint)
  38                     ((:int64 :uint64) $wire-type-varint)
  39                     ((:sint32 :sint64) $wire-type-varint)
  40                     ((:fixed32 :sfixed32) $wire-type-32bit)
  41                     ((:fixed64 :sfixed64) $wire-type-64bit)
  42                     ((:string :bytes) $wire-type-string)
  43                     ((:bool) $wire-type-varint)
  44                     ((:float) $wire-type-32bit)
  45                     ((:double) $wire-type-64bit)
  46                     ;; A few of our homegrown types
  47                     ((:symbol) $wire-type-string)
  48                     ((:date :time :datetime :timestamp) $wire-type-64bit))))
  49         (ilogior type (iash index 3))))))
  50
  51 (define-compiler-macro make-tag (&whole form type index)
  52   (setq type (fold-symbol type))
  53   (cond ((typep type 'fixnum)
  54          `(ilogior ,type (iash ,index 3)))
  55         ((keywordp type)
  56          (let ((type (ecase type
  57                        ((:int32 :uint32) $wire-type-varint)
  58                        ((:int64 :uint64) $wire-type-varint)
  59                        ((:sint32 :sint64) $wire-type-varint)
  60                        ((:fixed32 :sfixed32) $wire-type-32bit)
  61                        ((:fixed64 :sfixed64) $wire-type-64bit)
  62                        ((:string :bytes) $wire-type-string)
  63                        ((:bool) $wire-type-varint)
  64                        ((:float) $wire-type-32bit)
  65                        ((:double) $wire-type-64bit)
  66                        ;; A few of our homegrown types
  67                        ((:symbol) $wire-type-string)
  68                        ((:date :time :datetime :timestamp) $wire-type-64bit))))
  69            `(ilogior ,type (iash ,index 3))))
  70         (t form)))
  71
  72 (defun fold-symbol (x)
  73   "Given an expression 'x', constant-fold it until it can be foleded no more."
  74   (let ((last '#:last))
  75     (loop
  76       (cond ((eq x last) (return x))
  77             ((and (listp x)
  78                   (eq (first x) 'quote)
  79                   (constantp (second x)))
  80              (shiftf last x (second x)))
  81             ((and (symbolp x)
  82                   (boundp x))
  83              (shiftf last x (symbol-value x)))
  84             (t (return x))))))
  85
  86
  87 (defun zig-zag-encode32 (val)
  88   (declare (optimize (speed 3) (safety 0) (debug 0)))
  89   (declare (type (signed-byte 32) val))
  90   (logxor (ash val 1) (ash val -31)))
  91
  92 (defun zig-zag-encode64 (val)
  93   (declare (optimize (speed 3) (safety 0) (debug 0)))
  94   (declare (type (signed-byte 64) val))
  95   (logxor (ash val 1) (ash val -63)))
  96
  97 (define-compiler-macro zig-zag-encode32 (&whole form val)
  98   (if (atom val)
  99     `(locally (declare (optimize (speed 3) (safety 0) (debug 0))
 100                        (type (signed-byte 32) ,val))
 101        (logxor (ash ,val 1) (ash ,val -31)))
 102     form))
 103
 104 (define-compiler-macro zig-zag-encode64 (&whole form val)
 105   (if (atom val)
 106     `(locally (declare (optimize (speed 3) (safety 0) (debug 0))
 107                        (type (signed-byte 64) ,val))
 108        (logxor (ash ,val 1) (ash ,val -63)))
 109     form))
 110
 111 (defun zig-zag-decode32 (val)
 112   (declare (optimize (speed 3) (safety 0) (debug 0)))
 113   (logxor (ash val -1) (- (logand val 1))))
 114
 115 (defun zig-zag-decode64 (val)
 116   (declare (optimize (speed 3) (safety 0) (debug 0)))
 117   (logxor (ash val -1) (- (logand val 1))))
 118
 119 (define-compiler-macro zig-zag-decode32 (&whole form val)
 120   (if (atom val)
 121     `(locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 122        (logxor (ash ,val -1) (- (logand ,val 1))))
 123     form))
 124
 125 (define-compiler-macro zig-zag-decode64 (&whole form val)
 126   (if (atom val)
 127     `(locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 128        (logxor (ash ,val -1) (- (logand ,val 1))))
 129     form))
 130
 131
 132 ;;; Serializers
 133
 134 ;; Serialize 'val' of primitive type 'type' into the buffer
 135 (defun serialize-prim (val type tag buffer index)
 136   "Serializes a Protobufs primitive (scalar) value into the buffer at the given index.
 137    The value is given by 'val', the primitive type by 'type'.
 138    Modifies the buffer in place, and returns the new index into the buffer.
 139    Watch out, this function turns off most type checking and all array bounds checking."
 140   (declare (type (simple-array (unsigned-byte 8)) buffer)
 141            (type (unsigned-byte 32) tag)
 142            (type fixnum index))
 143   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 144     (let ((idx (encode-uint32 tag buffer index)))
 145       (declare (type fixnum idx))
 146       (ecase type
 147         ((:int32 :uint32)
 148          (encode-uint32 (ldb (byte 32 0) val) buffer idx))
 149         ((:int64 :uint64)
 150          (encode-uint64 (ldb (byte 64 0) val) buffer idx))
 151         ((:sint32)
 152          (encode-uint32 (zig-zag-encode32 val) buffer idx))
 153         ((:sint64)
 154          (encode-uint64 (zig-zag-encode64 val) buffer idx))
 155         ((:fixed32)
 156          (encode-fixed32 val buffer idx))
 157         ((:sfixed32)
 158          (encode-sfixed32 val buffer idx))
 159         ((:fixed64)
 160          (encode-fixed64 val buffer idx))
 161         ((:sfixed64)
 162          (encode-sfixed64 val buffer idx))
 163         ((:string)
 164          (encode-string val buffer idx))
 165         ((:bytes)
 166          (encode-octets val buffer idx))
 167         ((:bool)
 168          (encode-uint32 (if val 1 0) buffer idx))
 169         ((:float)
 170          (encode-single val buffer idx))
 171         ((:double)
 172          (encode-double val buffer idx))
 173         ;; A few of our homegrown types
 174         ((:symbol)
 175          (let ((val (if (keywordp val)
 176                       (string val)
 177                       ;; Non-keyword symbols are consy, avoid them if possible
 178                       (format nil "~A:~A" (package-name (symbol-package val)) (symbol-name val)))))
 179            (encode-string val buffer idx)))
 180         ((:date :time :datetime :timestamp)
 181          (encode-uint64 (ldb (byte 64 0) val) buffer idx))))))
 182
 183 (define-compiler-macro serialize-prim (&whole form val type tag buffer index)
 184   (setq type (fold-symbol type)
 185         tag  (fold-symbol tag))
 186   (if (member type '(:int32 :uint32 :int64 :uint64 :sint32 :sint64
 187                      :fixed32 :sfixed32 :fixed64 :sfixed64
 188                      :string :bytes :bool :float :double))
 189     `(locally (declare (optimize (speed 3) (safety 0) (debug 0))
 190                        (type (simple-array (unsigned-byte 8)) ,buffer)
 191                        ;; 'tag' is a constant, no need to declare its type
 192                        (type fixnum ,index))
 193        (let ((idx (encode-uint32 ,tag ,buffer ,index)))
 194          (declare (type fixnum idx))
 195          ,(ecase type
 196             ((:int32 )
 197              `(encode-uint32 (ldb (byte 32 0) ,val) ,buffer idx))
 198             ((:int64)
 199              `(encode-uint64 (ldb (byte 64 0) ,val) ,buffer idx))
 200             ((:uint32)
 201              `(encode-uint32 ,val ,buffer idx))
 202             ((:uint64)
 203              `(encode-uint64 ,val ,buffer idx))
 204             ((:sint32)
 205              `(encode-uint32 (zig-zag-encode32 ,val) ,buffer idx))
 206             ((:sint64)
 207              `(encode-uint64 (zig-zag-encode64 ,val) ,buffer idx))
 208             ((:fixed32)
 209              `(encode-fixed32 ,val ,buffer idx))
 210             ((:sfixed32)
 211              `(encode-sfixed32 ,val ,buffer idx))
 212             ((:fixed64)
 213              `(encode-fixed64 ,val ,buffer idx))
 214             ((:sfixed64)
 215              `(encode-sfixed64 ,val ,buffer idx))
 216             ((:string)
 217              `(encode-string ,val ,buffer idx))
 218             ((:bytes)
 219              `(encode-octets ,val ,buffer idx))
 220             ((:bool)
 221              `(encode-uint32 (if ,val 1 0) ,buffer idx))
 222             ((:float)
 223              `(encode-single ,val ,buffer idx))
 224             ((:double)
 225              `(encode-double ,val ,buffer idx)))))
 226     form))
 227
 228 (defun serialize-packed (values type tag buffer index)
 229   "Serializes a set of packed values into the buffer at the given index.
 230    The values are given by 'values', the primitive type by 'type'.
 231    Modifies the buffer in place, and returns the new index into the buffer.
 232    Watch out, this function turns off most type checking and all array bounds checking."
 233   (declare (type (simple-array (unsigned-byte 8)) buffer)
 234            (type (unsigned-byte 32) tag)
 235            (type fixnum index))
 236   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 237     (let ((idx (encode-uint32 tag buffer index)))
 238       (declare (type fixnum idx))
 239       (multiple-value-bind (full-len len)
 240           (packed-size values type tag)
 241         (declare (type fixnum len) (ignore full-len))
 242         (setq idx (encode-uint32 len buffer idx)))
 243       (ecase type
 244         ((:int32 :uint32)
 245          (dolist (val values idx)
 246            (setq idx (encode-uint32 (ldb (byte 32 0) val) buffer idx))))
 247         ((:int64 :uint64)
 248          (dolist (val values idx)
 249            (setq idx (encode-uint64 (ldb (byte 64 0) val) buffer idx))))
 250         ((:sint32)
 251          (dolist (val values idx)
 252            (setq idx (encode-uint32 (zig-zag-encode32 val) buffer idx))))
 253         ((:sint64)
 254          (dolist (val values idx)
 255            (setq idx (encode-uint64 (zig-zag-encode64 val) buffer idx))))
 256         ((:fixed32)
 257          (dolist (val values idx)
 258            (setq idx (encode-fixed32 val buffer idx))))
 259         ((:sfixed32)
 260          (dolist (val values idx)
 261            (setq idx (encode-sfixed32 val buffer idx))))
 262         ((:fixed64)
 263          (dolist (val values idx)
 264            (setq idx (encode-fixed64 val buffer idx))))
 265         ((:sfixed64)
 266          (dolist (val values idx)
 267            (setq idx (encode-sfixed64 val buffer idx))))
 268         ((:float)
 269          (dolist (val values idx)
 270            (setq idx (encode-single val buffer idx))))
 271         ((:double)
 272          (dolist (val values idx)
 273            (setq idx (encode-double val buffer idx))))))))
 274
 275 (define-compiler-macro serialize-packed (&whole form values type tag buffer index)
 276   (setq type (fold-symbol type)
 277         tag  (fold-symbol tag))
 278   (if (member type '(:int32 :uint32 :int64 :uint64 :sint32 :sint64
 279                      :fixed32 :sfixed32 :fixed64 :sfixed64
 280                      :float :double))
 281     `(locally (declare (optimize (speed 3) (safety 0) (debug 0))
 282                        (type (simple-array (unsigned-byte 8)) ,buffer)
 283                        ;; 'tag' is a constant, no need to declare its type
 284                        (type fixnum ,index))
 285        (let ((idx (encode-uint32 ,tag ,buffer ,index)))
 286          (declare (type fixnum idx))
 287          (multiple-value-bind (full-len len)
 288              (packed-size ,values ,type ,tag)
 289            (declare (type fixnum len) (ignore full-len))
 290            (setq idx (encode-uint32 len ,buffer idx)))
 291          (dolist (val ,values idx)
 292            ,(ecase type
 293               ((:int32)
 294                `(setq idx (encode-uint32 (ldb (byte 32 0) val) ,buffer idx)))
 295               ((:int64)
 296                `(setq idx (encode-uint64 (ldb (byte 64 0) val) ,buffer idx)))
 297               ((:uint32)
 298                `(setq idx (encode-uint32 val ,buffer idx)))
 299               ((:uint64)
 300                `(setq idx (encode-uint64 val ,buffer idx)))
 301               ((:sint32)
 302                `(setq idx (encode-uint32 (zig-zag-encode32 val) ,buffer idx)))
 303               ((:sint64)
 304                `(setq idx (encode-uint64 (zig-zag-encode64 val) ,buffer idx)))
 305               ((:fixed32)
 306                `(setq idx (encode-fixed32 val ,buffer idx)))
 307               ((:sfixed32)
 308                `(setq idx (encode-sfixed32 val ,buffer idx)))
 309               ((:fixed64)
 310                `(setq idx (encode-fixed64 val ,buffer idx)))
 311               ((:sfixed64)
 312                `(setq idx (encode-sfixed64 val ,buffer idx)))
 313               ((:float)
 314                `(setq idx (encode-single val ,buffer idx)))
 315               ((:double)
 316                `(setq idx (encode-double val ,buffer idx)))))))
 317     form))
 318
 319 (defun serialize-enum (val values tag buffer index)
 320   "Serializes a Protobufs enum value into the buffer at the given index.
 321    The value is given by 'val', the enum values are in 'values'.
 322    Modifies the buffer in place, and returns the new index into the buffer.
 323    Watch out, this function turns off most type checking and all array bounds checking."
 324   (declare (type (simple-array (unsigned-byte 8)) buffer)
 325            (type (unsigned-byte 32) tag)
 326            (type fixnum index))
 327   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 328     (let* ((val (let ((e (find val values :key #'proto-value)))
 329                   (and e (proto-index e))))
 330            (idx (encode-uint32 tag buffer index)))
 331       (declare (type (unsigned-byte 32) val)
 332                (type fixnum idx))
 333       (encode-uint32 (ldb (byte 32 0) val) buffer idx))))
 334
 335
 336 ;;; Deserializers
 337
 338 ;; Deserialize the next object of type 'type'
 339 (defun deserialize-prim (type buffer index)
 340   "Deserializes the next object of primitive type 'type'.
 341    Deserializes from the byte vector 'buffer' starting at 'index'.
 342    Returns the value and and the new index into the buffer.
 343    Watch out, this function turns off most type checking and all array bounds checking."
 344   (declare (type (simple-array (unsigned-byte 8)) buffer)
 345            (type fixnum index))
 346   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 347     (ecase type
 348       ((:int32)
 349        (decode-int32 buffer index))
 350       ((:int64)
 351        (decode-int64 buffer index))
 352       ((:uint32)
 353        (decode-uint32 buffer index))
 354       ((:uint64)
 355        (decode-uint64 buffer index))
 356       ((:sint32)
 357        (multiple-value-bind (val idx)
 358            (decode-uint32 buffer index)
 359          (values (zig-zag-decode32 val) idx)))
 360       ((:sint64)
 361        (multiple-value-bind (val idx)
 362            (decode-uint64 buffer index)
 363          (values (zig-zag-decode64 val) idx)))
 364       ((:fixed32)
 365        (decode-fixed32 buffer index))
 366       ((:sfixed32)
 367        (decode-sfixed32 buffer index))
 368       ((:fixed64)
 369        (decode-fixed64 buffer index))
 370       ((:sfixed64)
 371        (decode-sfixed64 buffer index))
 372       ((:string)
 373        (decode-string buffer index))
 374       ((:bytes)
 375        (decode-octets buffer index))
 376       ((:bool)
 377        (multiple-value-bind (val idx)
 378            (decode-uint32 buffer index)
 379          (values (if (i= val 0) nil t) idx)))
 380       ((:float)
 381        (decode-single buffer index))
 382       ((:double)
 383        (decode-double buffer index))
 384       ;; A few of our homegrown types
 385       ((:symbol)
 386        ;; Note that this is consy, avoid it if possible
 387        (multiple-value-bind (val idx)
 388            (decode-string buffer index)
 389          (values (make-lisp-symbol val) idx)))
 390       ((:date :time :datetime :timestamp)
 391        (decode-uint64 buffer index)))))
 392
 393 (define-compiler-macro deserialize-prim (&whole form type buffer index)
 394   (setq type (fold-symbol type))
 395   (if (member type '(:int32 :uint32 :int64 :uint64 :sint32 :sint64
 396                      :fixed32 :sfixed32 :fixed64 :sfixed64
 397                      :string :bytes :bool :float :double))
 398     `(locally (declare (optimize (speed 3) (safety 0) (debug 0))
 399                        (type (simple-array (unsigned-byte 8)) ,buffer)
 400                        (type fixnum ,index))
 401        ,(ecase type
 402           ((:int32)
 403            `(decode-int32 ,buffer ,index))
 404           ((:int64)
 405            `(decode-int64 ,buffer ,index))
 406           ((:uint32)
 407            `(decode-uint32 ,buffer ,index))
 408           ((:uint64)
 409            `(decode-uint64 ,buffer ,index))
 410           ((:sint32)
 411            `(multiple-value-bind (val idx)
 412                 (decode-uint32 ,buffer ,index)
 413               (values (zig-zag-decode32 val) idx)))
 414           ((:sint64)
 415            `(multiple-value-bind (val idx)
 416                (decode-uint64 ,buffer ,index)
 417              (values (zig-zag-decode64 val) idx)))
 418           ((:fixed32)
 419            `(decode-fixed32 ,buffer ,index))
 420           ((:sfixed32)
 421            `(decode-sfixed32 ,buffer ,index))
 422           ((:fixed64)
 423            `(decode-fixed64 ,buffer ,index))
 424           ((:sfixed64)
 425            `(decode-sfixed64 ,buffer ,index))
 426           ((:string)
 427            `(decode-string ,buffer ,index))
 428           ((:bytes)
 429            `(decode-octets ,buffer ,index))
 430           ((:bool)
 431            `(multiple-value-bind (val idx)
 432                 (decode-uint32 ,buffer ,index)
 433               (values (if (i= val 0) nil t) idx)))
 434           ((:float)
 435            `(decode-single ,buffer ,index))
 436           ((:double)
 437            `(decode-double ,buffer ,index))))
 438     form))
 439
 440 (defun deserialize-packed (type buffer index)
 441   "Deserializes the next packed values of type 'type'.
 442    Deserializes from the byte vector 'buffer' starting at 'index'.
 443    Returns the value and and the new index into the buffer.
 444    Watch out, this function turns off most type checking and all array bounds checking."
 445   (declare (type (simple-array (unsigned-byte 8)) buffer)
 446            (type fixnum index))
 447   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 448     (multiple-value-bind (len idx)
 449         (decode-uint32 buffer index)
 450       (declare (type (unsigned-byte 32) len)
 451                (type fixnum idx))
 452       (let ((end (i+ idx len)))
 453         (declare (type (unsigned-byte 32) end))
 454         (with-collectors ((values collect-value))
 455           (loop
 456             (when (>= idx end)
 457               (return-from deserialize-packed (values values idx)))
 458             (multiple-value-bind (val nidx)
 459                 (ecase type
 460                   ((:int32)
 461                    (decode-int32 buffer idx))
 462                   ((:int64)
 463                    (decode-int64 buffer idx))
 464                   ((:uint32)
 465                    (decode-uint32 buffer idx))
 466                   ((:uint64)
 467                    (decode-uint64 buffer idx))
 468                   ((:sint32)
 469                    (multiple-value-bind (val idx)
 470                        (decode-uint32 buffer idx)
 471                      (values (zig-zag-decode32 val) idx)))
 472                   ((:sint64)
 473                    (multiple-value-bind (val idx)
 474                        (decode-uint64 buffer idx)
 475                      (values (zig-zag-decode64 val) idx)))
 476                   ((:fixed32)
 477                    (decode-fixed32 buffer idx))
 478                   ((:sfixed32)
 479                    (decode-sfixed32 buffer idx))
 480                   ((:fixed64)
 481                    (decode-fixed64 buffer idx))
 482                   ((:sfixed64)
 483                    (decode-sfixed64 buffer idx))
 484                   ((:float)
 485                    (decode-single buffer idx))
 486                   ((:double)
 487                    (decode-double buffer idx)))
 488               (collect-value val)
 489               (setq idx nidx))))))))
 490
 491 (define-compiler-macro deserialize-packed (&whole form type buffer index)
 492   (setq type (fold-symbol type))
 493   (if (member type '(:int32 :uint32 :int64 :uint64 :sint32 :sint64
 494                      :fixed32 :sfixed32 :fixed64 :sfixed64
 495                      :float :double))
 496     `(locally (declare (optimize (speed 3) (safety 0) (debug 0))
 497                        (type (simple-array (unsigned-byte 8)) ,buffer)
 498                        (type fixnum ,index))
 499        (block deserialize-packed
 500          (multiple-value-bind (len idx)
 501              (decode-uint32 ,buffer ,index)
 502            (declare (type (unsigned-byte 32) len)
 503                     (type fixnum idx))
 504            (let ((end (i+ idx len)))
 505              (declare (type (unsigned-byte 32) end))
 506              (with-collectors ((values collect-value))
 507                (loop
 508                  (when (>= idx end)
 509                    (return-from deserialize-packed (values values idx)))
 510                  (multiple-value-bind (val nidx)
 511                      ,(ecase type
 512                         ((:int32)
 513                          `(decode-int32 ,buffer idx))
 514                         ((:int64)
 515                          `(decode-int64 ,buffer idx))
 516                         ((:uint32)
 517                          `(decode-uint32 ,buffer idx))
 518                         ((:uint64)
 519                          `(decode-uint64 ,buffer idx))
 520                         ((:sint32)
 521                          `(multiple-value-bind (val idx)
 522                               (decode-uint32 ,buffer idx)
 523                             (values (zig-zag-decode32 val) idx)))
 524                         ((:sint64)
 525                          `(multiple-value-bind (val idx)
 526                               (decode-uint64 ,buffer idx)
 527                             (values (zig-zag-decode64 val) idx)))
 528                         ((:fixed32)
 529                          `(decode-fixed32 ,buffer idx))
 530                         ((:sfixed32)
 531                          `(decode-sfixed32 ,buffer idx))
 532                         ((:fixed64)
 533                          `(decode-fixed64 ,buffer idx))
 534                         ((:sfixed64)
 535                          `(decode-sfixed64 ,buffer idx))
 536                         ((:float)
 537                          `(decode-single ,buffer idx))
 538                         ((:double)
 539                          `(decode-double ,buffer idx)))
 540                    (collect-value val)
 541                    (setq idx nidx))))))))
 542     form))
 543
 544 (defun deserialize-enum (values buffer index)
 545   "Deserializes the next enum value take from 'values'.
 546    Deserializes from the byte vector 'buffer' starting at 'index'.
 547    Returns the value and and the new index into the buffer.
 548    Watch out, this function turns off most type checking and all array bounds checking."
 549   (declare (type (simple-array (unsigned-byte 8)) buffer)
 550            (type fixnum index))
 551   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 552     (multiple-value-bind (val idx)
 553         (decode-int32 buffer index)
 554       (let ((val (let ((e (find val values :key #'proto-index)))
 555                    (and e (proto-value e)))))
 556         (values val idx)))))
 557
 558
 559 ;;; Object sizing
 560
 561 (defun prim-size (val type tag)
 562   "Returns the size in bytes that the primitive object will take when serialized.
 563    Watch out, this function turns off most type checking."
 564   (declare (type (unsigned-byte 32) tag))
 565   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 566     (ecase type
 567       ((:int32 :uint32)
 568        (i+ (length32 tag) (length32 (ldb (byte 32 0) val))))
 569       ((:int64 :uint64)
 570        (i+ (length32 tag) (length64 (ldb (byte 64 0) val))))
 571       ((:sint32)
 572        (i+ (length32 tag) (length32 (zig-zag-encode32 val))))
 573       ((:sint64)
 574        (i+ (length32 tag) (length64 (zig-zag-encode64 val))))
 575       ((:fixed32 :sfixed32)
 576        (i+ (length32 tag) 4))
 577       ((:fixed64 :sfixed64)
 578        (i+ (length32 tag) 8))
 579       ((:string)
 580        (let ((len (babel:string-size-in-octets val :encoding :utf-8)))
 581          (i+ (length32 tag) (length32 len) len)))
 582       ((:bytes)
 583        (let ((len (length val)))
 584          (i+ (length32 tag) (length32 len) len)))
 585       ((:bool)
 586        (i+ (length32 tag) 1))
 587       ((:float)
 588        (i+ (length32 tag) 4))
 589       ((:double)
 590        (i+ (length32 tag) 8))
 591       ;; A few of our homegrown types
 592       ((:symbol)
 593        (let ((len (if (keywordp val)
 594                     (length (symbol-name val))
 595                     (i+ (length (package-name (symbol-package val))) 1 (length (symbol-name val))))))
 596          (i+ (length32 tag) (length32 len) len)))
 597       ((:date :time :datetime :timestamp)
 598        (i+ (length32 tag) 8)))))
 599
 600 (define-compiler-macro prim-size (&whole form val type tag)
 601   (setq type (fold-symbol type)
 602         tag  (fold-symbol tag))
 603   (if (member type '(:int32 :uint32 :int64 :uint64 :sint32 :sint64
 604                      :fixed32 :sfixed32 :fixed64 :sfixed64
 605                      :string :bytes :bool :float :double))
 606     `(locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 607        ,(ecase type
 608           ((:int32)
 609            `(i+ (length32 ,tag) (length32 (ldb (byte 32 0) ,val))))
 610           ((:int64)
 611            `(i+ (length32 ,tag) (length64 (ldb (byte 64 0) ,val))))
 612           ((:uint32)
 613            `(i+ (length32 ,tag) (length32 ,val)))
 614           ((:uint64)
 615            `(i+ (length32 ,tag) (length64 ,val)))
 616           ((:sint32)
 617            `(i+ (length32 ,tag) (length32 (zig-zag-encode32 ,val))))
 618           ((:sint64)
 619            `(i+ (length32 ,tag) (length64 (zig-zag-encode64 ,val))))
 620           ((:fixed32 :sfixed32)
 621            `(i+ (length32 ,tag) 4))
 622           ((:fixed64 :sfixed64)
 623            `(i+ (length32 ,tag) 8))
 624           ((:string)
 625            `(let ((len (babel:string-size-in-octets ,val :encoding :utf-8)))
 626               (i+ (length32 ,tag) (length32 len) len)))
 627           ((:bytes)
 628            `(let ((len (length ,val)))
 629               (i+ (length32 ,tag) (length32 len) len)))
 630           ((:bool)
 631            `(i+ (length32 ,tag) 1))
 632           ((:float)
 633            `(i+ (length32 ,tag) 4))
 634           ((:double)
 635            `(i+ (length32 ,tag) 8))))
 636     form))
 637
 638 (defun packed-size (values type tag)
 639   "Returns the size in bytes that the packed object will take when serialized.
 640    Watch out, this function turns off most type checking."
 641   (declare (type (unsigned-byte 32) tag))
 642   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 643     (let ((len (let ((len 0))
 644                  (declare (type fixnum len))
 645                  (dolist (val values len)
 646                    (iincf len (ecase type
 647                                 ((:int32 :uint32) (length32 (ldb (byte 32 0) val)))
 648                                 ((:int64 :uint64) (length64 (ldb (byte 64 0) val)))
 649                                 ((:sint32) (length32 (zig-zag-encode32 val)))
 650                                 ((:sint64) (length64 (zig-zag-encode64 val)))
 651                                 ((:fixed32 :sfixed32) 4)
 652                                 ((:fixed64 :sfixed64) 8)
 653                                 ((:float) 4)
 654                                 ((:double) 8)))))))
 655       (declare (type (unsigned-byte 32) len))
 656       ;; Two value: the full size of the packed object, and the size
 657       ;; of just the payload
 658       (values (i+ (length32 tag) (length32 len) len) len))))
 659
 660 (define-compiler-macro packed-size (&whole form values type tag)
 661   (setq type (fold-symbol type)
 662         tag  (fold-symbol tag))
 663   (if (member type '(:int32 :uint32 :int64 :uint64 :sint32 :sint64
 664                      :fixed32 :sfixed32 :fixed64 :sfixed64
 665                      :float :double))
 666     `(locally (declare (optimize (speed 3) (safety 0) (debug 0)))
 667        (let ((len (let ((len 0))
 668                     (declare (type fixnum len))
 669                     (dolist (val ,values len)
 670                       (iincf len ,(ecase type
 671                                     ((:int32) `(length32 (ldb (byte 32 0) val)))
 672                                     ((:int64) `(length64 (ldb (byte 64 0) val)))
 673                                     ((:uint32) `(length32 val))
 674                                     ((:uint64) `(length64 val))
 675                                     ((:sint32) `(length32 (zig-zag-encode32 val)))
 676                                     ((:sint64) `(length64 (zig-zag-encode64 val)))
 677                                     ((:fixed32 :sfixed32) `4)
 678                                     ((:fixed64 :sfixed64) `8)
 679                                     ((:float) `4)
 680                                     ((:double) `8)))))))
 681          (declare (type (unsigned-byte 32) len))
 682          (values (i+ (length32 (the (unsigned-byte 32) ,tag)) (length32 len) len) len)))
 683     form))
 684
 685 (defun enum-size (val values tag)
 686   "Returns the size in bytes that the enum object will take when serialized."
 687   (declare (type (unsigned-byte 32) tag))
 688   (let ((idx (let ((e (find val values :key #'proto-value)))
 689                (and e (proto-index e)))))
 690     (assert idx () "There is no enum value for ~S" val)
 691     (i+ (length32 tag) (length32 (ldb (byte 32 0) idx)))))
 692
 693 \f
 694 ;;; Wire-level encoders
 695 ;;; These are called at the lowest level, so arg types are assumed to be correct
 696
 697 (defun encode-uint32 (val buffer index)
 698   "Encodes the unsigned 32-bit integer 'val' as a varint into the buffer
 699    at the given index.
 700    Modifies the buffer, and returns the new index into the buffer.
 701    Watch out, this function turns off all type checking and array bounds checking."
 702   (declare (optimize (speed 3) (safety 0) (debug 0)))
 703   (declare (type (unsigned-byte 32) val)
 704            (type (simple-array (unsigned-byte 8)) buffer)
 705            (type fixnum index))
 706   ;; Seven bits at a time, least significant bits first
 707   (loop do (let ((bits (ildb (byte 7 0) val)))
 708              (declare (type (unsigned-byte 8) bits))
 709              (setq val (iash val -7))
 710              (setf (aref buffer index) (ilogior bits (if (i= val 0) 0 128)))
 711              (iincf index))
 712         until (i= val 0))
 713   (values index buffer))                        ;return the buffer to improve 'trace'
 714
 715 (defun encode-uint64 (val buffer index)
 716   "Encodes the unsigned 64-bit integer 'val' as a varint into the buffer
 717    at the given index.
 718    Modifies the buffer, and returns the new index into the buffer.
 719    Watch out, this function turns off all type checking and array bounds checking."
 720   (declare (optimize (speed 3) (safety 0) (debug 0)))
 721   (declare (type (unsigned-byte 64) val)
 722            (type (simple-array (unsigned-byte 8)) buffer)
 723            (type fixnum index))
 724   (loop do (let ((bits (ldb (byte 7 0) val)))
 725              (declare (type (unsigned-byte 8) bits))
 726              (setq val (ash val -7))
 727              (setf (aref buffer index) (ilogior bits (if (zerop val) 0 128)))
 728              (iincf index))
 729         until (zerop val))
 730   (values index buffer))
 731
 732 (defun encode-fixed32 (val buffer index)
 733   "Encodes the unsigned 32-bit integer 'val' as a fixed int into the buffer
 734    at the given index.
 735    Modifies the buffer, and returns the new index into the buffer.
 736    Watch out, this function turns off all type checking and array bounds checking."
 737   (declare (optimize (speed 3) (safety 0) (debug 0)))
 738   (declare (type (unsigned-byte 32) val)
 739            (type (simple-array (unsigned-byte 8)) buffer)
 740            (type fixnum index))
 741   (loop repeat 4 doing
 742     (let ((byte (ildb (byte 8 0) val)))
 743       (declare (type (unsigned-byte 8) byte))
 744       (setq val (iash val -8))
 745       (setf (aref buffer index) byte)
 746       (iincf index)))
 747   (values index buffer))
 748
 749 (defun encode-fixed64 (val buffer index)
 750   "Encodes the unsigned 64-bit integer 'val' as a fixed int into the buffer
 751    at the given index.
 752    Modifies the buffer, and returns the new index into the buffer.
 753    Watch out, this function turns off all type checking and array bounds checking."
 754   (declare (optimize (speed 3) (safety 0) (debug 0)))
 755   (declare (type (unsigned-byte 64) val)
 756            (type (simple-array (unsigned-byte 8)) buffer)
 757            (type fixnum index))
 758   (loop repeat 8 doing
 759     (let ((byte (ldb (byte 8 0) val)))
 760       (declare (type (unsigned-byte 8) byte))
 761       (setq val (ash val -8))
 762       (setf (aref buffer index) byte)
 763       (iincf index)))
 764   (values index buffer))
 765
 766 (defun encode-sfixed32 (val buffer index)
 767   "Encodes the signed 32-bit integer 'val' as a fixed int into the buffer
 768    at the given index.
 769    Modifies the buffer, and returns the new index into the buffer.
 770    Watch out, this function turns off all type checking and array bounds checking."
 771   (declare (optimize (speed 3) (safety 0) (debug 0)))
 772   (declare (type (signed-byte 32) val)
 773            (type (simple-array (unsigned-byte 8)) buffer)
 774            (type fixnum index))
 775   (loop repeat 4 doing
 776     (let ((byte (ildb (byte 8 0) val)))
 777       (declare (type (unsigned-byte 8) byte))
 778       (setq val (iash val -8))
 779       (setf (aref buffer index) byte)
 780       (iincf index)))
 781   (values index buffer))
 782
 783 (defun encode-sfixed64 (val buffer index)
 784   "Encodes the signed 64-bit integer 'val' as a fixed int into the buffer
 785    at the given index.
 786    Modifies the buffer, and returns the new index into the buffer.
 787    Watch out, this function turns off all type checking and array bounds checking."
 788   (declare (optimize (speed 3) (safety 0) (debug 0)))
 789   (declare (type (signed-byte 64) val)
 790            (type (simple-array (unsigned-byte 8)) buffer)
 791            (type fixnum index))
 792   (loop repeat 8 doing
 793     (let ((byte (ldb (byte 8 0) val)))
 794       (declare (type (unsigned-byte 8) byte))
 795       (setq val (ash val -8))
 796       (setf (aref buffer index) byte)
 797       (iincf index)))
 798   (values index buffer))
 799
 800 (defun encode-single (val buffer index)
 801   "Encodes the single float 'val' into the buffer at the given index.
 802    Modifies the buffer, and returns the new index into the buffer.
 803    Watch out, this function turns off all type checking and array bounds checking."
 804   (declare (optimize (speed 3) (safety 0) (debug 0)))
 805   (declare (type single-float val)
 806            (type (simple-array (unsigned-byte 8)) buffer)
 807            (type fixnum index))
 808   (let ((bits (single-float-bits val)))
 809     (loop repeat 4 doing
 810       (let ((byte (ldb (byte 8 0) bits)))
 811         (declare (type (unsigned-byte 8) byte))
 812         (setq bits (ash bits -8))
 813         (setf (aref buffer index) byte)
 814         (iincf index))))
 815   (values index buffer))
 816
 817 (defun encode-double (val buffer index)
 818   "Encodes the double float 'val' into the buffer at the given index.
 819    Modifies the buffer, and returns the new index into the buffer.
 820    Watch out, this function turns off all type checking and array bounds checking."
 821   (declare (optimize (speed 3) (safety 0) (debug 0)))
 822   (declare (type double-float val)
 823            (type (simple-array (unsigned-byte 8)) buffer)
 824            (type fixnum index))
 825   (multiple-value-bind (low high)
 826       (double-float-bits val)
 827     (loop repeat 4 doing
 828       (let ((byte (ldb (byte 8 0) low)))
 829         (declare (type (unsigned-byte 8) byte))
 830         (setq low (ash low -8))
 831         (setf (aref buffer index) byte)
 832         (iincf index)))
 833     (loop repeat 4 doing
 834       (let ((byte (ldb (byte 8 0) high)))
 835         (declare (type (unsigned-byte 8) byte))
 836         (setq high (ash high -8))
 837         (setf (aref buffer index) byte)
 838         (iincf index))))
 839   (values index buffer))
 840
 841 (defun encode-string (string buffer index)
 842   "Encodes the octets into the buffer at the given index.
 843    Modifies the buffer, and returns the new index into the buffer.
 844    Watch out, this function turns off all type checking and array bounds checking."
 845   (declare (optimize (speed 3) (safety 0) (debug 0)))
 846   (declare (type (simple-array (unsigned-byte 8)) buffer)
 847            (type fixnum index))
 848   (let* ((octets (babel:string-to-octets string :encoding :utf-8))
 849          (len (length octets))
 850          (idx (encode-uint32 len buffer index)))
 851     (declare (type fixnum len)
 852              (type (unsigned-byte 32) idx))
 853     (replace buffer octets :start1 idx)
 854     (values (i+ idx len) buffer)))
 855
 856 (defun encode-octets (octets buffer index)
 857   "Encodes the octets into the buffer at the given index.
 858    Modifies the buffer, and returns the new index into the buffer.
 859    Watch out, this function turns off all type checking and array bounds checking."
 860   (declare (optimize (speed 3) (safety 0) (debug 0)))
 861   (declare (type (simple-array (unsigned-byte 8)) buffer)
 862            (type fixnum index))
 863   (let* ((len (length octets))
 864          (idx (encode-uint32 len buffer index)))
 865     (declare (type fixnum len)
 866              (type (unsigned-byte 32) idx))
 867     (replace buffer octets :start1 idx)
 868     (values (i+ idx len) buffer)))
 869
 870
 871 ;;; Wire-level decoders
 872 ;;; These are called at the lowest level, so arg types are assumed to be correct
 873
 874 ;; Decode the value from the buffer at the given index,
 875 ;; then return the value and new index into the buffer
 876 (defun decode-uint32 (buffer index)
 877   "Decodes the next 32-bit varint integer in the buffer at the given index.
 878    Returns both the decoded value and the new index into the buffer.
 879    Watch out, this function turns off all type checking and array bounds checking."
 880   (declare (optimize (speed 3) (safety 0) (debug 0)))
 881   (declare (type (simple-array (unsigned-byte 8)) buffer)
 882            (type fixnum index))
 883   ;; Seven bits at a time, least significant bits first
 884   (loop with val fixnum = 0
 885         for places fixnum upfrom 0 by 7
 886         for byte fixnum = (prog1 (aref buffer index) (iincf index))
 887         do (setq val (ilogior val (iash (ildb (byte 7 0) byte) places)))
 888         until (i< byte 128)
 889         finally (progn
 890                   (assert (< val #.(ash 1 32)) ()
 891                           "The value ~D is longer than 32 bits" val)
 892                   (return (values val index)))))
 893
 894 (defun decode-uint64 (buffer index)
 895   "Decodes the next 64-bit varint integer in the buffer at the given index.
 896    Returns both the decoded value and the new index into the buffer.
 897    Watch out, this function turns off all type checking and array bounds checking."
 898   (declare (optimize (speed 3) (safety 0) (debug 0)))
 899   (declare (type (simple-array (unsigned-byte 8)) buffer)
 900            (type fixnum index))
 901   ;; Seven bits at a time, least significant bits first
 902   (loop with val = 0
 903         for places fixnum upfrom 0 by 7
 904         for byte fixnum = (prog1 (aref buffer index) (iincf index))
 905         do (setq val (logior val (ash (ildb (byte 7 0) byte) places)))
 906         until (i< byte 128)
 907         finally (return (values val index))))
 908
 909 (defun decode-int32 (buffer index)
 910   "Decodes the next 32-bit varint integer in the buffer at the given index.
 911    Returns both the decoded value and the new index into the buffer.
 912    Watch out, this function turns off all type checking and array bounds checking."
 913   (declare (optimize (speed 3) (safety 0) (debug 0)))
 914   (declare (type (simple-array (unsigned-byte 8)) buffer)
 915            (type fixnum index))
 916   (multiple-value-bind (val index)
 917       (decode-uint32 buffer index)
 918     (declare (type fixnum val))
 919     (when (i= (ildb (byte 1 31) val) 1)
 920       (idecf val #.(ash 1 32)))
 921     (values val index)))
 922
 923 (defun decode-int64 (buffer index)
 924   "Decodes the next 64-bit varint integer in the buffer at the given index.
 925    Returns both the decoded value and the new index into the buffer.
 926    Watch out, this function turns off all type checking and array bounds checking."
 927   (declare (optimize (speed 3) (safety 0) (debug 0)))
 928   (declare (type (simple-array (unsigned-byte 8)) buffer)
 929            (type fixnum index))
 930   (multiple-value-bind (val index)
 931       (decode-uint64 buffer index)
 932     (when (i= (ldb (byte 1 63 ) val) 1)
 933       (decf val #.(ash 1 64)))
 934     (values val index)))
 935
 936 (defun decode-fixed32 (buffer index)
 937   "Decodes the next 32-bit unsigned fixed integer in the buffer at the given index.
 938    Returns both the decoded value and the new index into the buffer.
 939    Watch out, this function turns off all type checking and array bounds checking."
 940   (declare (optimize (speed 3) (safety 0) (debug 0)))
 941   (declare (type (simple-array (unsigned-byte 8)) buffer)
 942            (type fixnum index))
 943   ;; Eight bits at a time, least significant bits first
 944   (let ((val 0))
 945     (declare (type fixnum val))
 946     (loop repeat 4
 947           for places fixnum upfrom 0 by 8
 948           for byte fixnum = (prog1 (aref buffer index) (iincf index))
 949           do (setq val (ilogior val (iash byte places))))
 950     (values val index)))
 951
 952 (defun decode-sfixed32 (buffer index)
 953   "Decodes the next 32-bit signed fixed integer in the buffer at the given index.
 954    Returns both the decoded value and the new index into the buffer.
 955    Watch out, this function turns off all type checking and array bounds checking."
 956   (declare (optimize (speed 3) (safety 0) (debug 0)))
 957   (declare (type (simple-array (unsigned-byte 8)) buffer)
 958            (type fixnum index))
 959   ;; Eight bits at a time, least significant bits first
 960   (let ((val 0))
 961     (declare (type fixnum val))
 962     (loop repeat 4
 963           for places fixnum upfrom 0 by 8
 964           for byte fixnum = (prog1 (aref buffer index) (iincf index))
 965           do (setq val (ilogior val (iash byte places))))
 966     (when (i= (ldb (byte 1 31) val) 1)              ;sign bit set, so negative value
 967       (decf val #.(ash 1 32)))
 968     (values val index)))
 969
 970 (defun decode-fixed64 (buffer index)
 971   "Decodes the next unsigned 64-bit fixed integer in the buffer at the given index.
 972    Returns both the decoded value and the new index into the buffer.
 973    Watch out, this function turns off all type checking and array bounds checking."
 974   (declare (optimize (speed 3) (safety 0) (debug 0)))
 975   (declare (type (simple-array (unsigned-byte 8)) buffer)
 976            (type fixnum index))
 977   ;; Eight bits at a time, least significant bits first
 978   (let ((val 0))
 979     (loop repeat 8
 980           for places fixnum upfrom 0 by 8
 981           for byte fixnum = (prog1 (aref buffer index) (iincf index))
 982           do (setq val (logior val (ash byte places))))
 983     (values val index)))
 984
 985 (defun decode-sfixed64 (buffer index)
 986   "Decodes the next signed 64-bit fixed integer in the buffer at the given index.
 987    Returns both the decoded value and the new index into the buffer.
 988    Watch out, this function turns off all type checking and array bounds checking."
 989   (declare (optimize (speed 3) (safety 0) (debug 0)))
 990   (declare (type (simple-array (unsigned-byte 8)) buffer)
 991            (type fixnum index))
 992   ;; Eight bits at a time, least significant bits first
 993   (let ((val 0))
 994     (loop repeat 8
 995           for places fixnum upfrom 0 by 8
 996           for byte fixnum = (prog1 (aref buffer index) (iincf index))
 997           do (setq val (logior val (ash byte places))))
 998     (when (i= (ldb (byte 1 63) val) 1)             ;sign bit set, so negative value
 999       (decf val #.(ash 1 64)))
1000     (values val index)))
1001
1002 (defun decode-single (buffer index)
1003   "Decodes the next single float in the buffer at the given index.
1004    Returns both the decoded value and the new index into the buffer.
1005    Watch out, this function turns off all type checking and array bounds checking."
1006   (declare (optimize (speed 3) (safety 0) (debug 0)))
1007   (declare (type (simple-array (unsigned-byte 8)) buffer)
1008            (type fixnum index))
1009   ;; Eight bits at a time, least significant bits first
1010   (let ((bits 0))
1011     (loop repeat 4
1012           for places fixnum upfrom 0 by 8
1013           for byte fixnum = (prog1 (aref buffer index) (iincf index))
1014           do (setq bits (logior bits (ash byte places))))
1015     (when (i= (ldb (byte 1 31) bits) 1)             ;sign bit set, so negative value
1016       (decf bits #.(ash 1 32)))
1017     (values (make-single-float bits) index)))
1018
1019 (defun decode-double (buffer index)
1020   "Decodes the next double float in the buffer at the given index.
1021    Returns both the decoded value and the new index into the buffer.
1022    Watch out, this function turns off all type checking and array bounds checking."
1023   (declare (optimize (speed 3) (safety 0) (debug 0)))
1024   (declare (type (simple-array (unsigned-byte 8)) buffer)
1025            (type fixnum index))
1026   ;; Eight bits at a time, least significant bits first
1027   (let ((low  0)
1028         (high 0))
1029     (loop repeat 4
1030           for places fixnum upfrom 0 by 8
1031           for byte fixnum = (prog1 (aref buffer index) (iincf index))
1032           do (setq low (logior low (ash byte places))))
1033     (loop repeat 4
1034           for places fixnum upfrom 0 by 8
1035           for byte fixnum = (prog1 (aref buffer index) (iincf index))
1036           do (setq high (logior high (ash byte places))))
1037     ;; High bits are signed, but low bits are unsigned
1038     (when (i= (ldb (byte 1 31) high) 1)             ;sign bit set, so negative value
1039       (decf high #.(ash 1 32)))
1040     (values (make-double-float low high) index)))
1041
1042 (defun decode-string (buffer index)
1043   "Decodes the next UTF-8 encoded string in the buffer at the given index.
1044    Returns both the decoded string and the new index into the buffer.
1045    Watch out, this function turns off all type checking and array bounds checking."
1046   (declare (optimize (speed 3) (safety 0) (debug 0)))
1047   (declare (type (simple-array (unsigned-byte 8)) buffer)
1048            (type fixnum index))
1049   (multiple-value-bind (len idx)
1050       (decode-uint32 buffer index)
1051     (declare (type (unsigned-byte 32) len)
1052              (type fixnum idx))
1053     (values (babel:octets-to-string buffer :start idx :end (i+ idx len) :encoding :utf-8) (i+ idx len))))
1054
1055 (defun decode-octets (buffer index)
1056   "Decodes the next octets in the buffer at the given index.
1057    Returns both the decoded value and the new index into the buffer.
1058    Watch out, this function turns off all type checking and array bounds checking."
1059   (declare (optimize (speed 3) (safety 0) (debug 0)))
1060   (declare (type (simple-array (unsigned-byte 8)) buffer)
1061            (type fixnum index))
1062   (multiple-value-bind (len idx)
1063       (decode-uint32 buffer index)
1064     (declare (type (unsigned-byte 32) len)
1065              (type fixnum idx))
1066     (values (subseq buffer idx (i+ idx len)) (i+ idx len))))
1067
1068
1069 ;;; Wire-level lengths
1070 ;;; These are called at the lowest level, so arg types are assumed to be correct
1071
1072 (defun length32 (val)
1073   "Returns the length that 'val' will take when encoded as a 32-bit integer."
1074   (declare (optimize (speed 3) (safety 0) (debug 0)))
1075   (declare (type (unsigned-byte 32) val))
1076   (let ((size 0))
1077     (declare (type fixnum size))
1078     (loop do (progn
1079                (setq val (iash val -7))
1080                (iincf size))
1081           until (i= val 0))
1082     size))
1083
1084 (defun length64 (val)
1085   "Returns the length that 'val' will take when encoded as a 64-bit integer."
1086   (declare (optimize (speed 3) (safety 0) (debug 0)))
1087   (declare (type (unsigned-byte 64) val))
1088   (let ((size 0))
1089     (declare (type fixnum size))
1090     (loop do (progn
1091                (setq val (ash val -7))
1092                (iincf size))
1093           until (zerop val))
1094     size))
1095
1096
1097 ;;; Skipping elements
1098 ;;; This is called at the lowest level, so arg types are assumed to be correct
1099
1100 (defun skip-element (buffer index tag)
1101   "Skip an element in the buffer at the index of the given wire type.
1102    Returns the new index in the buffer.
1103    Watch out, this function turns off all type checking and all array bounds checking."
1104   (declare (optimize (speed 3) (safety 0) (debug 0)))
1105   (declare (type (simple-array (unsigned-byte 8)) buffer)
1106            (type fixnum index)
1107            (type (unsigned-byte 32) tag))
1108   (case (ilogand tag #x7)
1109     ((#.$wire-type-varint)
1110      (loop for byte fixnum = (prog1 (aref buffer index) (iincf index))
1111            until (i< byte 128))
1112      index)
1113     ((#.$wire-type-string)
1114      (multiple-value-bind (len idx)
1115          (decode-uint32 buffer index)
1116        (declare (type (unsigned-byte 32) len)
1117                 (type fixnum idx))
1118        (i+ idx len)))
1119     ((#.$wire-type-32bit)
1120      (i+ index 4))
1121     ((#.$wire-type-64bit)
1122      (i+ index 8))
1123     ((#.$wire-type-start-group)
1124      (loop (multiple-value-bind (new-tag idx)
1125                (decode-uint32 buffer index)
1126              (cond ((not (i= (ilogand new-tag #x7) $wire-type-end-group))
1127                     ;; If it's not the end of a group, skip the next element
1128                     (setq index (skip-element buffer idx new-tag)))
1129                    ;; If it's the end of the expected group, we're done
1130                    ((i= (i- tag $wire-type-start-group) (i- new-tag $wire-type-end-group))
1131                     (return idx))
1132                    (t
1133                     (assert (i= (i- tag $wire-type-start-group) (i- new-tag $wire-type-end-group)) ()
1134                             "Couldn't find a matching end group tag"))))))
1135     (t index)))