From c22a4e1389eea989526cc9dc3c3859da4fb57061 Mon Sep 17 00:00:00 2001 From: nik gaffney Date: Sun, 6 Mar 2005 20:25:01 +0800 Subject: [PATCH] roscoelite A green micaceous mineral occurring in minute scales. Various 'declares' for speed, safety and cluttering. Small bug fixes and optimi[sz]ations. darcs-hash:20050306122501-2648a-2a2946d523deea88f35d8c262352c1cfd65ef222.gz --- osc-dispatch.lisp | 22 ++++++++++++++-------- osc.lisp | 46 +++++++++++++++++++++++++--------------------- 2 files changed, 39 insertions(+), 29 deletions(-) diff --git a/osc-dispatch.lisp b/osc-dispatch.lisp index 6754a3c..862545e 100644 --- a/osc-dispatch.lisp +++ b/osc-dispatch.lisp @@ -34,11 +34,17 @@ (in-package :osc) ;; should probably be a clos object, and instantiated -(defun osc-tree () +;; for now, a hash table is enuf. + +(defun make-osc-tree () (make-hash-table :test 'equalp)) -;; lookout for leaky abstract trees.. , -;; how should this be better encapsulatd?? + +;;; ;; ;;;;;; ; ; ; ; +;; +;; register/delete and dispatch. .. +;; +;;;; ; ; ; ;; (defun dp-register (tree address function) "registers a function to respond to incoming osc message. since @@ -48,7 +54,7 @@ function)) (defun dp-remove (tree address) - "removes the function associated with the given adress.." + "removes the function associated with the given address.." (remhash address tree)) (defun dp-match (tree pattern) @@ -59,7 +65,7 @@ (defun dispatch (tree osc-message) "calls the function(s) matching the address(pattern) in the osc message with the data contained in the message" - (dolist (x (dp-match tree - (car osc-message))) - (unless (eq x NIL) - (eval `(,x ,@(cdr osc-message)))))) + (let ((pattern (car osc-message))) + (dolist (x (dp-match tree pattern)) + (unless (eq x NIL) + (eval `(,x ,@(cdr osc-message))))))) diff --git a/osc.lisp b/osc.lisp index 8939558..557dd3f 100644 --- a/osc.lisp +++ b/osc.lisp @@ -65,6 +65,8 @@ :decode-message)) (in-package :osc) + +(declaim (optimize (speed 2) (safety 1))) ;;;;;; ; ;; ; ; ; ; ; ; ; ;; @@ -74,7 +76,7 @@ (defun encode-message (address &rest data) "encodes an osc message with the given address and data." - (concatenate '(vector '(unsigned-byte 8)) + (concatenate '(vector (unsigned-byte 8)) (encode-address address) (encode-typetags data) (encode-data data))) @@ -94,7 +96,9 @@ f => #(102) => float s => #(115) => string" - (let ((lump (make-array 0 :adjustable t :fill-pointer t))) + (let ((lump (make-array 0 :adjustable t + :fill-pointer t + :element-type 'char))) (macrolet ((write-to-vector (char) `(vector-push-extend (char-code ,char) lump))) @@ -108,6 +112,7 @@ (cat lump (pad (padding-length (length lump))))))) + (defun encode-data (data) "encodes data in a format suitable for an OSC message" (let ((lump (make-array 0 :adjustable t :fill-pointer t))) @@ -121,9 +126,6 @@ (t (error "wrong type. turn back")))) lump))) -(defun encode-string (string) - (cat (map 'vector #'char-code string) - (pad-string string))) ;;;;;; ; ;; ; ; ; ; ; ; ; @@ -134,19 +136,20 @@ (defun decode-message (message) "reduces an osc message to an (address . data) pair. .." + (declare (type (vector *) message)) (let ((x (position (char-code #\,) message))) (if (eq x NIL) - (format "message contains no data.. ") - (cons (decode-address (subseq message 0 x)) - (decode-taged-data (subseq message x)))))) + (format t "message contains no data.. ") + (cons (decode-address (subseq message 0 x)) + (decode-taged-data (subseq message x)))))) (defun decode-address (address) - (coerce (map 'vector #'code-char (delete 0 address)) - 'string)) + (coerce (map 'vector #'code-char + (delete 0 address)) + 'string)) (defun decode-taged-data (data) "decodes data encoded with typetags... - NOTE: currently handles the following tags only i => #(105) => int32 f => #(102) => float @@ -181,13 +184,6 @@ tags) (nreverse result))) -(defun split-data (data) - "splits incoming data into the relevant unpadded chunks, ready for conversion .. ." - (loop for i = 0 then (1+ j) - as j = (position #\0 string :start i) - collect (subseq string i j) - while j)) - ;;;;; ; ; ;; ;; ; ; ;; @@ -208,6 +204,7 @@ #-(or sbcl cmucl) (error "cant decode floats using this implementation")) (defun decode-int32 (s) + (declare (type (simple-array integer) s)) "4 byte > 32 bit int > two's compliment (in network byte order)" (let ((i (+ (ash (elt s 0) 24) (ash (elt s 1) 16) @@ -219,17 +216,20 @@ (defun encode-int32 (i) "convert integer into a sequence of 4 bytes in network byte order." - (declare (type integer s)) - (let ((buf (make-sequence '(vector (unsigned-byte 8)) 4))) + (declare (type integer i n)) + (let ((buf (make-sequence + '(vector (unsigned-byte 8)) 4))) (macrolet ((set-byte (n) `(setf (elt buf ,n) - (logand #xff (ash i ,(* 8 (- n 3))))))) + (logand #xff (ash i ,(* 8 (- n 3))))))) (set-byte 0) (set-byte 1) (set-byte 2) (set-byte 3)) buf)) + + (defun decode-string (data) "converts a binary vector to a string and removes trailing #\nul characters" (string-trim '(#\nul) (coerce (map 'vector #'code-char data) 'string))) @@ -253,19 +253,23 @@ (defun osc-string-length (string) "determines the length required for a padded osc string" + (declare (type simple-string string)) (let ((n (length string))) (+ n (padding-length n)))) (defun padding-length (s) "returns the length of padding required for a given length of string" + (declare (type fixnum s)) (- 4 (mod s 4))) (defun pad-string (string) "returns the padding required for a given osc string" + (declare (type simple-string string)) (pad (- 4 (mod (length string) 4)))) (defun pad (n) "make a sequence of the required number of #\Nul characters" + (declare (type fixnum n)) (make-array n :initial-element 0 :fill-pointer n)) ;; end