X-Git-Url: https://asedeno.scripts.mit.edu/gitweb/?a=blobdiff_plain;f=wire-format.lisp;h=6d597decced6dc4b9fef97d9c23411ee66ca5ae6;hb=HEAD;hp=449c1e6742233797fbfa4d16506bef6d04be1a72;hpb=c80b657c0bf77604b5187858e06c27296049ca02;p=cl-protobufs.git diff --git a/wire-format.lisp b/wire-format.lisp index 449c1e6..6d597de 100644 --- a/wire-format.lisp +++ b/wire-format.lisp @@ -234,31 +234,21 @@ (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 @@ -828,6 +818,7 @@ 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 @@ -851,6 +842,7 @@ (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)) @@ -869,6 +861,8 @@ (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)) @@ -929,10 +923,10 @@ (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 @@ -950,7 +944,7 @@ 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)) @@ -986,7 +980,7 @@ 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)))))) @@ -1002,9 +996,11 @@ (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. @@ -1015,13 +1011,15 @@ (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. @@ -1033,6 +1031,8 @@ ;; 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)) @@ -1042,9 +1042,10 @@ 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.