This commit is contained in:
ErikR 2015-08-25 21:59:32 +02:00
parent 953af87fe4
commit 3bde47386a

View file

@ -180,38 +180,38 @@
(let ((div (position 0 data)))
(let ((tags (subseq data 1 div))
(acc (subseq data (padded-length div)))
(result '()))
(acc (subseq data (padded-length div)))
(result '()))
(map 'vector
#'(lambda (x)
(cond
((eq x (char-code #\i))
(push (decode-int32 (subseq acc 0 4))
result)
(setf acc (subseq acc 4)))
((eq x (char-code #\h))
(push (decode-uint64 (subseq acc 0 8))
result)
(setf acc (subseq acc 8)))
((eq x (char-code #\f))
(push (decode-float32 (subseq acc 0 4))
result)
(setf acc (subseq acc 4)))
((eq x (char-code #\s))
(let ((pointer (padded-length (position 0 acc))))
(push (decode-string
(subseq acc 0 pointer))
result)
(setf acc (subseq acc pointer))))
((eq x (char-code #\b))
(let* ((size (decode-int32 (subseq acc 0 4)))
#'(lambda (x)
(cond
((eq x (char-code #\i))
(push (decode-int32 (subseq acc 0 4))
result)
(setf acc (subseq acc 4)))
((eq x (char-code #\h))
(push (decode-uint64 (subseq acc 0 8))
result)
(setf acc (subseq acc 8)))
((eq x (char-code #\f))
(push (decode-float32 (subseq acc 0 4))
result)
(setf acc (subseq acc 4)))
((eq x (char-code #\s))
(let ((pointer (padded-length (position 0 acc))))
(push (decode-string
(subseq acc 0 pointer))
result)
(setf acc (subseq acc pointer))))
((eq x (char-code #\b))
(let* ((size (decode-int32 (subseq acc 0 4)))
(bl (+ 4 size))
(end (+ bl (mod (- 4 bl) 4)))) ; NOTE: cannot use (padded-length bl), as it is not the same algorithm. Blobs of 4, 8, 12 etc bytes should not be padded!
(push (decode-blob (subseq acc 0 end))
result)
(setf acc (subseq acc end))))
(t (error "unrecognised typetag ~a" x))))
tags)
(t (error "unrecognised typetag ~a" x))))
tags)
(nreverse result))))