(format nil "~A:~A" (package-name (symbol-package val)) (symbol-name val)))))
(encode-string val buffer idx)))
((:date :time :datetime :timestamp)
- (encode-uint64 (ldb (byte 64 0) val) buffer idx))))))
+ (encode-uint64 val buffer idx))))))
(define-compiler-macro serialize-prim (&whole form val type tag buffer index)
(setq type (fold-symbol type)
(packed-size values type tag)
(declare (type fixnum len) (ignore full-len))
(setq idx (encode-uint32 len buffer idx)))
- (ecase type
- ((:int32 :int64)
- (map () #'(lambda (val) (setq idx (encode-int val buffer idx))) values))
- ((:uint32)
- (map () #'(lambda (val) (setq idx (encode-uint32 val buffer idx))) values))
- ((:uint64)
- (map () #'(lambda (val) (setq idx (encode-uint64 val buffer idx))) values))
- ((:sint32)
- (map () #'(lambda (val) (setq idx (encode-uint32 (zig-zag-encode32 val) buffer idx))) values))
- ((:sint64)
- (map () #'(lambda (val) (setq idx (encode-uint64 (zig-zag-encode64 val) buffer idx))) values))
- ((:fixed32)
- (map () #'(lambda (val) (setq idx (encode-fixed32 val buffer idx))) values))
- ((:sfixed32)
- (map () #'(lambda (val) (setq idx (encode-sfixed32 val buffer idx))) values))
- ((:fixed64)
- (map () #'(lambda (val) (setq idx (encode-fixed64 val buffer idx))) values))
- ((:sfixed64)
- (map () #'(lambda (val) (setq idx (encode-sfixed64 val buffer idx))) values))
- ((:bool)
- (map () #'(lambda (val) (setq idx (encode-uint32 (if val 1 0) buffer idx))) values))
- ((:float)
- (map () #'(lambda (val) (setq idx (encode-single val buffer idx))) values))
- ((:double)
- (map () #'(lambda (val) (setq idx (encode-double val buffer idx))) values)))
+ (map ()
+ (ecase type
+ ((:int32 :int64) #'(lambda (val) (setq idx (encode-int val buffer idx))))
+ ((:uint32) #'(lambda (val) (setq idx (encode-uint32 val buffer idx))))
+ ((:uint64) #'(lambda (val) (setq idx (encode-uint64 val buffer idx))))
+ ((:sint32) #'(lambda (val) (setq idx (encode-uint32 (zig-zag-encode32 val) buffer idx))))
+ ((:sint64) #'(lambda (val) (setq idx (encode-uint64 (zig-zag-encode64 val) buffer idx))))
+ ((:fixed32) #'(lambda (val) (setq idx (encode-fixed32 val buffer idx))))
+ ((:sfixed32) #'(lambda (val) (setq idx (encode-sfixed32 val buffer idx))))
+ ((:fixed64) #'(lambda (val) (setq idx (encode-fixed64 val buffer idx))))
+ ((:sfixed64) #'(lambda (val) (setq idx (encode-sfixed64 val buffer idx))))
+ ((:bool) #'(lambda (val) (setq idx (encode-uint32 (if val 1 0) buffer idx))))
+ ((:float) #'(lambda (val) (setq idx (encode-single val buffer idx))))
+ ((:double) #'(lambda (val) (setq idx (encode-double val buffer idx)))))
+ values)
idx)))
;; The optimized serializers supply 'vectorp' so we can generate better code
(idx (encode-uint32 tag buffer index)))
(declare (type (unsigned-byte 32) val)
(type fixnum idx))
- (encode-uint32 (ldb (byte 32 0) val) buffer idx))))
+ (encode-uint32 val buffer idx))))
(defun serialize-packed-enum (values enum-values tag buffer index)
"Serializes Protobufs enum values into the buffer at the given index.
(let ((val (let ((e (find val enum-values :key #'proto-value)))
(and e (proto-index e)))))
(declare (type (unsigned-byte 32) val))
- (setq idx (encode-uint32 (ldb (byte 32 0) val) buffer idx)))) values)
+ (setq idx (encode-uint32 val buffer idx)))) values)
idx)))
~& Modifies the buffer, and returns the new index into the buffer.~
~& Watch out, this function turns off all type checking and array bounds checking." bits)
(declare #.$optimize-serialization)
- (declare (type (unsigned-byte ,bits) val)
- (type (simple-array (unsigned-byte 8)) buffer)
- (type fixnum index))
- ;; Seven bits at a time, least significant bits first
- (loop do (let ((bits (,ldb (byte 7 0) val)))
- (declare (type (unsigned-byte 8) bits))
- (setq val (,ash val -7))
- (setf (aref buffer index)
- (ilogior bits (if ,zerop-val 0 128)))
- (iincf index))
- until ,zerop-val)
+ (let ((val (ldb (byte ,bits 0) val)))
+ (declare (type (unsigned-byte ,bits) val)
+ (type (simple-array (unsigned-byte 8)) buffer)
+ (type fixnum index))
+ ;; Seven bits at a time, least significant bits first
+ (loop do (let ((bits (,ldb (byte 7 0) val)))
+ (declare (type (unsigned-byte 8) bits))
+ (setq val (,ash val -7))
+ (setf (aref buffer index)
+ (ilogior bits (if ,zerop-val 0 128)))
+ (iincf index))
+ until ,zerop-val))
(values index buffer)) ;return the buffer to improve 'trace'
(defun ,encode-fixed (val buffer index)
,(format nil
Modifies the buffer, and returns the new index into the buffer.
Watch out, this function turns off all type checking and array bounds checking."
(declare #.$optimize-serialization)
- (let ((val (ldb (byte 64 0) val))) ;clamp val to 64-bits maximum
- (declare (type (unsigned-byte 64) val)
- (type (simple-array (unsigned-byte 8)) buffer)
- (type fixnum index))
- ;; Seven bits at a time, least significant bits first
- (loop do (let ((bits (ldb (byte 7 0) val)))
- (declare (type (unsigned-byte 8) bits))
- (setq val (ash val -7))
- (setf (aref buffer index)
- (ilogior bits (if (zerop val) 0 128)))
- (iincf index))
- until (zerop val))
- (values index buffer))) ;return the buffer to improve 'trace'
+ (declare (type (simple-array (unsigned-byte 8)) buffer)
+ (type (signed-byte 64) val)
+ (type fixnum index))
+ ;; Seven bits at a time, least significant bits first
+ (loop repeat 9 ;up to 63 bits
+ do (setf (aref buffer index) (ldb (byte 7 0) val))
+ (setq val (ash val -7))
+ until (zerop val)
+ do (iincf (aref buffer index) #x80)
+ (iincf index)
+ finally (unless (zerop val) ;take the 64th bit as needed
+ (setf (aref buffer index) 1)
+ (unless (= val -1)
+ (serialization-error "Integer too large while encoding VarInt."))))
+ (values (iincf index) buffer)) ;return the buffer to improve 'trace'
(defun encode-single (val buffer index)
"Encodes the single float 'val' into the buffer at the given index.
(type (simple-array (unsigned-byte 8)) buffer)
(type fixnum index))
(let ((bits (single-float-bits val)))
+ (declare (type (signed-byte 32) bits))
(loop repeat 4 doing
(let ((byte (ldb (byte 8 0) bits)))
(declare (type (unsigned-byte 8) byte))
(type fixnum index))
(multiple-value-bind (low high)
(double-float-bits val)
+ (declare (type (unsigned-byte 32) low)
+ (type (signed-byte 32) high))
(loop repeat 4 doing
(let ((byte (ldb (byte 8 0) low)))
(declare (type (unsigned-byte 8) byte))
(let* ((octets (babel:string-to-octets string :encoding :utf-8))
(len (length octets))
(idx (encode-uint32 len buffer index)))
- (declare (type (array (unsigned-byte 8)) octets)
+ (declare (type (simple-array (unsigned-byte 8)) octets)
(type fixnum len)
(type (unsigned-byte 32) idx))
(replace buffer octets :start1 idx)
(bytes (/ bits 8))
;; Given bits, can we use fixnums safely?
(fixnump (<= bits (integer-length most-negative-fixnum)))
- (ldb (if fixnump 'ildb 'ldb))
(ash (if fixnump 'iash 'ash))
(decf (if fixnump 'idecf 'decf))
- (logior (if fixnump 'ilogior 'logior)))
+ (logior (if fixnump 'ilogior 'logior))
+ (logbitp (if fixnump 'ilogbitp 'logbitp)))
`(progn
(defun ,decode-uint (buffer index)
,(format nil
do (let ((bits (ildb (byte 7 0) byte)))
(declare (type (unsigned-byte 8) bits))
(setq val (,logior val (,ash bits places))))
- until (i< byte 128)
+ while (ilogbitp 7 byte)
finally (progn
(unless (< val ,(ash 1 bits))
(serialization-error "The value ~D is longer than ~A bits" val ,bits))
for places fixnum upfrom 0 by 8
for byte fixnum = (prog1 (aref buffer index) (iincf index))
do (setq val (,logior val (,ash byte places))))
- (when (i= (,ldb (byte 1 ,(1- bits)) val) 1) ;sign bit set, so negative value
+ (when (,logbitp ,(1- bits) val) ;sign bit set, so negative value
(,decf val ,(ash 1 bits)))
(values val index))))))
(type fixnum index))
(multiple-value-bind (val index)
(decode-uint64 buffer index)
- (when (i= (ldb (byte 1 63) val) 1)
- (decf val (ash 1 64)))
- (values val index)))
+ (declare (type (unsigned-byte 64) val))
+ (values (if (logbitp 63 val)
+ (- val #.(ash 1 64))
+ val)
+ index)))
(defun decode-single (buffer index)
"Decodes the next single float in the buffer at the given index.
(type fixnum index))
;; Eight bits at a time, least significant bits first
(let ((bits 0))
+ (declare (type (unsigned-byte 32) bits))
(loop repeat 4
for places fixnum upfrom 0 by 8
for byte fixnum = (prog1 (aref buffer index) (iincf index))
do (setq bits (logior bits (ash byte places))))
- (when (i= (ldb (byte 1 31) bits) 1) ;sign bit set, so negative value
- (decf bits #.(ash 1 32)))
- (values (make-single-float bits) index)))
+ (values (make-single-float (if (logbitp 31 bits) ;sign bit
+ (- bits #.(ash 1 32))
+ bits))
+ index)))
(defun decode-double (buffer index)
"Decodes the next double float in the buffer at the given index.
;; Eight bits at a time, least significant bits first
(let ((low 0)
(high 0))
+ (declare (type (unsigned-byte 32) low)
+ (type (unsigned-byte 32) high))
(loop repeat 4
for places fixnum upfrom 0 by 8
for byte fixnum = (prog1 (aref buffer index) (iincf index))
for byte fixnum = (prog1 (aref buffer index) (iincf index))
do (setq high (logior high (ash byte places))))
;; High bits are signed, but low bits are unsigned
- (when (i= (ldb (byte 1 31) high) 1) ;sign bit set, so negative value
- (decf high #.(ash 1 32)))
- (values (make-double-float low high) index)))
+ (values (make-double-float low (if (logbitp 31 high) ;sign bit
+ (- high #.(ash 1 32))
+ high))
+ index)))
(defun decode-string (buffer index)
"Decodes the next UTF-8 encoded string in the buffer at the given index.
(defun varint-length (val)
"Return the length that 'val' will take when encoded as a varint integer."
(declare #.$optimize-serialization)
- (let ((val (ldb (byte 64 0) val))
- (size 0))
- (declare (type (unsigned-byte 64) val))
- (declare (type fixnum size))
- (loop do (setq val (ash val -7))
- (iincf size)
- until (zerop val))
- size))
-
+ (loop repeat 10 ;max length of varint
+ do (setq val (ash val -7))
+ count 1
+ until (zerop val)))
;;; Skipping elements
;;; This is called at the lowest level, so arg types are assumed to be correct
projects / cl-protobufs.git / blobdiff