zzkt/osc
1
0
Fork 0
Code Issues 7 Pull requests Projects Releases Activity Actions

Encoding and decoding blobs now follows the spec with regards to size #1

Merged
erikronstrom merged 3 commits from master into master 2015-08-26 09:18:09 +00:00
Conversation 1 Commits 3 Files changed 1 +79 -28
1 changed files with 79 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

105
osc.lisp
View file

@ -96,6 +96,7 @@
f => #(102) => float f => #(102) => float
s => #(115) => string s => #(115) => string
b => #(98) => blob b => #(98) => blob
h => #(104) => int64
and considers non int/float/string data to be a blob." and considers non int/float/string data to be a blob."
(let ((lump (make-array 0 :adjustable t (let ((lump (make-array 0 :adjustable t
@ -106,7 +107,7 @@
(write-to-vector #\,) (write-to-vector #\,)
(dolist (x data) (dolist (x data)
(typecase x (typecase x
(integer (write-to-vector #\i)) (integer (if (>= x 4294967296) (write-to-vector #\h) (write-to-vector #\i)))
(float (write-to-vector #\f)) (float (write-to-vector #\f))
(simple-string (write-to-vector #\s)) (simple-string (write-to-vector #\s))
(t (write-to-vector #\b))))) (t (write-to-vector #\b)))))
@ -120,7 +121,7 @@
`(setf lump (cat lump (,f x))))) `(setf lump (cat lump (,f x)))))
(dolist (x data) (dolist (x data)
(typecase x (typecase x
(integer (enc encode-int32)) (integer (if (>= x 4294967296) (enc encode-int64) (enc encode-int32)))
(float (enc encode-float32)) (float (enc encode-float32))
(simple-string (enc encode-string)) (simple-string (enc encode-string))
(t (enc encode-blob)))) (t (enc encode-blob))))
@ -174,37 +175,43 @@
i => #(105) => int32 i => #(105) => int32
f => #(102) => float f => #(102) => float
s => #(115) => string s => #(115) => string
b => #(98) => blob" b => #(98) => blob
h => #(104) => int64"
(let ((div (position 0 data))) (let ((div (position 0 data)))
(let ((tags (subseq data 1 div)) (let ((tags (subseq data 1 div))
(acc (subseq data (padded-length div))) (acc (subseq data (padded-length div)))
(result '())) (result '()))
(map 'vector (map 'vector
#'(lambda (x) #'(lambda (x)
(cond (cond
((eq x (char-code #\i)) ((eq x (char-code #\i))
(push (decode-int32 (subseq acc 0 4)) (push (decode-int32 (subseq acc 0 4))
result) result)
(setf acc (subseq acc 4))) (setf acc (subseq acc 4)))
((eq x (char-code #\f)) ((eq x (char-code #\h))
(push (decode-float32 (subseq acc 0 4)) (push (decode-uint64 (subseq acc 0 8))
result) result)
(setf acc (subseq acc 4))) (setf acc (subseq acc 8)))
((eq x (char-code #\s)) ((eq x (char-code #\f))
(let ((pointer (padded-length (position 0 acc)))) (push (decode-float32 (subseq acc 0 4))
(push (decode-string result)
(subseq acc 0 pointer)) (setf acc (subseq acc 4)))
result) ((eq x (char-code #\s))
(setf acc (subseq acc pointer)))) (let ((pointer (padded-length (position 0 acc))))
((eq x (char-code #\b)) (push (decode-string
(let* ((size (decode-int32 (subseq acc 0 4))) (subseq acc 0 pointer))
(end (padded-length (+ 4 size)))) 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)) (push (decode-blob (subseq acc 0 end))
result) result)
(setf acc (subseq acc end)))) (setf acc (subseq acc end))))
(t (error "unrecognised typetag")))) (t (error "unrecognised typetag ~a" x))))
tags) tags)
(nreverse result)))) (nreverse result))))
@ -316,6 +323,50 @@
(set-byte 3)) (set-byte 3))
buf)) buf))
(defun encode-int64 (i)
"convert an integer into a sequence of 8 bytes in network byte order."
(declare (type integer i))
(let ((buf (make-sequence
'(vector (unsigned-byte 8)) 8)))
(macrolet ((set-byte (n)
`(setf (elt buf ,n)
(logand #xff (ash i ,(* 8 (- n 7)))))))
(set-byte 0)
(set-byte 1)
(set-byte 2)
(set-byte 3)
(set-byte 4)
(set-byte 5)
(set-byte 6)
(set-byte 7))
buf))
(defun decode-uint64 (s)
"8 byte -> 64 bit unsigned int"
(let ((i (+ (ash (elt s 0) 56)
(ash (elt s 1) 48)
(ash (elt s 2) 40)
(ash (elt s 3) 32)
(ash (elt s 4) 24)
(ash (elt s 5) 16)
(ash (elt s 6) 8)
(elt s 7))))
i))
(defun decode-int64 (s)
"8 byte -> 64 bit int -> two's compliment (in network byte order)"
(let ((i (+ (ash (elt s 0) 56)
(ash (elt s 1) 48)
(ash (elt s 2) 40)
(ash (elt s 3) 32)
(ash (elt s 4) 24)
(ash (elt s 5) 16)
(ash (elt s 6) 8)
(elt s 7))))
(if (>= i #x7fffffffffffffff)
(- 0 (- #x10000000000000000 i))
i)))
;; osc-strings are unsigned bytes, padded to a 4 byte boundary ;; osc-strings are unsigned bytes, padded to a 4 byte boundary
(defun decode-string (data) (defun decode-string (data)
@ -340,7 +391,7 @@
"encodes a blob from a given vector" "encodes a blob from a given vector"
(let ((bl (length blob))) (let ((bl (length blob)))
(cat (encode-int32 bl) blob (cat (encode-int32 bl) blob
(pad (padding-length bl))))) (pad (mod (- 4 bl) 4))))) ; NOTE: cannot use (padding-length bl), as it is not the same algorithm. Blobs of 4, 8, 12 etc bytes should not be padded!
;; utility functions for osc-string/padding slonking ;; utility functions for osc-string/padding slonking