;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
-;;; Confidential and proprietary information of ITA Software, Inc. ;;;
+;;; Free Software published under an MIT-like license. See LICENSE ;;;
;;; ;;;
-;;; Copyright (c) 2012 ITA Software, Inc. All rights reserved. ;;;
+;;; Copyright (c) 2012 Google, Inc. All rights reserved. ;;;
;;; ;;;
;;; Original author: Scott McKay ;;;
;;; ;;;
;; If you need to debug the (de)serializer, (pushnew :debug-serialization *features*)
;; Otherwise, we try to make (de)serialization as fast as possible,
;; risking life and limb to do so
-(defconstant $optimize-serialization
+(defparameter $optimize-serialization
#+debug-serialization $optimize-default
#-debug-serialization $optimize-fast-unsafe)
(defun zig-zag-decode32 (val)
(declare #.$optimize-serialization)
+ (declare (type (unsigned-byte 32) val))
(logxor (ash val -1) (- (logand val 1))))
(defun zig-zag-decode64 (val)
(declare #.$optimize-serialization)
+ (declare (type (unsigned-byte 64) val))
(logxor (ash val -1) (- (logand val 1))))
(define-compiler-macro zig-zag-decode32 (&whole form val)
(if (atom val)
- `(locally (declare #.$optimize-serialization)
+ `(locally (declare #.$optimize-serialization
+ (type (unsigned-byte 32) ,val))
(logxor (ash ,val -1) (- (logand ,val 1))))
form))
(define-compiler-macro zig-zag-decode64 (&whole form val)
(if (atom val)
- `(locally (declare #.$optimize-serialization)
+ `(locally (declare #.$optimize-serialization
+ (type (unsigned-byte 64) ,val))
(logxor (ash ,val -1) (- (logand ,val 1))))
form))
The value is given by 'val', the primitive type by 'type'.
Modifies the buffer in place, and returns the new index into the buffer.
Watch out, this function turns off most type checking and all array bounds checking."
- (declare
- (type (unsigned-byte 32) tag)
+ (declare (type (unsigned-byte 32) tag)
(type fixnum index))
(locally (declare #.$optimize-serialization)
(let ((idx (encode-uint32 tag buffer index)))
`(encode-double ,val ,buffer idx)))))
form))
-(defun serialize-packed (values type tag buffer index)
+(defun serialize-packed (values type tag buffer index &optional vectorp)
"Serializes a set of packed values into the buffer at the given index.
The values are given by 'values', the primitive type by 'type'.
Modifies the buffer in place, and returns the new index into the buffer.
Watch out, this function turns off most type checking and all array bounds checking."
- (declare (type (simple-array (unsigned-byte 8)) buffer)
+ (declare (ignore vectorp)
+ (type (simple-array (unsigned-byte 8)) buffer)
(type (unsigned-byte 32) tag)
(type fixnum index))
(locally (declare #.$optimize-serialization)
(map () #'(lambda (val) (setq idx (encode-double val buffer idx))) values)))
idx)))
-(define-compiler-macro serialize-packed (&whole form values type tag buffer index)
+;; The optimized serializers supply 'vectorp' so we can generate better code
+(define-compiler-macro serialize-packed (&whole form values type tag buffer index
+ &optional (vectorp nil vectorp-p))
(setq type (fold-symbol type)
tag (fold-symbol tag))
- (if (member type '(:int32 :uint32 :int64 :uint64 :sint32 :sint64
- :fixed32 :sfixed32 :fixed64 :sfixed64
- :bool :float :double))
+ (if (and vectorp-p
+ `(member type '(:int32 :uint32 :int64 :uint64 :sint32 :sint64
+ :fixed32 :sfixed32 :fixed64 :sfixed64
+ :bool :float :double)))
`(locally (declare #.$optimize-serialization
(type (simple-array (unsigned-byte 8)) ,buffer)
;; 'tag' is a constant, no need to declare its type
(packed-size ,values ,type ,tag)
(declare (type fixnum len) (ignore full-len))
(setq idx (encode-uint32 len ,buffer idx)))
- (map () #'(lambda (val)
- ,(ecase type
- ((:int32)
- `(setq idx (encode-uint32 (ldb (byte 32 0) val) ,buffer idx)))
- ((:int64)
- `(setq idx (encode-uint64 (ldb (byte 64 0) val) ,buffer idx)))
- ((:uint32)
- `(setq idx (encode-uint32 val ,buffer idx)))
- ((:uint64)
- `(setq idx (encode-uint64 val ,buffer idx)))
- ((:sint32)
- `(setq idx (encode-uint32 (zig-zag-encode32 val) ,buffer idx)))
- ((:sint64)
- `(setq idx (encode-uint64 (zig-zag-encode64 val) ,buffer idx)))
- ((:fixed32)
- `(setq idx (encode-fixed32 val ,buffer idx)))
- ((:sfixed32)
- `(setq idx (encode-sfixed32 val ,buffer idx)))
- ((:fixed64)
- `(setq idx (encode-fixed64 val ,buffer idx)))
- ((:sfixed64)
- `(setq idx (encode-sfixed64 val ,buffer idx)))
- ((:bool)
- `(setq idx (encode-uint32 (if val 1 0) ,buffer idx)))
- ((:float)
- `(setq idx (encode-single val ,buffer idx)))
- ((:double)
- `(setq idx (encode-double val ,buffer idx))))) ,values)
+ (,(if vectorp 'dovector 'dolist) (val ,values)
+ ,(ecase type
+ ((:int32)
+ `(setq idx (encode-uint32 (ldb (byte 32 0) val) ,buffer idx)))
+ ((:int64)
+ `(setq idx (encode-uint64 (ldb (byte 64 0) val) ,buffer idx)))
+ ((:uint32)
+ `(setq idx (encode-uint32 val ,buffer idx)))
+ ((:uint64)
+ `(setq idx (encode-uint64 val ,buffer idx)))
+ ((:sint32)
+ `(setq idx (encode-uint32 (zig-zag-encode32 val) ,buffer idx)))
+ ((:sint64)
+ `(setq idx (encode-uint64 (zig-zag-encode64 val) ,buffer idx)))
+ ((:fixed32)
+ `(setq idx (encode-fixed32 val ,buffer idx)))
+ ((:sfixed32)
+ `(setq idx (encode-sfixed32 val ,buffer idx)))
+ ((:fixed64)
+ `(setq idx (encode-fixed64 val ,buffer idx)))
+ ((:sfixed64)
+ `(setq idx (encode-sfixed64 val ,buffer idx)))
+ ((:bool)
+ `(setq idx (encode-uint32 (if val 1 0) ,buffer idx)))
+ ((:float)
+ `(setq idx (encode-single val ,buffer idx)))
+ ((:double)
+ `(setq idx (encode-double val ,buffer idx)))))
idx))
form))
The value is given by 'val', the enum values are in 'enum-values'.
Modifies the buffer in place, and returns the new index into the buffer.
Watch out, this function turns off most type checking and all array bounds checking."
- (declare (type (simple-array (unsigned-byte 8)) buffer)
+ (declare (type list enum-values)
+ (type (simple-array (unsigned-byte 8)) buffer)
(type (unsigned-byte 32) tag)
(type fixnum index))
(locally (declare #.$optimize-serialization)
The values are given by 'values', the enum values are in 'enum-values'.
Modifies the buffer in place, and returns the new index into the buffer.
Watch out, this function turns off most type checking and all array bounds checking."
- (declare (type (simple-array (unsigned-byte 8)) buffer)
+ (declare (type list enum-values)
+ (type (simple-array (unsigned-byte 8)) buffer)
(type (unsigned-byte 32) tag)
(type fixnum index))
(locally (declare #.$optimize-serialization)
Deserializes from the byte vector 'buffer' starting at 'index'.
Returns the value and and the new index into the buffer.
Watch out, this function turns off most type checking and all array bounds checking."
- (declare (type (simple-array (unsigned-byte 8)) buffer)
+ (declare (type list enum-values)
+ (type (simple-array (unsigned-byte 8)) buffer)
(type fixnum index))
(locally (declare #.$optimize-serialization)
(multiple-value-bind (val idx)
Deserializes from the byte vector 'buffer' starting at 'index'.
Returns the value and and the new index into the buffer.
Watch out, this function turns off most type checking and all array bounds checking."
- (declare (type (simple-array (unsigned-byte 8)) buffer)
+ (declare (type list enum-values)
+ (type (simple-array (unsigned-byte 8)) buffer)
(type fixnum index))
(locally (declare #.$optimize-serialization)
(multiple-value-bind (len idx)
`(i+ (length32 ,tag) 8))))
form))
-(defun packed-size (values type tag)
+(defun packed-size (values type tag &optional vectorp)
"Returns the size in bytes that the packed object will take when serialized.
Watch out, this function turns off most type checking."
- (declare (type (unsigned-byte 32) tag))
+ (declare (ignore vectorp)
+ (type (unsigned-byte 32) tag))
(locally (declare #.$optimize-serialization)
(let ((len (let ((len 0))
(declare (type fixnum len))
;; of just the payload
(values (i+ (length32 tag) (length32 len) len) len))))
-(define-compiler-macro packed-size (&whole form values type tag)
+;; The optimized serializers supply 'vectorp' so we can generate better code
+(define-compiler-macro packed-size (&whole form values type tag
+ &optional (vectorp nil vectorp-p))
(setq type (fold-symbol type)
tag (fold-symbol tag))
- (if (member type '(:int32 :uint32 :int64 :uint64 :sint32 :sint64
- :fixed32 :sfixed32 :fixed64 :sfixed64
- :bool :float :double))
+ (if (and vectorp-p
+ (member type '(:int32 :uint32 :int64 :uint64 :sint32 :sint64
+ :fixed32 :sfixed32 :fixed64 :sfixed64
+ :bool :float :double)))
`(locally (declare #.$optimize-serialization)
(let ((len (let ((len 0))
(declare (type fixnum len))
- (map () #'(lambda (val)
- (iincf len ,(ecase type
- ((:int32) `(length32 (ldb (byte 32 0) val)))
- ((:int64) `(length64 (ldb (byte 64 0) val)))
- ((:uint32) `(length32 val))
- ((:uint64) `(length64 val))
- ((:sint32) `(length32 (zig-zag-encode32 val)))
- ((:sint64) `(length64 (zig-zag-encode64 val)))
- ((:fixed32 :sfixed32) `4)
- ((:fixed64 :sfixed64) `8)
- ((:bool) `1)
- ((:float) `4)
- ((:double) `8)))) ,values)
+ (,(if vectorp 'dovector 'dolist) (val ,values)
+ (iincf len ,(ecase type
+ ((:int32) `(length32 (ldb (byte 32 0) val)))
+ ((:int64) `(length64 (ldb (byte 64 0) val)))
+ ((:uint32) `(length32 val))
+ ((:uint64) `(length64 val))
+ ((:sint32) `(length32 (zig-zag-encode32 val)))
+ ((:sint64) `(length64 (zig-zag-encode64 val)))
+ ((:fixed32 :sfixed32) `4)
+ ((:fixed64 :sfixed64) `8)
+ ((:bool) `1)
+ ((:float) `4)
+ ((:double) `8))))
len)))
(declare (type (unsigned-byte 32) len))
(values (i+ (length32 (the (unsigned-byte 32) ,tag)) (length32 len) len) len)))
(defun enum-size (val enum-values tag)
"Returns the size in bytes that the enum object will take when serialized."
- (declare (type (unsigned-byte 32) tag))
+ (declare (type list enum-values)
+ (type (unsigned-byte 32) tag))
(let ((idx (let ((e (find val enum-values :key #'proto-value)))
(and e (proto-index e)))))
(assert idx () "There is no enum value for ~S" val)
(defun packed-enum-size (values enum-values tag)
"Returns the size in bytes that the enum values will take when serialized."
+ (declare (type list enum-values)
+ (type (unsigned-byte 32) tag))
(let ((len (let ((len 0))
(declare (type fixnum len))
(map () #'(lambda (val)
(let ((idx (let ((e (find val enum-values :key #'proto-value)))
(and e (proto-index e)))))
(assert idx () "There is no enum value for ~S" val)
- (iincf len (length32 (ldb (byte 32 0) val))))) values)
+ (iincf len (length32 (ldb (byte 32 0) idx))))) values)
len)))
(declare (type (unsigned-byte 32) len))
;; Two value: the full size of the packed object, and the size
(let* ((octets (babel:string-to-octets string :encoding :utf-8))
(len (length octets))
(idx (encode-uint32 len buffer index)))
- (declare (type fixnum len)
+ (declare (type (array (unsigned-byte 8)) octets)
+ (type fixnum len)
(type (unsigned-byte 32) idx))
(replace buffer octets :start1 idx)
(values (i+ idx len) buffer)))
Modifies the buffer, and returns the new index into the buffer.
Watch out, this function turns off all type checking and array bounds checking."
(declare #.$optimize-serialization)
- (declare (type (simple-array (unsigned-byte 8)) buffer)
+ (declare (type (array (unsigned-byte 8)) octets)
+ (type (simple-array (unsigned-byte 8)) buffer)
(type fixnum index))
(let* ((len (length octets))
(idx (encode-uint32 len buffer index)))
projects / cl-protobufs.git / blobdiff