(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
Watch out, this function turns off all type checking and array bounds checking."
(declare #.$optimize-serialization)
(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
(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))
(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.
projects / cl-protobufs.git / blobdiff