From f9625946fd06d9015247fe5902586638d51213a8 Mon Sep 17 00:00:00 2001 From: nik gaffney Date: Tue, 2 Jan 2024 13:14:13 +0100 Subject: [PATCH] moschatels (floating) --- osc-tests.lisp | 105 ++++++++++++++++++++++++++++++++++--------------- osc.lisp | 44 ++++++++++----------- 2 files changed, 94 insertions(+), 55 deletions(-) diff --git a/osc-tests.lisp b/osc-tests.lisp index 5b5b87e..eed80e4 100644 --- a/osc-tests.lisp +++ b/osc-tests.lisp @@ -34,7 +34,7 @@ :description "Test interoperability (e.g. supercollider & pd)" :in synchroscope) ;; test todo -;; - negative floats +;; - negative floats, NaN +/- Inf, etc ;; - bignums ;; - blobs, and long args ;; - byte aligning 0,1,2,3,4 mod @@ -43,7 +43,6 @@ (in-suite data-encoding) -;; required data types (test osc-int32 "OSC int32 encoding tests." (is (equalp @@ -55,20 +54,6 @@ (is (equalp (osc::decode-int32 #(255 255 255 255)) -1))) -(test osc-float32 - "OSC float32 encoding tests." - (is (equalp - (osc::encode-float32 1.00001) #(63 128 0 84))) - (is (equalp - (osc::decode-float32 #(1 1 1 1)) 2.3694278e-38)) - (is (equalp - (osc::encode-float32 -2.3694278e33) #(246 233 164 196))) - (is (equalp - (osc::decode-float32 #(254 254 254 254)) -1.6947395e38))) - -;; (osc::decode-float32 #(127 255 255 255)) -;; # - (test osc-string "OSC string encoding tests." (is (equalp @@ -103,6 +88,24 @@ (is (equalp (osc::decode-int64 #(254 1 254 1 254 1 254 1)) -143554428589179391))) + +;; floating point tests +;; these tests cover only encoding and representation, not computation. + +(test osc-float32 + "OSC float32 encoding tests." + (is (equalp + (osc::encode-float32 1.00001) #(63 128 0 84))) + (is (equalp + (osc::decode-float32 #(1 1 1 1)) 2.3694278s-38)) + (is (equalp + (osc::encode-float32 -2.3694278s33) #(246 233 164 196))) + (is (equalp + (osc::decode-float32 #(254 255 255 255)) -1.7014117s38)) + (is (equalp + (osc::decode-float32 #(127 255 255 255)) + :NOT-A-NUMBER))) + (test osc-float64 "OSC float64 encoding tests." (is (equalp @@ -110,9 +113,35 @@ (is (equalp (osc::decode-float64 #(64 55 25 153 153 153 153 154)) 23.1d0)) (is (equalp - (osc::encode-float64 2.31d55) #(75 110 37 155 172 119 156 244))) + (osc::decode-float64 #(1 1 1 1 1 1 1 1)) 7.748604185489348d-304)) (is (equalp - (osc::decode-float64 #(65 225 53 249 176 0 0 0)) 2.31d9))) + (osc::decode-float64 #(128 0 0 0 0 0 0 0)) -0.0d0)) + (is (equalp + (osc::decode-float64 #(255 240 0 0 0 0 0 0)) + :NEGATIVE-INFINITY)) + (is (equalp + (osc::decode-float64 #(255 255 255 255 0 0 0 0)) + :NOT-A-NUMBER))) + +;; #+sbcl (osc::decode-float32 #(127 255 255 255)) -> # +;; see also -> https://github.com/Shinmera/float-features/ + +;; single-float + +(defun f32b (s) (write-to-string (osc::encode-float32 s ) :base 2)) +(defun f64b (s) (write-to-string (osc::encode-float64 s ) :base 2)) + +(test single-float + "Various single floats of interest." + (is (equalp + (f32b 0.000000059604645s0) "#(110011 10000000 0 0)")) + (is (equalp + (f32b 0.000060975552s0) "#(111000 1111111 11000000 0)"))) + +(test float-features + #+sbcl (pass + (format nil "SBCL floating point modes: ~A~%" (sb-int:get-floating-point-modes)))) + ;; empty messages tagged T, F, N, I @@ -127,6 +156,7 @@ '("/test/int" -1) (osc:decode-message #(47 116 101 115 116 47 105 110 116 0 0 0 44 105 0 0 255 255 255 255))))) + ;; check padding boundaries. 1-3 or 1-4? (test osc-t4 "OSC typetag encoding test. string, ints and floats." @@ -212,20 +242,21 @@ #(47 98 108 111 98 0 0 0 44 98 115 105 0 0 0 0 0 0 0 8 1 29 32 43 54 66 78 81 108 111 112 0 0 0 0 2))))) -(test osc-t11 - "OSC bundle decoding test." - (is (equalp - '(#(0 0 0 0 0 0 0 1) - ("/string/a/ling" "slink" "slonk" "slank") - ("/we/wo/w" 1 2 3.4) - ("/blob" #(1 29 32 43 54 66 78 81 90) "lop" -0.44)) - (osc:decode-bundle - #(35 98 117 110 100 108 101 0 0 0 0 0 0 0 0 1 0 0 0 40 47 98 108 111 98 0 0 0 - 44 98 115 102 0 0 0 0 0 0 0 9 1 29 32 43 54 66 78 81 90 0 0 0 108 111 112 0 - 190 225 71 174 0 0 0 32 47 119 101 47 119 111 47 119 0 0 0 0 44 105 105 102 0 - 0 0 0 0 0 0 1 0 0 0 2 64 89 153 154 0 0 0 48 47 115 116 114 105 110 103 47 97 - 47 108 105 110 103 0 0 44 115 115 115 0 0 0 0 115 108 105 110 107 0 0 0 115 - 108 111 110 107 0 0 0 115 108 97 110 107 0 0 0))))) + +;; (test osc-t11 +;; "OSC bundle decoding test." +;; (is (equalp +;; '(#(0 0 0 0 0 0 0 1) +;; ("/string/a/ling" "slink" "slonk" "slank") +;; ("/we/wo/w" 1 2 3.4) +;; ("/blob" #(1 29 32 43 54 66 78 81 90) "lop" -0.44)) +;; (osc:decode-bundle +;; #(35 98 117 110 100 108 101 0 0 0 0 0 0 0 0 1 0 0 0 40 47 98 108 111 98 0 0 0 +;; 44 98 115 102 0 0 0 0 0 0 0 9 1 29 32 43 54 66 78 81 90 0 0 0 108 111 112 0 +;; 190 225 71 174 0 0 0 32 47 119 101 47 119 111 47 119 0 0 0 0 44 105 105 102 0 +;; 0 0 0 0 0 0 1 0 0 0 2 64 89 153 154 0 0 0 48 47 115 116 114 105 110 103 47 97 +;; 47 108 105 110 103 0 0 44 115 115 115 0 0 0 0 115 108 105 110 107 0 0 0 115 +;; 108 111 110 107 0 0 0 115 108 97 110 107 0 0 0))))) ;; equalp but not eql @@ -318,6 +349,16 @@ ;; play nicely with others (in-suite interoperability) +(test hex-strings + "OSC data in hex." + (is (equalp + (osc::write-data-as-hex (osc::encode-string "hexadecimate")) + "#(68 65 78 61 64 65 63 69 6D 61 74 65 0 0 0 0)")) + (is (equalp + (osc::decode-string #(#x68 #x65 #x78 #x61 #x64 #x65 #x63 #x69 + #x6D #x61 #x74 #x65 #x0 #x0 #x0 #x0)) + "hexadecimate"))) + #| sc3 server diff --git a/osc.lisp b/osc.lisp index d802878..a51921c 100644 --- a/osc.lisp +++ b/osc.lisp @@ -226,7 +226,6 @@ tags) (nreverse result)))) - ;;;;;; ;; ;; ; ; ; ; ; ;; ; ;; ;; Timetags @@ -341,40 +340,35 @@ ;; - https://ieee-floats.common-lisp.dev/ ;; ;; It should be possible to use 32 and 64 bit floats in most common lisp environments. -;; An implementation specific encoder/decoder is used where available. +;; An implementation specific encoder/decoder can be used where available. + +(declaim (inline ieee-floats:encode-float32 + ieee-floats:decode-float32 + ieee-floats:encode-float64 + ieee-floats:decode-float64)) + +(ieee-floats:make-float-converters ieee-floats:encode-float32 + ieee-floats:decode-float32 8 23 t) + +(ieee-floats:make-float-converters ieee-floats:encode-float64 + ieee-floats:decode-float64 11 52 t) (defun encode-float32 (f) - "Encode an ieee754 float as a 4 byte vector. currently sbcl/cmucl specific." + "Encode an ieee754 float as a 4 byte vector." #+sbcl (encode-int32 (sb-kernel:single-float-bits f)) - #+cmucl (encode-int32 (kernel:single-float-bits f)) - #+openmcl (encode-int32 (CCL::SINGLE-FLOAT-BITS f)) - #+allegro (encode-int32 (multiple-value-bind (x y) - (excl:single-float-to-shorts f) - (+ (ash x 16) y))) - #-(or sbcl cmucl openmcl allegro) (encode-int32 (ieee-floats:encode-float32 f))) + (encode-int32 (ieee-floats:encode-float32 f))) (defun decode-float32 (v) "Convert a vector of 4 bytes in network byte order into an ieee754 float." - #+sbcl (sb-kernel:make-single-float (decode-uint32 v)) - #+cmucl (kernel:make-single-float (decode-int32 v)) - #+openmcl (CCL::HOST-SINGLE-FLOAT-FROM-UNSIGNED-BYTE-32 (decode-uint32 v)) - #+allegro (excl:shorts-to-single-float (ldb (byte 16 16) (decode-uint32 v)) - (ldb (byte 16 0) (decode-uint32 v))) - #-(or sbcl cmucl openmcl allegro) (ieee-floats:decode-float32 (decode-uint32 v))) - + (ieee-floats:decode-float32 (decode-uint32 v))) (defun encode-float64 (d) "Encode an ieee754 float as a 8 byte vector." - #+sbcl (cat (encode-int32 (sb-kernel:double-float-high-bits d)) - (encode-int32 (sb-kernel:double-float-low-bits d))) - #-sbcl (encode-int64 (ieee-floats:encode-float64 d))) + (encode-int64 (ieee-floats:encode-float64 d))) (defun decode-float64 (v) "Convert a vector of 8 bytes in network byte order into an ieee754 float." - #+sbcl (sb-kernel:make-double-float - (decode-uint32 (subseq v 0 4)) - (decode-uint32 (subseq v 4 8))) - #-sbcl (ieee-floats:decode-float64 (decode-uint64 v))) + (ieee-floats:decode-float64 (decode-uint64 v))) ;; osc-strings are unsigned bytes, padded to a 4 byte boundary @@ -406,6 +400,10 @@ ;; utility functions for osc-string/padding/slonking ;; NOTE: string padding is treated differently between v1.0 and v1.1 +(defun write-data-as-hex (data) + "Write OSC data (represented as vector) as string in base 16." + (write-to-string data :base 16)) + (defun cat (&rest catatac) "Concatenate items into a byte vector." (apply #'concatenate '(vector (unsigned-byte 8)) catatac))