1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;; Confidential and proprietary information of ITA Software, Inc. ;;;
5 ;;; Copyright (c) 2012 ITA Software, Inc. All rights reserved. ;;;
7 ;;; Original author: Scott McKay ;;;
9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11 (in-package "PROTO-IMPL")
14 ;;; Protocol buffers wire format
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)))
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)))
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)))
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)))
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)))
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-fixed32 val buffer idx)))
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-fixed64 val buffer idx)))
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)))
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)))
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)))
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)))
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
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))))))
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)))
122 (dolist (val values idx)
123 (setq idx (encode-uint32 val buffer idx))))
125 (dolist (val values idx)
126 (setq idx (encode-uint64 val buffer idx))))
128 (dolist (val values idx)
129 (setq idx (encode-uint32 (zig-zag-encode32 val) buffer idx))))
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-fixed32 val buffer idx))))
136 ((:fixed64 :sfixed64)
137 (dolist (val values idx)
138 (setq idx (encode-fixed64 val buffer idx))))
140 (dolist (val values idx)
141 (setq idx (encode-single val buffer idx))))
143 (dolist (val values idx)
144 (setq idx (encode-double val buffer idx))))))))
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))))
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)))
176 (decode-uint32 buffer index))
178 (decode-uint64 buffer index))
180 (multiple-value-bind (val idx)
181 (decode-uint32 buffer index)
182 (values (zig-zag-decode32 val) idx)))
184 (multiple-value-bind (val idx)
185 (decode-uint64 buffer index)
186 (values (zig-zag-decode64 val) idx)))
187 ((:fixed32 :sfixed32)
188 (decode-fixed32 buffer index))
189 ((:fixed64 :sfixed64)
190 (decode-fixed64 buffer index))
192 (multiple-value-bind (val idx)
193 (decode-octets buffer index)
194 (values (babel:octets-to-string val :encoding :utf-8) idx)))
196 (decode-octets buffer index))
198 (multiple-value-bind (val idx)
199 (decode-uint32 buffer index)
200 (values (if (zerop val) nil t) idx)))
202 (decode-single buffer index))
204 (decode-double buffer index))
205 ;; A few of our homegrown types
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)))))
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))
233 (return-from deserialize-packed (values values idx)))
234 (multiple-value-bind (val nidx)
237 (decode-uint32 buffer idx))
239 (decode-uint64 buffer idx))
241 (multiple-value-bind (val idx)
242 (decode-uint32 buffer idx)
243 (values (zig-zag-decode32 val) idx)))
245 (multiple-value-bind (val idx)
246 (decode-uint64 buffer idx)
247 (values (zig-zag-decode64 val) idx)))
248 ((:fixed32 :sfixed32)
249 (decode-fixed32 buffer idx))
250 ((:fixed64 :sfixed64)
251 (decode-fixed64 buffer idx))
253 (decode-single buffer idx))
255 (decode-double buffer idx)))
257 (setq idx nidx))))))))
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)))))
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)))
281 (let ((tag (ilogior $wire-type-varint (iash (proto-index field) 3))))
282 (i+ (length32 tag) (length32 val))))
284 (let ((tag (ilogior $wire-type-varint (iash (proto-index field) 3))))
285 (i+ (length32 tag) (length64 val))))
287 (let ((tag (ilogior $wire-type-varint (iash (proto-index field) 3))))
288 (i+ (length32 tag) (length32 (zig-zag-encode32 val)))))
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)))
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)))
303 (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
304 (let ((tag (ilogior $wire-type-string (iash (proto-index field) 3)))
306 (i+ (length32 tag) (length32 len) len))))
308 (let ((tag (ilogior $wire-type-varint (iash (proto-index field) 3))))
309 (i+ (length32 tag) 1)))
311 (let ((tag (ilogior $wire-type-32bit (iash (proto-index field) 3))))
312 (i+ (length32 tag) 4)))
314 (let ((tag (ilogior $wire-type-64bit (iash (proto-index field) 3))))
315 (i+ (length32 tag) 8)))
316 ;; A few of our homegrown types
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))))))
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
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)
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))))
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))))
354 (defun encode-uint32 (val buffer index)
355 "Encodes the 32-bit integer 'val' as a varint 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)))
369 (values index buffer)) ;return the buffer to improve 'trace'
371 (defun encode-uint64 (val buffer index)
372 "Encodes the 64-bit integer 'val' as a varint 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)))
383 (values index buffer))
385 (defun encode-fixed32 (val buffer index)
386 "Encodes the 32-bit integer 'val' as a fixed int 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)))
392 (let ((byte (ldb #.(byte 8 0) val)))
393 (declare (type fixnum byte))
394 (setq val (ash val -8))
395 (setf (aref buffer index) byte)
397 (values index buffer))
399 (defun encode-fixed64 (val buffer index)
400 "Encodes the 64-bit integer 'val' as a fixed int into the buffer at the given index.
401 Modifies the buffer, and returns the new index into the buffer."
402 (declare (type fixnum index)
403 (type (simple-array (unsigned-byte 8)) buffer))
404 (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
406 (let ((byte (ldb #.(byte 8 0) val)))
407 (declare (type fixnum byte))
408 (setq val (ash val -8))
409 (setf (aref buffer index) byte)
411 (values index buffer))
413 (defun encode-single (val buffer index)
414 "Encodes the single float 'val' into the buffer at the given index.
415 Modifies the buffer, and returns the new index into the buffer."
416 (declare (type fixnum index)
417 (type (simple-array (unsigned-byte 8)) buffer))
418 (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
419 (let ((bits (single-float-bits val)))
421 (let ((byte (ldb #.(byte 8 0) bits)))
422 (declare (type fixnum byte))
423 (setq bits (ash bits -8))
424 (setf (aref buffer index) byte)
426 (values index buffer))
428 (defun encode-double (val buffer index)
429 "Encodes the double float 'val' into the buffer at the given index.
430 Modifies the buffer, and returns the new index into the buffer."
431 (declare (type fixnum index)
432 (type (simple-array (unsigned-byte 8)) buffer))
433 (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
434 (multiple-value-bind (low high)
435 (double-float-bits val)
437 (let ((byte (ldb #.(byte 8 0) low)))
438 (declare (type fixnum byte))
439 (setq low (ash low -8))
440 (setf (aref buffer index) byte)
443 (let ((byte (ldb #.(byte 8 0) high)))
444 (declare (type fixnum byte))
445 (setq high (ash high -8))
446 (setf (aref buffer index) byte)
448 (values index buffer))
450 (defun encode-octets (octets buffer index)
451 "Encodes the octets into the buffer at the given index.
452 Modifies the buffer, and returns the new index into the buffer."
453 (declare (type fixnum index)
454 (type (simple-array (unsigned-byte 8)) buffer))
455 (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
456 (let* ((len (length octets))
457 (idx (encode-uint32 len buffer index)))
458 (declare (type fixnum len idx))
459 (replace buffer octets :start1 idx)
460 (values (i+ idx len) buffer))))
462 (defun zig-zag-encode32 (val)
463 (assert (< (integer-length val) 32))
464 (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
465 (logxor (ash val 1) (ash val -31))))
467 (defun zig-zag-encode64 (val)
468 (assert (< (integer-length val) 64))
469 (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
470 (logxor (ash val 1) (ash val -63))))
475 ;; Decode the value from the buffer at the given index,
476 ;; then return the value and new index into the buffer
477 (defun decode-uint32 (buffer index)
478 "Decodes the next 32-bit varint integer in the buffer at the given index.
479 Returns both the decoded value and the new index into the buffer."
480 (declare (type fixnum index)
481 (type (simple-array (unsigned-byte 8)) buffer))
482 (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
483 ;; Seven bits at a time, least significant bits first
485 for places fixnum upfrom 0 by 7
486 for byte fixnum = (prog1 (aref buffer index) (iincf index))
487 do (setq val (logior val (ash (ldb #.(byte 7 0) byte) places)))
490 (assert (< val #.(ash 1 32)) ()
491 "The value ~D is longer than 32 bits" val)
492 (return (values val index))))))
494 (defun decode-uint64 (buffer index)
495 "Decodes the next 64-bit varint integer in the buffer at the given index.
496 Returns both the decoded value and the new index into the buffer."
497 (declare (type fixnum index)
498 (type (simple-array (unsigned-byte 8)) buffer))
499 (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
500 ;; Seven bits at a time, least significant bits first
502 for places fixnum upfrom 0 by 7
503 for byte fixnum = (prog1 (aref buffer index) (iincf index))
504 do (setq val (logior val (ash (ldb #.(byte 7 0) byte) places)))
506 finally (return (values val index)))))
508 (defun decode-fixed32 (buffer index)
509 "Decodes the next 32-bit fixed integer in the buffer at the given index.
510 Returns both the decoded value and the new index into the buffer."
511 (declare (type fixnum index)
512 (type (simple-array (unsigned-byte 8)) buffer))
513 (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
514 ;; Eight bits at a time, least significant bits first
517 for places fixnum upfrom 0 by 8
518 for byte fixnum = (prog1 (aref buffer index) (iincf index))
519 do (setq bits (logior bits (ash byte places))))
520 (when (i= (ldb #.(byte 1 31) bits) 1) ;sign bit set, so negative value
521 (decf bits #.(ash 1 32)))
522 (values bits index))))
524 (defun decode-fixed64 (buffer index)
525 "Decodes the next 64-bit fixed integer in the buffer at the given index.
526 Returns both the decoded value and the new index into the buffer."
527 (declare (type fixnum index)
528 (type (simple-array (unsigned-byte 8)) buffer))
529 (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
530 ;; Eight bits at a time, least significant bits first
533 for places fixnum upfrom 0 by 8
534 for byte fixnum = (prog1 (aref buffer index) (iincf index))
535 do (setq bits (logior bits (ash byte places))))
536 (when (i= (ldb #.(byte 1 63) bits) 1) ;sign bit set, so negative value
537 (decf bits #.(ash 1 64)))
538 (values bits index))))
540 (defun decode-single (buffer index)
541 "Decodes the next single float in the buffer at the given index.
542 Returns both the decoded value and the new index into the buffer."
543 (declare (type fixnum index)
544 (type (simple-array (unsigned-byte 8)) buffer))
545 (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
546 ;; Eight bits at a time, least significant bits first
549 for places fixnum upfrom 0 by 8
550 for byte fixnum = (prog1 (aref buffer index) (iincf index))
551 do (setq bits (logior bits (ash byte places))))
552 (when (i= (ldb #.(byte 1 31) bits) 1) ;sign bit set, so negative value
553 (decf bits #.(ash 1 32)))
554 (values (make-single-float bits) index))))
556 (defun decode-double (buffer index)
557 "Decodes the next double float in the buffer at the given index.
558 Returns both the decoded value and the new index into the buffer."
559 (declare (type fixnum index)
560 (type (simple-array (unsigned-byte 8)) buffer))
561 (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
562 ;; Eight bits at a time, least significant bits first
566 for places fixnum upfrom 0 by 8
567 for byte fixnum = (prog1 (aref buffer index) (iincf index))
568 do (setq low (logior low (ash byte places))))
570 for places fixnum upfrom 0 by 8
571 for byte fixnum = (prog1 (aref buffer index) (iincf index))
572 do (setq high (logior high (ash byte places))))
573 ;; High bits are signed, but low bits are unsigned
574 (when (i= (ldb #.(byte 1 31) high) 1) ;sign bit set, so negative value
575 (decf high #.(ash 1 32)))
576 (values (make-double-float low high) index))))
578 (defun decode-octets (buffer index)
579 "Decodes the next octets in the buffer at the given index.
580 Returns both the decoded value and the new index into the buffer."
581 (declare (type fixnum index)
582 (type (simple-array (unsigned-byte 8)) buffer))
583 (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
584 (multiple-value-bind (len idx)
585 (decode-uint32 buffer index)
586 (declare (type fixnum len idx))
587 (values (subseq buffer idx (i+ idx len)) (i+ idx len)))))
589 (defun zig-zag-decode32 (val)
590 (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
591 (logxor (ash val -1) (- (logand val 1)))))
593 (defun zig-zag-decode64 (val)
594 (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
595 (logxor (ash val -1) (- (logand val 1)))))
600 (defun length32 (val)
601 "Returns the length that 'val' will take when encoded as a 32-bit integer."
602 (assert (< val #.(ash 1 32)) ()
603 "The value ~D is longer than 32 bits" val)
604 (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
606 (declare (type fixnum size))
608 (setq val (ash val -7))
613 (defun length64 (val)
614 "Returns the length that 'val' will take when encoded as a 64-bit integer."
615 (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
617 (declare (type fixnum size))
619 (setq val (ash val -7))