From 271545fbad8a83dcc76934028e0de465bbbbb637 Mon Sep 17 00:00:00 2001
From: nik gaffney <nik@fo.am>
Date: Sun, 6 Mar 2005 20:47:28 +0800
Subject: [PATCH] pseudoscholastic

darcs-hash:20050306124728-2648a-e3eb0f8e6157cd343a9b7b7fe114b5894ceb5cf7.gz
---
 osc.lisp | 53 +++++++++++++++++++++++++++--------------------------
 1 file changed, 27 insertions(+), 26 deletions(-)

diff --git a/osc.lisp b/osc.lisp
index 557dd3f..7200a66 100644
--- a/osc.lisp
+++ b/osc.lisp
@@ -17,7 +17,7 @@
 ;;
 ;; requirements
 ;;
-;;  dependent on sbcl for float encoding, other suggestions welcome.
+;;  dependent on sbcl or cmucl for float encoding, other suggestions welcome.
 ;;
 ;; commentary
 ;;
@@ -57,6 +57,8 @@
 ;;    - in-package'd
 ;;  2005-03-01
 ;;    - fixed address string bug
+;;  2005-0305
+;;    - 'declare' scattering and other optimisations
 
 (defpackage :osc
   (:use :cl)
@@ -66,7 +68,7 @@
 
 (in-package :osc)
  
-(declaim (optimize (speed 2) (safety 1)))
+(declaim (optimize (speed 3) (safety 1)))
 
 ;;;;;; ;    ;;    ;     ; ;     ; ; ;         ;
 ;; 
@@ -112,7 +114,6 @@
       (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)))
@@ -127,7 +128,6 @@
       lump)))
 
 
-
 ;;;;;; ;    ;;    ;     ; ;     ; ; ;         ;
 ;; 
 ;;    decoding OSC messages
@@ -164,23 +164,23 @@
     (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 #\f))
-	       (push (decode-float32  (subseq acc 0 4)) 
-		     result)
-	       (setf acc (subseq acc 4)))
-	      ((eq x (char-code #\s))
-	       (let ((pointer (+ (padding-length (position 0 acc))
-				 (position 0 acc))))
-		 (push (decode-string 
-			(subseq acc 0 pointer))
-		       result)
-		 (setf acc (subseq acc pointer))))
-	      ((eq x (char-code #\b)) (decode-blob x))
-	      (t  (error "unrecognised typetag"))))
+	       ((eq x (char-code #\i)) 
+		(push (decode-int32 (subseq acc 0 4)) 
+		      result)
+		(setf acc (subseq acc 4)))
+	       ((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 (+ (padding-length (position 0 acc))
+				  (position 0 acc))))
+		  (push (decode-string 
+			 (subseq acc 0 pointer))
+			result)
+		  (setf acc (subseq acc pointer))))
+	       ((eq x (char-code #\b)) (decode-blob x))
+	       (t  (error "unrecognised typetag"))))
 	 tags)
     (nreverse result)))
 	
@@ -204,7 +204,7 @@
   #-(or sbcl cmucl) (error "cant decode floats using this implementation"))
 
 (defun decode-int32 (s)
- (declare (type (simple-array integer) 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)
@@ -212,7 +212,7 @@
 	      (elt s 3))))
     (if (>= i #x7fffffff)
         (- 0 (- #x100000000 i))
-      i)))
+	i)))
 
 (defun encode-int32 (i)
   "convert integer into a sequence of 4 bytes in network byte order."
@@ -220,8 +220,8 @@
   (let ((buf (make-sequence 
 	      '(vector (unsigned-byte 8)) 4)))
     (macrolet ((set-byte (n)
-			 `(setf (elt buf ,n)
-			       (logand #xff (ash i ,(* 8 (- n 3)))))))
+		 `(setf (elt buf ,n)
+			(logand #xff (ash i ,(* 8 (- n 3)))))))
       (set-byte 0)
       (set-byte 1)
       (set-byte 2)
@@ -253,8 +253,9 @@
 
 (defun osc-string-length (string)
   "determines the length required for a padded osc string"
-  (declare (type simple-string string)) 
+  (declare (type simple-string string))
   (let ((n (length string)))
+    (declare (type fixnum n))
     (+ n (padding-length n))))
 
 (defun padding-length (s)