Preparing to make portable, if possible

abstract-tag.lisp

@@ -40,6 +40,7 @@
 
 (defun get-id3v1-genre (n)
   "Given N, a supposed ID3 genre, range check it to make sure it is > 0 and < (sizeof *ID3V1-GENRES*)"
+  (declare #.utils:*standard-optimize-settings*)
   (if (or (> n (1- (length *id3v1-genres*)))
             (< n 0))
         "BAD GENRE"
@@ -57,6 +58,7 @@
 
 ;;; The following probably should be macro-ized in the future---lots of cut/paste going on...
 (defmethod album ((me mp3-file-stream))
+  (declare #.utils:*standard-optimize-settings*)
   (let ((frames (get-frames me '("TAL" "TALB"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one album tag")
@@ -66,6 +68,7 @@
       nil))
 
 (defmethod artist ((me mp3-file-stream))
+  (declare #.utils:*standard-optimize-settings*)
   (let ((frames (get-frames me '("TP1" "TPE1"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one artist tag")
@@ -75,6 +78,7 @@
       nil))
 
 (defmethod comment ((me mp3-file-stream))
+  (declare #.utils:*standard-optimize-settings*)
   (let ((frames (get-frames me '("COM" "COMM"))))
     (when frames
       (let ((new-frames))
@@ -87,6 +91,7 @@
       nil))
 
 (defmethod year ((me mp3-file-stream))
+  (declare #.utils:*standard-optimize-settings*)
   (let ((frames (get-frames me '("TRD" "TDRC"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one year tag")
@@ -96,6 +101,7 @@
       nil))
 
 (defmethod title ((me mp3-file-stream))
+  (declare #.utils:*standard-optimize-settings*)
   (let ((frames (get-frames me '("TT2" "TIT2"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one title tag")
@@ -105,6 +111,7 @@
       nil))
 
 (defmethod genre ((me mp3-file-stream))
+  (declare #.utils:*standard-optimize-settings*)
   (let ((frames (get-frames me '("TCO" "TCON"))))
     (when frames
       (when (> (length frames) 1)
@@ -134,6 +141,7 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; no V2.1 tags for any of these ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defmethod album-artist ((me mp3-file-stream))
+  (declare #.utils:*standard-optimize-settings*)
   (let ((frames (get-frames me '("TP2" "TPE2"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one album-artist tag")
@@ -141,6 +149,7 @@
   nil)
 
 (defmethod composer ((me mp3-file-stream))
+  (declare #.utils:*standard-optimize-settings*)
   (let ((frames (get-frames me '("TCM" "TCOM"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one composer tag")
@@ -148,6 +157,7 @@
   nil)
 
 (defmethod copyright ((me mp3-file-stream))
+  (declare #.utils:*standard-optimize-settings*)
   (let ((frames (get-frames me '("TCR" "TCOP"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one copyright tag")
@@ -155,6 +165,7 @@
   nil)
 
 (defmethod encoder ((me mp3-file-stream))
+  (declare #.utils:*standard-optimize-settings*)
   (let ((frames (get-frames me '("TEN" "TENC"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one encoder tag")
@@ -162,6 +173,7 @@
   nil)
 
 (defmethod groups ((me mp3-file-stream))
+  (declare #.utils:*standard-optimize-settings*)
   (let ((frames (get-frames me '("TT1" "TTE1"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one group tag")
@@ -169,6 +181,7 @@
   nil)
 
 (defmethod lyrics ((me mp3-file-stream))
+  (declare #.utils:*standard-optimize-settings*)
   (let ((frames (get-frames me '("ULT" "USLT"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one lyrics tag")
@@ -176,6 +189,7 @@
   nil)
 
 (defmethod writer ((me mp3-file-stream))
+  (declare #.utils:*standard-optimize-settings*)
   (let ((frames (get-frames me '("TCM" "TCOM"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one composer tag")
@@ -183,6 +197,7 @@
   nil)
 
 (defmethod compilation ((me mp3-file-stream))
+  (declare #.utils:*standard-optimize-settings*)
   (let ((frames (get-frames me '("TCMP"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one compilation tag")
@@ -191,6 +206,7 @@
   nil)
 
 (defmethod disk ((me mp3-file-stream))
+  (declare #.utils:*standard-optimize-settings*)
   (let ((frames (get-frames me '("TPA" "TPOS"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one disk number tag")
@@ -198,6 +214,7 @@
   nil)
 
 (defmethod tempo ((me mp3-file-stream))
+  (declare #.utils:*standard-optimize-settings*)
   (let ((frames (get-frames me '("TBP" "TBPM"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one tempo tag")
@@ -205,12 +222,14 @@
   nil)
 
 (defun mk-lst (str)
+  (declare #.utils:*standard-optimize-settings*)
   (let ((pos (position #\/ str)))
     (if (null pos)
         (list str)
         (list (subseq str 0 pos) (subseq str (+ 1 pos))))))
 
 (defmethod track ((me mp3-file-stream))
+  (declare #.utils:*standard-optimize-settings*)
   (let ((frames (get-frames me '("TRK" "TRCK"))))
     (when frames
       (assert (= 1 (length frames)) () "There can be only one track number tag")
@@ -219,6 +238,7 @@
 
 (defmethod show-tags ((me mp3-file-stream) &key (raw *raw-tags*))
   "Show the tags for an mp3-file.  If RAW is non-nil, dump all the frames; else, print out a subset."
+  (declare #.utils:*standard-optimize-settings*)
   (if raw
       (format t "~a~%~a~%" (stream-filename me)
               (with-output-to-string (s)

audio-streams.lisp

@@ -40,19 +40,25 @@
   "Stream initializer. If STREAM-FILENAME is set, MMAP a the file. Else, we assume VECT was set."
   (with-mem-stream-slots (stream)
     (when stream-filename
-      (setf vect (ccl:map-file-to-octet-vector stream-filename)))
+      #+CCL (setf vect (ccl:map-file-to-octet-vector stream-filename))
+      #-CCL (error "Not Yet!")
+      )
     (setf stream-size (length vect))))
 
 (defmethod stream-close ((stream mem-stream))
   "Close a stream, making the underlying object (file or vector) inaccessible."
+  (declare #.utils:*standard-optimize-settings*)
   (with-mem-stream-slots (stream)
     (when stream-filename
-      (ccl:unmap-octet-vector vect))
+      #+CCL (ccl:unmap-octet-vector vect)
+      #-CCL (error "Not Yet")
+      )
     (setf vect nil)))
 
 (defmethod stream-seek ((stream mem-stream) &optional (offset 0) (from :current))
   "Set INDEX to requested value.  No error checking done here, but subsequent reads will fail if INDEX is out-of-bounds.
 As a convenience, OFFSET and FROM are optional, so (STREAM-SEEK stream) returns the current read-offset in stream."
+  (declare #.utils:*standard-optimize-settings*)
   (with-mem-stream-slots (stream)
     (ecase from
       (:start                  ; INDEX set to OFFSET from start of stream
@@ -66,25 +72,25 @@ As a convenience, OFFSET and FROM are optional, so (STREAM-SEEK stream) returns
 
 (defun read-n-bytes (stream n-bytes &key (bits-per-byte 8) (endian :little-endian))
   "Returns a FIXNUM constructed by reading N-BYTES.  BITS-PER-BYTE contols how many bits should be used from each read byte."
-  (fastest
-    (with-mem-stream-slots (stream)
-      (declare (integer index n-bytes stream-size))
-      (when (<= (+ index n-bytes) stream-size)
-        (ecase endian
-          (:little-endian
-           (loop with value = 0
-                 for low-bit downfrom (* bits-per-byte (1- n-bytes)) to 0 by bits-per-byte do
-                   (setf (ldb (byte bits-per-byte low-bit) value) (aref vect index))
-                   (incf index)
-                 finally (return-from read-n-bytes value)))
-          (:big-endian
-           (loop with value = 0
-                 for low-bit upfrom 0 to (* bits-per-byte (1- n-bytes)) by bits-per-byte do
-                   (setf (ldb (byte bits-per-byte low-bit) value) (aref vect index))
-                   (incf index)
-                 finally (return-from read-n-bytes value))))))
-    nil))
-
+  (declare #.utils:*standard-optimize-settings*)
+  (with-mem-stream-slots (stream)
+    (when (<= (+ index n-bytes) stream-size)
+      (ecase endian
+        (:little-endian
+         (loop with value = 0
+               for low-bit downfrom (* bits-per-byte (1- n-bytes)) to 0 by bits-per-byte do
+                 (setf (ldb (byte bits-per-byte low-bit) value) (aref vect index))
+                 (incf index)
+               finally (return-from read-n-bytes value)))
+        (:big-endian
+         (loop with value = 0
+               for low-bit upfrom 0 to (* bits-per-byte (1- n-bytes)) by bits-per-byte do
+                 (setf (ldb (byte bits-per-byte low-bit) value) (aref vect index))
+                 (incf index)
+               finally (return-from read-n-bytes value))))))
+    nil)
+
+;;; XXX Not sure this does anything...
 (declaim (inline read-n-bytes))
 
 (defmethod stream-read-u8   ((stream mem-stream) &key (bits-per-byte 8)) (read-n-bytes stream 1 :bits-per-byte bits-per-byte))
@@ -97,8 +103,8 @@ As a convenience, OFFSET and FROM are optional, so (STREAM-SEEK stream) returns
 (defmethod stream-read-sequence ((stream mem-stream) size &key (bits-per-byte 8))
   "Read in a sequence of octets at BITS-PER-BYTE.  If BITS-PER-BYTE == 8, then simply return
 a displaced array from STREAMs underlying vector.  If it is == 7, then we have to create a new vector and read into that."
-  (fastest
-    (with-mem-stream-slots (stream)
+  (declare #.utils:*standard-optimize-settings*)
+  (with-mem-stream-slots (stream)
       (when (> (+ index size) stream-size)
         (setf size (- stream-size index)))
       (ecase bits-per-byte
@@ -108,15 +114,18 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
         (7
          (let* ((last-byte-was-FF nil)
                 (byte nil)
-                (octets (ccl:with-output-to-vector (out)
-                          (dotimes (i size)
-                            (setf byte (stream-read-u8 stream))
-                            (if last-byte-was-FF
-                                (if (not (zerop byte))
-                                    (write-byte byte out))
-                                (write-byte byte out))
-                            (setf last-byte-was-FF (= byte #xFF))))))
-           (values octets size)))))))
+                (octets
+                  #-CCL (error "Not yet")
+                  #+CCL  (ccl:with-output-to-vector (out)
+                           (dotimes (i size)
+                             (setf byte (stream-read-u8 stream))
+                             (if last-byte-was-FF
+                                 (if (not (zerop byte))
+                                     (write-byte byte out))
+                                 (write-byte byte out))
+                             (setf last-byte-was-FF (= byte #xFF))))
+                  ))
+           (values octets size))))))
 
 (defclass mp3-file-stream (mem-stream)
   ((id3-header :accessor id3-header :initform nil :documentation "holds all the ID3 info")
@@ -136,31 +145,35 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
 
 (defun make-file-stream (filename)
   "Convenience function for creating a file stream. Detects file type and returns proper type stream."
-  (let* ((new-stream (make-mmap-stream filename))
-         (ret-stream))
-
-    ;; detect file type and make RET-STREAM.  if we don't recognize stream, RET-STREAM will be NULL
-    (cond ((mp4-atom:is-valid-m4-file new-stream)
-           (setf ret-stream (make-instance 'mp4-file-stream :vect (vect new-stream) :stream-filename (stream-filename new-stream))))
-          ((flac-frame:is-valid-flac-file new-stream)
-           (setf ret-stream (make-instance 'flac-file-stream :vect (vect new-stream) :stream-filename (stream-filename new-stream))))
-          ((id3-frame:is-valid-mp3-file new-stream)
-           (setf ret-stream (make-instance 'mp3-file-stream :vect (vect new-stream) :stream-filename (stream-filename new-stream)))))
-    (stream-close new-stream)
-    ret-stream))
+  (declare #.utils:*standard-optimize-settings*)
+  (log5:with-context "make-file-stream"
+    (let* ((new-stream (make-mmap-stream filename))
+           (ret-stream))
+
+      (log-stream "Looking at ~a" filename)
+      ;; detect file type and make RET-STREAM.  if we don't recognize stream, RET-STREAM will be NULL
+      (cond ((mp4-atom:is-valid-m4-file new-stream)
+             (log-stream "~a is an MP4 file" filename)
+             (setf ret-stream (make-instance 'mp4-file-stream :vect (vect new-stream) :stream-filename (stream-filename new-stream))))
+            ((flac-frame:is-valid-flac-file new-stream)
+             (log-stream "~a is a FLAC file" filename)
+             (setf ret-stream (make-instance 'flac-file-stream :vect (vect new-stream) :stream-filename (stream-filename new-stream))))
+            ((id3-frame:is-valid-mp3-file new-stream)
+             (log-stream "~a is an ID3 file" filename)
+             (setf ret-stream (make-instance 'mp3-file-stream :vect (vect new-stream) :stream-filename (stream-filename new-stream))))
+            (t
+             (log-stream "Unkown file type")))
+      (stream-close new-stream)
+      ret-stream)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Strings ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-;;; We need to be able to decode many types of string formats, so we borrow and extend
-;;; the constants embedded in the ID3 "spec."
-(defconstant +enc-iso-8859+ 0 "normal 8-bit Latin encoding")
-(defconstant +enc-ucs+      1 "universal character set, 16-bit, uses initial Byte Order Mark (BOM) to determine endianess")
-(defconstant +enc-ucs-be+   2 "universal character set, 16-bit, big-endian, no BOM")
-(defconstant +enc-utf-8+    3 "UCS transformation format, 8-bit as neeed")
-
 ;;; Decode octets as an iso-8859-1 string (encoding == 0)
 (defun stream-decode-iso-string (octets &key (start 0) (end nil))
-  (ccl:decode-string-from-octets octets :start start :end end :external-format :iso-8859-1))
+  (declare #.utils:*standard-optimize-settings*)
+  #+CCL (ccl:decode-string-from-octets octets :start start :end end :external-format :iso-8859-1)
+  #-CCL (error "Not Yet")
+  )
 
 ;;;
 ;;; XXX: Coded this way because I can't seem to get a simple :external-format :ucs-2 to work correctly
@@ -168,39 +181,51 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
 ;;; sometimes encoded as #(00 00))
 (defun stream-decode-ucs-string (octets &key (start 0) (end nil))
   "Decode octets as a UCS string with a BOM (encoding == 1)"
-    (labels ((get-byte-order-mark (octets)
-               (let ((retval 0))
-                 (setf (ldb (byte 8 0) retval) (aref octets 1))
-                 (setf (ldb (byte 8 8) retval) (aref octets 0))
-                 (when (not (or (= #xfffe retval) (= #xfeff retval)))
-                   (error 'audio-stream-condition
-                          :location "stream-decode-ucs-string"
-                          :object nil
-                          :message (format nil "got an invalid byte-order mark of ~x" retval)))
-                 retval)))
-
-      ;; special case: empty (and mis-coded) string
-      (cond ((zerop (length octets))
-             (make-string 0))
-            (t
-             ;;
-             ;; else, we have a (hopefully) properly encoded string
-             (let ((bom (get-byte-order-mark octets)))
-               (ecase (the fixnum bom)
-                 (#xfffe (ccl:decode-string-from-octets octets :start (+ 2 start) :end end :external-format :ucs-2le))
-                 (#xfeff (ccl:decode-string-from-octets octets :start (+ 2 start) :end end :external-format :ucs-2be))
-                 (0      (make-string 0))))))))
+  (declare #.utils:*standard-optimize-settings*)
+  (labels ((get-byte-order-mark (octets)
+             (let ((retval 0))
+               (setf (ldb (byte 8 0) retval) (aref octets 1))
+               (setf (ldb (byte 8 8) retval) (aref octets 0))
+               (when (not (or (= #xfffe retval) (= #xfeff retval)))
+                 (error 'audio-stream-condition
+                        :location "stream-decode-ucs-string"
+                        :object nil
+                        :message (format nil "got an invalid byte-order mark of ~x" retval)))
+               retval)))
+
+    ;; special case: empty (and mis-coded) string
+    (cond ((zerop (length octets))
+           (make-string 0))
+          (t
+           ;;
+           ;; else, we have a (hopefully) properly encoded string
+           (let ((bom (get-byte-order-mark octets)))
+             (ecase (the fixnum bom)
+               (#xfffe #+CCL (ccl:decode-string-from-octets octets :start (+ 2 start) :end end :external-format :ucs-2le)
+                       #-CCL (error "Not Yet")
+                       )
+               (#xfeff #+CCL (ccl:decode-string-from-octets octets :start (+ 2 start) :end end :external-format :ucs-2be)
+                       #-CCL (error "Not Yet")
+                       )
+               (0      (make-string 0))))))))
 
 (defun stream-decode-ucs-be-string (octets &key (start 0) (end nil))
   "Decode octets as a UCS-BE string (encoding == 2)"
-  (ccl:decode-string-from-octets octets :start start :end end :external-format :ucs-2be))
+  (declare #.utils:*standard-optimize-settings*)
+  #+CCL (ccl:decode-string-from-octets octets :start start :end end :external-format :ucs-2be)
+  #-CCL (error "Not Yet")
+  )
 
 (defun stream-decode-utf-8-string (octets &key (start 0) (end nil))
   "Decode octets as a utf-8 string"
-  (ccl:decode-string-from-octets octets :start start :end end :external-format :utf-8))
+  (declare #.utils:*standard-optimize-settings*)
+  #+CCL (ccl:decode-string-from-octets octets :start start :end end :external-format :utf-8)
+  #-CCL (error "Not Yet")
+  )
 
 (defun stream-decode-string (octets &key (start 0) (end nil) (encoding 0))
   "Decode octets depending on encoding"
+  (declare #.utils:*standard-optimize-settings*)
   (ecase encoding
     (0 (stream-decode-iso-string octets    :start start :end end))
     (1 (stream-decode-ucs-string octets    :start start :end end))
@@ -209,90 +234,109 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
 
 (defmethod stream-read-iso-string-with-len ((instream mem-stream) len)
   "Read an iso-8859-1 string of length 'len' (encoding = 0)"
+  (declare #.utils:*standard-optimize-settings*)
   (stream-decode-iso-string (stream-read-sequence instream len)))
 
 (defmethod stream-read-ucs-string-with-len ((instream mem-stream) len)
   "Read an ucs-2 string of length 'len' (encoding = 1)"
+  (declare #.utils:*standard-optimize-settings*)
   (stream-decode-ucs-string (stream-read-sequence instream len)))
 
 (defmethod stream-read-ucs-be-string-with-len ((instream mem-stream) len)
   "Read an ucs-2-be string of length 'len' (encoding = 2)"
+  (declare #.utils:*standard-optimize-settings*)
   (stream-decode-ucs-be-string (stream-read-sequence instream len)))
 
 (defmethod stream-read-utf-8-string-with-len ((instream mem-stream) len)
   "Read an utf-8 string of length 'len' (encoding = 3)"
+  (declare #.utils:*standard-optimize-settings*)
   (stream-decode-utf-8-string  (stream-read-sequence instream len)))
 
 (defmethod stream-read-string-with-len ((instream mem-stream) len &key (encoding 0))
   "Read in a string of a given encoding of length 'len'"
+  (declare #.utils:*standard-optimize-settings*)
   (ecase encoding
-    (+enc-iso-8859+ (stream-read-iso-string-with-len instream len))
-    (+enc-ucs+      (stream-read-ucs-string-with-len instream len))
-    (+enc-ucs-be+   (stream-read-ucs-be-string-with-len instream len))
-    (+enc-utf-8+    (stream-read-utf-8-string-with-len instream len))))
+    (0 (stream-read-iso-string-with-len instream len))
+    (1 (stream-read-ucs-string-with-len instream len))
+    (2 (stream-read-ucs-be-string-with-len instream len))
+    (3 (stream-read-utf-8-string-with-len instream len))))
 
 (defmethod stream-read-iso-string ((instream mem-stream))
   "Read in a null terminated iso-8859-1 string"
-  (let ((octets (ccl:with-output-to-vector (out)
-                  (do ((b (stream-read-u8 instream) (stream-read-u8 instream)))
-                      (nil)
-                    (when (zerop b)
-                      (return))         ; leave loop w/o writing
-                    (write-byte b out)))))
+  (declare #.utils:*standard-optimize-settings*)
+  (let ((octets #+CCL (ccl:with-output-to-vector (out)
+                        (do ((b (stream-read-u8 instream) (stream-read-u8 instream)))
+                            (nil)
+                          (when (zerop b)
+                            (return))   ; leave loop w/o writing
+                          (write-byte b out)))
+                #-CCL (error "Not Yet")
+        ))
     (stream-decode-iso-string octets)))
 
 (defmethod stream-read-ucs-string ((instream mem-stream))
   "Read in a null terminated UCS string."
-  (let ((octets (ccl:with-output-to-vector (out)
-                  (do* ((b0 (stream-read-u8 instream)
-                            (stream-read-u8 instream))
-                        (b1 (stream-read-u8 instream)
-                            (stream-read-u8 instream)))
-                       (nil)
-                    (when (and (zerop b0) (zerop b1))
-                      (return))
-                    (write-byte b0 out)
-                    (write-byte b1 out)))))
+  (declare #.utils:*standard-optimize-settings*)
+  (let ((octets #+CCL (ccl:with-output-to-vector (out)
+                        (do* ((b0 (stream-read-u8 instream)
+                                  (stream-read-u8 instream))
+                              (b1 (stream-read-u8 instream)
+                                  (stream-read-u8 instream)))
+                             (nil)
+                          (when (and (zerop b0) (zerop b1))
+                            (return))
+                          (write-byte b0 out)
+                          (write-byte b1 out)))
+                #-CCL (error "Not Yet")
+                ))
     (stream-decode-ucs-string octets)))
 
 (defmethod stream-read-ucs-be-string ((instream mem-stream))
   "Read in a null terminated UCS-BE string."
-  (let ((octets (ccl:with-output-to-vector (out)
-                  (do* ((b0 (stream-read-u8 instream)
-                            (stream-read-u8 instream))
-                        (b1 (stream-read-u8 instream)
-                            (stream-read-u8 instream)))
-                       (nil)
-                    (when (and (zerop b0) (zerop b1))
-                      (return))
-                    (write-byte b0 out)
-                    (write-byte b1 out)))))
+  (declare #.utils:*standard-optimize-settings*)
+  (let ((octets #+CCL (ccl:with-output-to-vector (out)
+                        (do* ((b0 (stream-read-u8 instream)
+                                  (stream-read-u8 instream))
+                              (b1 (stream-read-u8 instream)
+                                  (stream-read-u8 instream)))
+                             (nil)
+                          (when (and (zerop b0) (zerop b1))
+                            (return))
+                          (write-byte b0 out)
+                          (write-byte b1 out)))
+                #-CCL (error "Not Yet")
+                ))
     (stream-decode-ucs-be-string octets)))
 
 (defmethod stream-read-utf-8-string ((instream mem-stream))
   "Read in a null terminated utf-8 string (encoding == 3)"
-  (let ((octets (ccl:with-output-to-vector (out)
-                  (do ((b (stream-read-u8 instream)
-                          (stream-read-u8 instream)))
-                      (nil)
-                    (when (zerop b)
-                      (return))
-                    (write-byte b out)))))
+  (declare #.utils:*standard-optimize-settings*)
+  (let ((octets #+CCL (ccl:with-output-to-vector (out)
+                        (do ((b (stream-read-u8 instream)
+                                (stream-read-u8 instream)))
+                            (nil)
+                          (when (zerop b)
+                            (return))
+                          (write-byte b out)))
+                #-CCL (error "Not Yet")
+                ))
     (stream-decode-utf-8-string octets)))
 
 (defmethod stream-read-string ((instream mem-stream) &key (encoding 0))
   "Read in a null terminated string of a given encoding."
+  (declare #.utils:*standard-optimize-settings*)
   (ecase encoding
-    (+enc-iso-8859+ (stream-read-iso-string    instream))
-    (+enc-ucs+      (stream-read-ucs-string    instream))
-    (+enc-ucs-be+   (stream-read-ucs-be-string instream))
-    (+enc-utf-8+    (stream-read-utf-8-string  instream))))
+    (0 (stream-read-iso-string    instream))
+    (1 (stream-read-ucs-string    instream))
+    (2 (stream-read-ucs-be-string instream))
+    (3 (stream-read-utf-8-string  instream))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defvar *get-audio-info* t "controls whether the parsing functions also parse audio info like bit-rate, etc")
 
 (defmethod parse-audio-file ((stream mp4-file-stream) &key (get-audio-info *get-audio-info*) &allow-other-keys)
   "Parse an MP4A file by reading it's ATOMS and decoding them."
+  (declare #.utils:*standard-optimize-settings*)
   (handler-case
       (progn
         (mp4-atom:find-mp4-atoms stream)
@@ -303,6 +347,7 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
 
 (defmethod parse-audio-file ((stream flac-file-stream) &key (get-audio-info *get-audio-info*) &allow-other-keys)
   "Parse a flac file by reading it's headers and decoding them."
+  (declare #.utils:*standard-optimize-settings*)
   (declare (ignore get-audio-info)) ; audio info comes for "free" by parsing headers
   (handler-case
       (flac-frame:find-flac-frames stream)
@@ -311,6 +356,7 @@ a displaced array from STREAMs underlying vector.  If it is == 7, then we have t
 
 (defmethod parse-audio-file ((stream mp3-file-stream) &key (get-audio-info *get-audio-info*) &allow-other-keys)
   "Parse an MP3 file by reading it's FRAMES and decoding them."
+  (declare #.utils:*standard-optimize-settings*)
   (handler-case
       (progn
         (id3-frame:find-id3-frames stream)

id3-frame.lisp

@@ -31,31 +31,35 @@
 (defun is-valid-mp3-file (mp3-file)
   "Make sure this is an MP3 file. Look for ID3 header at begining (versions 2, 3, 4) and/or end (version 2.1)
 Written in this fashion so as to be 'crash-proof' when passed an arbitrary file."
+  (declare #.utils:*standard-optimize-settings*)
 
   (log5:with-context "is-valid-mp3-file"
     (let ((id3)
           (valid nil)
           (version)
           (tag))
-      (unwind-protect
-           (handler-case
-               (progn
-                 (stream-seek mp3-file 0 :start)
-                 (setf id3 (stream-read-string-with-len mp3-file 3))
-                 (setf version (stream-read-u8 mp3-file))
-                 (stream-seek mp3-file 128 :end)
-                 (setf tag (stream-read-string-with-len mp3-file 3))
-
-                 (log-id3-frame "id3 = ~a, version = ~d" id3 version)
-
-                 (setf valid (or (and (string= "ID3" id3)
-                                      (or (= 2 version) (= 3 version) (= 4 version)))
-                                 (string= tag "TAG"))))
-             (condition (c)
-               (declare (ignore c))
-               (setf valid nil)))
-        (stream-seek mp3-file 0 :start))
-        valid)))
+
+      (when (> (stream-size mp3-file) 4)
+        (unwind-protect
+             (handler-case
+                 (progn
+                   (stream-seek mp3-file 0 :start)
+                   (setf id3 (stream-read-string-with-len mp3-file 3))
+                   (setf version (stream-read-u8 mp3-file))
+                   (when (> (stream-size mp3-file) 128)
+                     (stream-seek mp3-file 128 :end)
+                     (setf tag (stream-read-string-with-len mp3-file 3)))
+
+                   (log-id3-frame "id3 = ~a, version = ~d" id3 version)
+
+                   (setf valid (or (and (string= "ID3" id3)
+                                        (or (= 2 version) (= 3 version) (= 4 version)))
+                                   (string= tag "TAG"))))
+               (condition (c)
+                 (utils:warn-user "is-valid-mp3-file got condition ~a" c)
+                 (setf valid nil)))
+          (stream-seek mp3-file 0 :start)))
+      valid)))
 
  (defclass v21-tag-header ()
    ((title    :accessor title    :initarg :title    :initform nil)
@@ -75,6 +79,7 @@ Written in this fashion so as to be 'crash-proof' when passed an arbitrary file.
 ;;; NB: no ":after" here
 (defmethod initialize-instance ((me v21-tag-header) &key instream)
   "Read in a V2.1 tag.  Caller will have stream-seek'ed file to correct location and ensured that TAG was present"
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "v21-frame-initializer"
     (log-id3-frame "reading v2.1 tag from ~:d" (stream-seek instream 0))
     (with-slots (title artist album year comment genre track) me
@@ -114,6 +119,7 @@ Written in this fashion so as to be 'crash-proof' when passed an arbitrary file.
   "Read in the extended header.  Caller will have stream-seek'ed to correct location in file.
 Note: extended headers are subject to unsynchronization, so make sure that INSTREAM has been made sync-safe.
 NB: 2.3 and 2.4 extended flags are different..."
+  (declare #.utils:*standard-optimize-settings*)
   (with-slots (size flags padding crc is-update restrictions) me
     (setf size (stream-read-u32 instream))
     (setf flags (stream-read-u16 instream)) ; reading in flags fields, must discern below 2.3/2.4
@@ -146,6 +152,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defun ext-header-restrictions-grok (r)
   "Return a string that shows what restrictions are in an ext-header"
+  (declare #.utils:*standard-optimize-settings*)
   (if (zerop r)
       "No restrictions"
       (with-output-to-string (s)
@@ -215,6 +222,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defmethod initialize-instance :after ((me id3-header) &key instream &allow-other-keys)
   "Fill in an mp3-header from INSTREAM."
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "id3-header-initializer"
     (with-slots (version revision flags size ext-header frames v21-tag-header) me
       (stream-seek instream 128 :end)
@@ -223,6 +231,7 @@ NB: 2.3 and 2.4 extended flags are different..."
         (handler-case
             (setf v21-tag-header (make-instance 'v21-tag-header :instream instream))
           (id3-frame-condition (c)
+            (utils:warn-user "initialize id3-header got condition ~a" c)
             (log-id3-frame "reading v21 got condition: ~a" c))))
 
       (stream-seek instream 0 :start)
@@ -257,6 +266,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 ;;; The "value" field accepts "normal" encoding, but also accepts any negative number, which means read
 ;;; the bytes an raw octets.
 (defun get-name-value-pair (instream len name-encoding value-encoding)
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context  "get-name-value-pair"
     (log-id3-frame "reading from ~:d, len ~:d, name-encoding = ~d, value-encoding = ~d" (stream-seek instream) len name-encoding value-encoding)
     (let* ((old-pos (stream-seek instream))
@@ -300,11 +310,13 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 ;; NB version 2.2 does NOT have FLAGS field in a frame; hence, the ECASE
 (defun valid-frame-flags (header-version frame-flags)
+  (declare #.utils:*standard-optimize-settings*)
   (ecase header-version
     (3 (zerop (logand #b0001111100011111 frame-flags)))
     (4 (zerop (logand #b1000111110110000 frame-flags)))))
 
 (defun print-frame-flags (version flags stream)
+  (declare #.utils:*standard-optimize-settings*)
   (ecase version
     (2 (format stream "None, "))
     (3 (format stream
@@ -341,6 +353,7 @@ NB: 2.3 and 2.4 extended flags are different..."
   (:documentation "Frame class that slurps in frame contents w/no attempt to grok them"))
 
 (defmethod initialize-instance :after ((me frame-raw) &key instream)
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "frame-raw"
     (with-slots (pos len octets) me
       (log-id3-frame "reading ~:d bytes from position ~:d" len pos)
@@ -397,6 +410,7 @@ NB: 2.3 and 2.4 extended flags are different..."
    (val      :accessor val)))
 
 (defmethod initialize-instance :after ((me frame-com) &key instream)
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "frame-com"
     (with-slots (len encoding lang desc val) me
       (setf encoding (stream-read-u8 instream))
@@ -436,6 +450,7 @@ NB: 2.3 and 2.4 extended flags are different..."
    (data       :accessor data)))
 
 (defmethod initialize-instance :after ((me frame-pic) &key instream)
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "frame-pic"
     (with-slots (id len encoding img-format type desc data) me
       (setf encoding (stream-read-u8 instream))
@@ -462,6 +477,7 @@ NB: 2.3 and 2.4 extended flags are different..."
   (:documentation "V2/V3/V4 T00-TZZ and T000-TZZZ frames, but not TXX or TXXX"))
 
 (defmethod initialize-instance :after ((me frame-text-info) &key instream)
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "frame-text-info"
     (with-slots (version flags len encoding info) me
       (let ((read-len len))
@@ -534,6 +550,7 @@ NB: 2.3 and 2.4 extended flags are different..."
   (:documentation "TXX is the only frame starting with a 'T' that has a different format"))
 
 (defmethod initialize-instance :after ((me frame-txx) &key instream)
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "frame-txx"
     (with-slots (len encoding desc val) me
       (setf encoding (stream-read-u8 instream))
@@ -555,6 +572,7 @@ NB: 2.3 and 2.4 extended flags are different..."
   (:documentation "Unique File Identifier"))
 
 (defmethod initialize-instance :after ((me frame-ufi) &key instream)
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "frame-ufi"
     (with-slots (id len name value) me
       (multiple-value-bind (n v) (get-name-value-pair instream len 0 -1)
@@ -673,6 +691,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defun get-picture-type (n)
   "Function to return picture types for APIC frames"
+  (declare #.utils:*standard-optimize-settings*)
   (if (and (>= n 0) (< n (length *picture-type*)))
       (nth n *picture-type*)
       "Unknown"))
@@ -693,6 +712,7 @@ NB: 2.3 and 2.4 extended flags are different..."
   (:documentation "Holds an attached picture (cover art)"))
 
 (defmethod initialize-instance :after ((me frame-apic) &key instream)
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "frame-apic"
     (with-slots (id len encoding mime type desc data) me
       (setf encoding (stream-read-u8 instream))
@@ -722,6 +742,7 @@ NB: 2.3 and 2.4 extended flags are different..."
   (:documentation "V23/4 Comment frame"))
 
 (defmethod initialize-instance :after ((me frame-comm) &key instream)
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "frame-comm"
     (with-slots (encoding lang len desc val) me
       (setf encoding (stream-read-u8 instream))
@@ -749,6 +770,7 @@ NB: 2.3 and 2.4 extended flags are different..."
   (:documentation "Play count frame"))
 
 (defmethod initialize-instance :after ((me frame-pcnt) &key instream)
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "frame-pcnt"
     (with-slots (play-count len) me
       (assert (= 4 len) () "Ran into a play count with ~d bytes" len)
@@ -769,6 +791,7 @@ NB: 2.3 and 2.4 extended flags are different..."
   (:documentation "Private frame"))
 
 (defmethod initialize-instance :after ((me frame-priv) &key instream)
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "frame-priv"
     (with-slots (id len name value) me
       (multiple-value-bind (n v) (get-name-value-pair instream len 0 -1)
@@ -792,6 +815,7 @@ NB: 2.3 and 2.4 extended flags are different..."
   (:documentation "TXXX frame"))
 
 (defmethod initialize-instance :after ((me frame-txxx) &key instream)
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "frame-txxx"
     (with-slots (encoding len desc val) me
       (setf encoding (stream-read-u8 instream))
@@ -816,6 +840,7 @@ NB: 2.3 and 2.4 extended flags are different..."
   (:documentation "Unique file identifier frame"))
 
 (defmethod initialize-instance :after ((me frame-ufid) &key instream)
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "frame-ufid"
     (with-slots (id len name value) me
       (multiple-value-bind (n v) (get-name-value-pair instream len 0 -1)
@@ -835,6 +860,7 @@ NB: 2.3 and 2.4 extended flags are different..."
   (:documentation "URL link frame"))
 
 (defmethod initialize-instance :after ((me frame-url-link) &key instream)
+  (declare #.utils:*standard-optimize-settings*)
   (with-slots (id len url) me
     (log5:with-context "url"
       (setf url (stream-read-iso-string-with-len instream len))
@@ -861,6 +887,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defun possibly-valid-frame-id? (frame-id)
   "test to see if a string is a potentially valid frame id"
+  (declare #.utils:*standard-optimize-settings*)
   (labels ((numeric-char-p (c)
              (let ((code (char-code c)))
                (and (>= code (char-code #\0))
@@ -874,11 +901,17 @@ NB: 2.3 and 2.4 extended flags are different..."
           (return-from possibly-valid-frame-id? nil))))
     t))
 
+(defun mk-frame-class-name (id)
+  (declare #.utils:*standard-optimize-settings*)
+  (string-upcase (concatenate 'string "frame-" id)))
+(utils:memoize 'mk-frame-class-name)
+
 (defun find-frame-class (id)
   "Search by concatenating 'frame-' with ID and look for that symbol in this package"
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "find-frame-class"
     (log-id3-frame "looking for class <~a>" id)
-    (let ((found-class-symbol (find-symbol (string-upcase (concatenate 'string "frame-" id)) :ID3-FRAME))
+    (let ((found-class-symbol (find-symbol (mk-frame-class-name id) :ID3-FRAME))
           found-class)
 
       ;; if we found the class name, return the class (to be used for MAKE-INSTANCE)
@@ -906,6 +939,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 
 (defun make-frame (version instream fn)
   "Create an appropriate mp3 frame by reading data from INSTREAM."
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "make-frame"
     (let* ((pos (stream-seek instream))
            (byte (stream-read-u8 instream))
@@ -947,6 +981,7 @@ NB: 2.3 and 2.4 extended flags are different..."
 (defmethod find-id3-frames ((mp3-file mp3-file-stream))
   "With an open mp3-file, make sure it is in fact an MP3 file, then read it's header and frames"
 
+  (declare #.utils:*standard-optimize-settings*)
   (labels ((read-loop (version stream)
              (log5:with-context "read-loop-in-find-id3-frames"
                (log-id3-frame "Starting loop through ~:d bytes" (stream-size stream))
@@ -963,6 +998,7 @@ NB: 2.3 and 2.4 extended flags are different..."
                          (log-id3-frame "bottom of read-loop: pos = ~:d, size = ~:d" (stream-seek stream) (stream-size stream))
                          (push this-frame frames))
                      (condition (c)
+                       (utils:warn-user "find-id3-frame got condition ~a" c)
                        (log-id3-frame "got condition ~a when making frame" c)
                        (return-from read-loop (values nil (nreverse frames))))))
 

iso-639-2.lisp

@@ -494,5 +494,6 @@
 
 (defun get-iso-639-2-language (l)
   "Convert an ISO-639-2 language tag into a readable language."
+  (declare #.utils:*standard-optimize-settings*)
   (let* ((lang (getf *langs* (make-keyword (string-upcase l)))))
     (if lang lang "Bad ISO-639-2 language")))

mp4-atom.lisp

@@ -28,25 +28,41 @@
 (defun as-int (str)
   "Given a 4-byte string, return an integer type equivalent.
 (eg (as-int \"hdlr\" == +audioprop-hdlr+))"
+  (declare #.utils:*standard-optimize-settings*)
   (let ((int 0))
     (declare (integer int))
     (setf (ldb (byte 8 24) int) (char-code (aref str 0)))
     (setf (ldb (byte 8 16) int) (char-code (aref str 1)))
     (setf (ldb (byte 8 8) int)  (char-code (aref str 2)))
     (setf (ldb (byte 8 0) int)  (char-code (aref str 3)))
+
     int))
 
-(defmethod as-string ((atom-type integer))
-  "Given an integer representing an atom type, return the string form"
+(defun as-string (atom-type)
+  (declare #.utils:*standard-optimize-settings*)
   (with-output-to-string (s nil)
     (write-char (code-char (ldb (byte 8 24) atom-type)) s)
     (write-char (code-char (ldb (byte 8 16) atom-type)) s)
     (write-char (code-char (ldb (byte 8 8)  atom-type)) s)
     (write-char (code-char (ldb (byte 8 0)  atom-type)) s)))
+(utils:memoize 'as-string)
+
+(defun mk-atom-class-name (name)
+  (string-upcase (concatenate 'string "atom-" (as-string name))))
+(utils:memoize 'mk-atom-class-name)
+
+;; (defmethod as-string ((atom-type integer))
+;;   "Given an integer representing an atom type, return the string form"
+;;   (with-output-to-string (s nil)
+;;     (write-char (code-char (ldb (byte 8 24) atom-type)) s)
+;;     (write-char (code-char (ldb (byte 8 16) atom-type)) s)
+;;     (write-char (code-char (ldb (byte 8 8)  atom-type)) s)
+;;     (write-char (code-char (ldb (byte 8 0)  atom-type)) s)))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun as-octet (c)
     "Used below so that we can create atom 'types' from char/ints"
+    (declare #.utils:*standard-optimize-settings*)
     (cond ((typep c 'standard-char) (coerce (char-code c) '(unsigned-byte 8)))
           ((typep c 'integer) (coerce c '(unsigned-byte 8)))
           (t (error "can any handle characters and integers"))))
@@ -104,6 +120,7 @@
 (defun atom-read-loop (mp4-file end func)
   "Loop from start to end through a file and call FUNC for every ATOM we find. Used
 at top-level and also for container ATOMs that need to read their contents."
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "atom-read-loop"
     (do ()
         ((>= (stream-seek mp4-file) end))
@@ -120,6 +137,7 @@ at top-level and also for container ATOMs that need to read their contents."
 
 (defmethod addc ((me mp4-atom) value)
   "Want to add children atoms to end of ATOM-CHILDREN to preserve in-file order."
+  (declare #.utils:*standard-optimize-settings*)
   (with-slots (atom-children) me
     (if (null atom-children)
         (setf atom-children (list value))
@@ -130,6 +148,7 @@ at top-level and also for container ATOMs that need to read their contents."
 (defmethod initialize-instance :after ((me atom-skip) &key (mp4-file nil) &allow-other-keys)
   "The 'skip' atom.  Used when we want to capture the header of atom, but don't want/need
 to read the payload of an atom."
+  (declare #.utils:*standard-optimize-settings*)
   (with-slots (atom-size atom-type) me
     (stream-seek mp4-file (- atom-size 8) :current)))
 
@@ -137,11 +156,12 @@ to read the payload of an atom."
   ((raw-data :accessor raw-data)))
 (defmethod initialize-instance :after ((me atom-raw-mixin) &key (mp4-file nil) &allow-other-keys)
   "The 'don't need to know contents, but want 'blob' of data read in' atom"
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "atom-raw-mixin"
     (with-slots (raw-data atom-type atom-size) me
       (log-mp4-atom "atom-raw-mixin: reading in ~d raw bytes for ~a" (- atom-size 8) (vpprint me nil))
       (setf raw-data (stream-read-sequence mp4-file (- atom-size 8)))
-      ;;(utils::dump-data "/tmp/o.txt" raw-data)
+      ;;(utils:dump-data "/tmp/o.txt" raw-data)
       )))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ILST ATOMS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -149,6 +169,7 @@ to read the payload of an atom."
 (defmethod initialize-instance :after ((me atom-ilst) &key (mp4-file nil) &allow-other-keys)
   "Construct an ilst atom.  ILST atoms are containers that hold data elements related to tagging.
 Loop through this container and construct constituent atoms"
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "atom-ilst-initializer"
     (with-slots (atom-size atom-type atom-children) me
       (log-mp4-atom "atom-ilst-init: found ilst atom <~a> @ ~:d, looping for ~:d bytes"
@@ -192,6 +213,7 @@ Loop through this container and construct constituent atoms"
    (:documentation "Represents the 'data' portion of ilst data atom"))
 
  (defmethod initialize-instance :after ((me atom-data) &key mp4-file &allow-other-keys)
+  (declare #.utils:*standard-optimize-settings*)
    (log5:with-context "atom-data-init"
      (with-slots (atom-size atom-type atom-version atom-flags atom-value atom-parent-type) me
        (setf atom-version (stream-read-u8 mp4-file))
@@ -310,6 +332,7 @@ Loop through this container and construct constituent atoms"
    (lang     :accessor lang)
    (quality  :accessor quality)))
 (defmethod initialize-instance :after ((me atom-mdhd) &key (mp4-file nil) &allow-other-keys)
+  (declare #.utils:*standard-optimize-settings*)
   (with-slots (version flags c-time m-time scale duration lang quality) me
     (setf version  (stream-read-u8 mp4-file))
     (setf flags    (stream-read-u24 mp4-file))
@@ -338,6 +361,7 @@ Loop through this container and construct constituent atoms"
 ;;; Note: start types are optional
 (defun read-descriptor-len (instream)
   "Get the ES descriptor's length."
+  (declare #.utils:*standard-optimize-settings*)
   (let* ((tmp (stream-read-u8 instream))
          (len (logand tmp #x7f)))
     (declare (type (unsigned-byte 8) tmp))
@@ -368,6 +392,7 @@ Loop through this container and construct constituent atoms"
 (defconstant +mp4-extdescrtagsend+         #xfe)
 
 (defmethod initialize-instance :after ((me atom-esds) &key (mp4-file nil) &allow-other-keys)
+  (declare #.utils:*standard-optimize-settings*)
   (with-slots (version flags esid s-priority obj-id s-type buf-size max-bit-rate avg-bit-rate) me
     (setf version (stream-read-u8 mp4-file))
     (setf flags (stream-read-u24 mp4-file))
@@ -394,6 +419,7 @@ Loop through this container and construct constituent atoms"
    (num-entries :accessor num-entries)))
 
 (defmethod initialize-instance :after ((me atom-stsd) &key (mp4-file nil) &allow-other-keys)
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "atom-stsd"
     (with-slots (flags version num-entries) me
       (setf version (stream-read-u8 mp4-file))
@@ -414,6 +440,7 @@ Loop through this container and construct constituent atoms"
    (samp-rate   :accessor samp-rate))) ; 4 bytes
 
 (defmethod initialize-instance :after ((me atom-mp4a) &key (mp4-file nil) &allow-other-keys)
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "atom-mp4a"
     (with-slots (reserved d-ref-idx version revision vendor num-chans samp-size comp-id packet-size samp-rate) me
       (setf reserved    (stream-read-sequence mp4-file 6))
@@ -431,7 +458,8 @@ Loop through this container and construct constituent atoms"
 
 
 (defun read-container-atoms (mp4-file parent-atom)
-  "loop through a container atom and add it's children to it"
+  "Loop through a container atom and add it's children to it"
+  (declare #.utils:*standard-optimize-settings*)
   (with-slots (atom-children atom-file-position atom-of-interest atom-size atom-type atom-decoded) parent-atom
     (atom-read-loop mp4-file (+ atom-file-position atom-size)
                     (lambda ()
@@ -443,6 +471,7 @@ Loop through this container and construct constituent atoms"
   ((version  :accessor version)
    (flags    :accessor flags)))
 (defmethod initialize-instance :after ((me atom-meta) &key (mp4-file nil) &allow-other-keys)
+  (declare #.utils:*standard-optimize-settings*)
    (with-slots (version flags) me
      (setf version  (stream-read-u8 mp4-file))
      (setf flags    (stream-read-u24 mp4-file))
@@ -450,9 +479,10 @@ Loop through this container and construct constituent atoms"
 
 (defun find-atom-class (id)
   "Search by concatenating 'atom-' with ID and look for that symbol in this package"
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "find-atom-class"
     (log-mp4-atom "find-atom-class: looking for class <~a>" (as-string id))
-    (let ((found-class-symbol (find-symbol (string-upcase (concatenate 'string "atom-" (as-string id))) :MP4-ATOM))
+    (let ((found-class-symbol (find-symbol (mk-atom-class-name id) :MP4-ATOM))
           (found-class))
 
       ;; if we found the class name, return the class (to be used for MAKE-INSTANCE)
@@ -467,6 +497,7 @@ Loop through this container and construct constituent atoms"
 
 (defun make-mp4-atom (mp4-file &optional parent-type)
   "Get current file position, read in size/type, then construct the correct atom."
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "make-mp4-atom"
     (let* ((pos (stream-seek mp4-file))
            (siz (stream-read-u32 mp4-file))
@@ -498,24 +529,28 @@ Loop through this container and construct constituent atoms"
 (defun is-valid-m4-file (mp4-file)
   "Make sure this is an MP4 file.  Quick check: is first atom (at file-offset 4) == FSTYP?
 Written in this fashion so as to be 'crash-proof' when passed an arbitrary file."
+  (declare #.utils:*standard-optimize-settings*)
   (let ((valid)
         (size)
         (header))
-    (unwind-protect
-         (handler-case
-             (progn
-               (stream-seek mp4-file 0 :start)
-               (setf size (stream-read-u32 mp4-file))
-               (setf header (stream-read-u32 mp4-file))
-               (setf valid (and (<= size (stream-size mp4-file))
-                                (= header +m4-ftyp+))))
-           (condition (c)
-             (declare (ignore c))))
-      (stream-seek mp4-file 0 :start))
+    (when (> (stream-size mp4-file) 8)
+      (unwind-protect
+           (handler-case
+               (progn
+                 (stream-seek mp4-file 0 :start)
+                 (setf size (stream-read-u32 mp4-file))
+                 (setf header (stream-read-u32 mp4-file))
+                 (setf valid (and (<= size (stream-size mp4-file))
+                                  (= header +m4-ftyp+))))
+             (condition (c)
+               (utils:warn-user "File:~a~%is-valid-mp4-file got condition ~a" (stream-filename mp4-file) c)))
+
+        (stream-seek mp4-file 0 :start)))
     valid))
 
 (defmethod find-mp4-atoms ((mp4-file mp4-file-stream))
   "Given a valid MP4 file MP4-FILE, look for the 'right' atoms and return them."
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "find-mp4-atoms"
 
     (log-mp4-atom "find-mp4-atoms: ~a, before read-file loop, file-position = ~:d, end = ~:d"
@@ -533,12 +568,14 @@ Written in this fashion so as to be 'crash-proof' when passed an arbitrary file.
 
 (defmethod map-mp4-atom ((atoms list) &key (func nil) (depth nil))
   "Given a list of atoms, call map-mp4-atom for each one"
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "map-mp4-atom"
     (dolist (a atoms)
       (map-mp4-atom a :func func :depth depth))))
 
 (defmethod map-mp4-atom ((me mp4-atom) &key (func nil) (depth nil))
   "Traverse all atoms under a given atom"
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "map-mp4-atom(single)"
     (labels ((_indented-atom (atom depth)
                (format t "~vt~a~%"  (if (null depth) 0 depth) (vpprint atom nil))))
@@ -550,11 +587,13 @@ Written in this fashion so as to be 'crash-proof' when passed an arbitrary file.
         (map-mp4-atom atom-children :func func :depth (if (null depth) nil (+ 1 depth)))))))
 
 (defmethod traverse ((me mp4-atom) path)
+  (declare #.utils:*standard-optimize-settings*)
   (traverse (atom-children me) path))
 
 (defmethod traverse ((me list) path)
   "Used in finding nested atoms. Search MP4-ATOMS and if we find a match with first of path,
 call traverse atom (unless length of path == 1, in which case, we've found our match)"
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "traverse"
     (log-mp4-atom "traverse: entering with ~a ~a" me path)
     (dolist (sibling me)
@@ -574,14 +613,16 @@ call traverse atom (unless length of path == 1, in which case, we've found our m
 
 (defmethod tag-get-value (atoms node)
   "Helper function to extract text from ILST atom's data atom"
+  (declare #.utils:*standard-optimize-settings*)
   (aif (traverse atoms
                  (list +mp4-atom-moov+ +mp4-atom-udta+ +mp4-atom-meta+ +mp4-atom-ilst+ node +itunes-ilst-data+))
        (atom-value it)
        nil))
 
 (defun mp4-show-raw-tag-atoms (mp4-file-stream out-stream)
-  (map-mp4-atom (mp4-atom::traverse (mp4-atoms mp4-file-stream)
-                                    (list +mp4-atom-moov+ +mp4-atom-udta+ +mp4-atom-meta+ +mp4-atom-ilst+))
+  (declare #.utils:*standard-optimize-settings*)
+  (map-mp4-atom (traverse (mp4-atoms mp4-file-stream)
+                          (list +mp4-atom-moov+ +mp4-atom-udta+ +mp4-atom-meta+ +mp4-atom-ilst+))
                 :depth 0
                 :func (lambda (atom depth)
                         (when (= (atom-type atom) +itunes-ilst-data+)
@@ -589,6 +630,7 @@ call traverse atom (unless length of path == 1, in which case, we've found our m
 
 (defun find-all (base name)
   "Starting as BASE atom, recursively search for all instances of NAME"
+  (declare #.utils:*standard-optimize-settings*)
   (let* ((search-name (if (typep name 'string) (as-int name) name))
          (found))
 
@@ -602,6 +644,7 @@ call traverse atom (unless length of path == 1, in which case, we've found our m
 (defun get-audio-properties-atoms (mp4-file)
   "First, find all TRAKs under moov. For the one that contains a HDLR atom with DATA of 'soun',
 return trak.mdia.mdhd and trak.mdia.minf.stbl.stsd"
+  (declare #.utils:*standard-optimize-settings*)
   (dolist (track (find-all (traverse (mp4-atoms mp4-file) (list +mp4-atom-moov+)) "trak"))
     (let ((hdlr (traverse track (list +mp4-atom-mdia+ +audioprop-hdlr+))))
       (when (and (not (null hdlr))
@@ -635,6 +678,7 @@ return trak.mdia.mdhd and trak.mdia.minf.stbl.stsd"
 
 (defun get-mp4-audio-info (mp4-file)
   "MP4A audio info is held in under the trak.mdia.mdhd/trak.mdia.minf.stbl/trak.mdia.minf.stbl.mp4a atoms."
+  (declare #.utils:*standard-optimize-settings*)
   (let ((info (make-instance 'audio-info)))
     (multiple-value-bind (mdhd mp4a esds) (get-audio-properties-atoms mp4-file)
       (with-slots (seconds channels bits-per-sample sample-rate max-bit-rate avg-bit-rate) info

mpeg.lisp

@@ -26,11 +26,14 @@
 (defconstant +mpeg-1+     3)
 
 (defun valid-version (version)
+  (declare #.utils:*standard-optimize-settings*)
   (or ;; can't deal with 2.5's yet (= (the fixnum +mpeg-2.5+) (the fixnum version))
       (= (the fixnum +mpeg-2+) (the fixnum version))
       (= (the fixnum +mpeg-1+) (the fixnum version))))
 
-(defun get-mpeg-version-string (version) (nth version '("MPEG 2.5" "Reserved" "MPEG 2" "MPEG 1")))
+(defun get-mpeg-version-string (version)
+  (declare #.utils:*standard-optimize-settings*)
+  (nth version '("MPEG 2.5" "Reserved" "MPEG 2" "MPEG 1")))
 
 ;;; the layers
 (defconstant +layer-reserved+  0)
@@ -39,28 +42,39 @@
 (defconstant +layer-1+         3)
 
 (defun valid-layer (layer)
+  (declare #.utils:*standard-optimize-settings*)
   (or (= (the fixnum +layer-3+) (the fixnum layer))
       (= (the fixnum +layer-2+) (the fixnum layer))
       (= (the fixnum +layer-1+) (the fixnum layer))))
 
-(defun get-layer-string (layer) (nth layer '("Reserved" "Layer III" "Layer II" "Layer I")))
+(defun get-layer-string (layer)
+  (declare #.utils:*standard-optimize-settings*)
+  (nth layer '("Reserved" "Layer III" "Layer II" "Layer I")))
 
 ;;; the modes
 (defconstant +channel-mode-stereo+ 0)
 (defconstant +channel-mode-joint+  1)
 (defconstant +channel-mode-dual+   2)
 (defconstant +channel-mode-mono+   3)
-(defun get-channel-mode-string (mode)  (nth mode '("Stereo" "Joint" "Dual" "Mono")))
+(defun get-channel-mode-string (mode)
+  (declare #.utils:*standard-optimize-settings*)
+  (nth mode '("Stereo" "Joint" "Dual" "Mono")))
 
 ;;; the emphases
 (defconstant +emphasis-none+     0)
 (defconstant +emphasis-50-15+    1)
 (defconstant +emphasis-reserved+ 2)
 (defconstant +emphasis-ccit+     3)
-(defun get-emphasis-string (e)   (nth e '("None" "50/15 ms" "Reserved" "CCIT J.17")))
-(defun valid-emphasis (e) (or (= (the fixnum e) (the fixnum +emphasis-none+))
-                              (= (the fixnum e) (the fixnum +emphasis-50-15+))
-                              (= (the fixnum e) (the fixnum +emphasis-ccit+))))
+
+(defun get-emphasis-string (e)
+  (declare #.utils:*standard-optimize-settings*)
+  (nth e '("None" "50/15 ms" "Reserved" "CCIT J.17")))
+
+(defun valid-emphasis (e)
+  (declare #.utils:*standard-optimize-settings*)
+  (or (= (the fixnum e) (the fixnum +emphasis-none+))
+      (= (the fixnum e) (the fixnum +emphasis-50-15+))
+      (= (the fixnum e) (the fixnum +emphasis-ccit+))))
 
 ;;; the modes
 (defconstant +mode-extension-0+ 0)
@@ -68,6 +82,7 @@
 (defconstant +mode-extension-2+ 2)
 (defconstant +mode-extension-3+ 3)
 (defun get-mode-extension-string (channel-mode layer mode-extension)
+  (declare #.utils:*standard-optimize-settings*)
   (if (not (= channel-mode +channel-mode-joint+))
       ""
       (if (or (= layer +layer-1+)
@@ -76,6 +91,7 @@
           (format nil "Intensity Stereo: ~[off~;on~], MS Stereo: ~[off~;on~]" (ash mode-extension -1) (logand mode-extension 1)))))
 
 (defun get-samples-per-frame (version layer)
+  (declare #.utils:*standard-optimize-settings*)
   (cond ((= (the fixnum layer) (the fixnum +layer-1+)) 384)
         ((= (the fixnum layer) (the fixnum +layer-2+)) 1152)
         ((= (the fixnum layer) (the fixnum +layer-3+))
@@ -132,9 +148,11 @@
                      (448 384 320 256 160)))))
 
   (defun valid-bit-rate-index (br-index)
+    (declare #.utils:*standard-optimize-settings*)
     (and (> (the fixnum br-index) 0) (< (the fixnum br-index) 15)))
 
   (defun get-bit-rate (version layer bit-rate-index)
+    (declare #.utils:*standard-optimize-settings*)
     (log5:with-context "get-bit-rate"
       (log-mpeg-frame "version = ~d, layer = ~d, bit-rate-index = ~d" version layer bit-rate-index)
       (let ((row (1- bit-rate-index))
@@ -158,10 +176,12 @@
               ret))))))
 
 (defun valid-sample-rate-index (sr-index)
+  (declare #.utils:*standard-optimize-settings*)
   (and (>= (the fixnum sr-index) 0)
        (<  (the fixnum sr-index) 3)))
 
 (defun get-sample-rate (version sr-index)
+  (declare #.utils:*standard-optimize-settings*)
   (cond ((= (the fixnum version) (the fixnum +mpeg-1+))
          (case (the fixnum sr-index) (0 44100) (1 48000) (2 32000)))
         ((= (the fixnum version) (the fixnum +mpeg-2+))
@@ -169,6 +189,7 @@
         (t nil)))
 
 (defun get-frame-size (version layer bit-rate sample-rate padded)
+  (declare #.utils:*standard-optimize-settings*)
   (truncate (float (cond ((= (the fixnum layer) (the fixnum +layer-1+))
                           (* 4 (+ (/ (* 12 bit-rate) sample-rate) padded)))
                          ((= (the fixnum layer) (the fixnum +layer-2+))
@@ -180,33 +201,34 @@
 
 (defmethod load-frame ((me frame) &key instream (read-payload nil))
   "Load an MPEG frame from current file position.  If READ-PAYLOAD is set, read in frame's content."
-  (fastest
-    (log5:with-context "load-frame"
-      (handler-case
-          (with-frame-slots (me)
-            (log-mpeg-frame "loading frame from pos ~:d" (stream-seek instream))
-            (when (null hdr-u32)        ; has header already been read in?
-              (log-mpeg-frame "reading in header")
-              (setf pos (stream-seek instream))
-              (setf hdr-u32 (stream-read-u32 instream))
-              (when (null hdr-u32)
-                (log-mpeg-frame "hit EOF")
-                (return-from load-frame nil)))
-
-            (if (parse-header me)
-                (progn
-                  (log-mpeg-frame "header parsed ok")
-                  (setf size (get-frame-size version layer bit-rate sample-rate padded))
-                  (when read-payload
-                    (setf payload (stream-read-sequence instream (- size 4))))
-                  t)
-                (progn
-                  (log-mpeg-frame "header didn't parse!")
-                  nil)))
-        (end-of-file (c)
-          (declare (ignore c))
-          (log-mpeg-frame "Hit EOF")
-          nil)))))
+  (declare #.utils:*standard-optimize-settings*)
+  (declare #.utils:*standard-optimize-settings*)
+  (log5:with-context "load-frame"
+    (handler-case
+        (with-frame-slots (me)
+          (log-mpeg-frame "loading frame from pos ~:d" (stream-seek instream))
+          (when (null hdr-u32)          ; has header already been read in?
+            (log-mpeg-frame "reading in header")
+            (setf pos (stream-seek instream))
+            (setf hdr-u32 (stream-read-u32 instream))
+            (when (null hdr-u32)
+              (log-mpeg-frame "hit EOF")
+              (return-from load-frame nil)))
+
+          (if (parse-header me)
+              (progn
+                (log-mpeg-frame "header parsed ok")
+                (setf size (get-frame-size version layer bit-rate sample-rate padded))
+                (when read-payload
+                  (setf payload (stream-read-sequence instream (- size 4))))
+                t)
+              (progn
+                (log-mpeg-frame "header didn't parse!")
+                nil)))
+      (end-of-file (c)
+        (declare (ignore c))
+        (log-mpeg-frame "Hit EOF")
+        nil))))
 
 (defmethod parse-header ((me frame))
   "Given a frame, verify that is a valid MPEG audio frame by examining the header.
@@ -225,82 +247,82 @@ Bit      3 (1  bit ): the copyright bit
 Bit      2 (1  bit ): the original bit
 Bits   1-0 (2  bits): the emphasis"
 
-  (fastest
-    (log5:with-context "parse-header"
-      (with-frame-slots (me)
-        ;; check sync word
-        (setf sync (get-bitfield hdr-u32 31 11))
-        ;(setf (ldb (byte 8 8) sync) (ldb (byte 8 24) hdr-u32))
-        ;(setf (ldb (byte 3 5) sync) (ldb (byte 3 5) (ldb (byte 8 16) hdr-u32)))
-        (when (not (= sync +sync-word+))
-          (log-mpeg-frame "bad sync ~x/~x" sync hdr-u32)
+  (declare #.utils:*standard-optimize-settings*)
+  (log5:with-context "parse-header"
+    (with-frame-slots (me)
+      ;; check sync word
+      (setf sync (get-bitfield hdr-u32 31 11))
+                                        ;(setf (ldb (byte 8 8) sync) (ldb (byte 8 24) hdr-u32))
+                                        ;(setf (ldb (byte 3 5) sync) (ldb (byte 3 5) (ldb (byte 8 16) hdr-u32)))
+      (when (not (= sync +sync-word+))
+        (log-mpeg-frame "bad sync ~x/~x" sync hdr-u32)
+        (return-from parse-header nil))
+
+      ;; check version
+                                        ;(setf version (ldb (byte 2 3) (ldb (byte 8 16) hdr-u32)))
+      (setf version (get-bitfield hdr-u32 20 2))
+      (when (not (valid-version version))
+        (log-mpeg-frame "bad version ~d" version)
+        (return-from parse-header nil))
+
+      ;; check layer
+                                        ;(setf layer (ldb (byte 2 1) (ldb (byte 8 16) hdr-u32)))
+      (setf layer (get-bitfield hdr-u32 18 2))
+      (when (not (valid-layer layer))
+        (log-mpeg-frame "bad layer ~d" layer)
+        (return-from parse-header nil))
+
+                                        ;(setf protection (ldb (byte 1 0) (ldb (byte 8 16) hdr-u32)))
+      (setf protection (get-bitfield hdr-u32 16 1))
+
+      (setf samples (get-samples-per-frame version layer))
+
+      ;; check bit-rate
+                                        ;(let ((br-index (the fixnum (ldb (byte 4 4) (ldb (byte 8 8) hdr-u32)))))
+      (let ((br-index (get-bitfield hdr-u32 15 4)))
+        (when (not (valid-bit-rate-index br-index))
+          (log-mpeg-frame "bad bit-rate index ~d" br-index)
           (return-from parse-header nil))
 
-        ;; check version
-        ;(setf version (ldb (byte 2 3) (ldb (byte 8 16) hdr-u32)))
-        (setf version (get-bitfield hdr-u32 20 2))
-        (when (not (valid-version version))
-          (log-mpeg-frame "bad version ~d" version)
-          (return-from parse-header nil))
+        (setf bit-rate (get-bit-rate version layer br-index)))
 
-        ;; check layer
-        ;(setf layer (ldb (byte 2 1) (ldb (byte 8 16) hdr-u32)))
-        (setf layer (get-bitfield hdr-u32 18 2))
-        (when (not (valid-layer layer))
-          (log-mpeg-frame "bad layer ~d" layer)
+      ;; check sample rate
+                                        ;(let ((sr-index (the fixnum (ldb (byte 2 2) (ldb (byte 8 8) hdr-u32)))))
+      (let ((sr-index (get-bitfield hdr-u32 11 2)))
+        (when (not (valid-sample-rate-index sr-index))
+          (log-mpeg-frame "bad sample-rate index ~d" sr-index)
           (return-from parse-header nil))
 
-        ;(setf protection (ldb (byte 1 0) (ldb (byte 8 16) hdr-u32)))
-        (setf protection (get-bitfield hdr-u32 16 1))
-
-        (setf samples (get-samples-per-frame version layer))
-
-        ;; check bit-rate
-        ;(let ((br-index (the fixnum (ldb (byte 4 4) (ldb (byte 8 8) hdr-u32)))))
-        (let ((br-index (get-bitfield hdr-u32 15 4)))
-          (when (not (valid-bit-rate-index br-index))
-            (log-mpeg-frame "bad bit-rate index ~d" br-index)
-            (return-from parse-header nil))
+        (setf sample-rate (get-sample-rate version sr-index)))
 
-          (setf bit-rate (get-bit-rate version layer br-index)))
+                                        ;(setf padded (ldb (byte 1 1) (ldb (byte 8 8) hdr-u32)))
+      (setf padded (get-bitfield hdr-u32 9 1))
 
-        ;; check sample rate
-        ;(let ((sr-index (the fixnum (ldb (byte 2 2) (ldb (byte 8 8) hdr-u32)))))
-        (let ((sr-index (get-bitfield hdr-u32 11 2)))
-          (when (not (valid-sample-rate-index sr-index))
-            (log-mpeg-frame "bad sample-rate index ~d" sr-index)
-            (return-from parse-header nil))
+                                        ;(setf private (ldb (byte 1 0) (ldb (byte 8 8) hdr-u32)))
+      (setf private (get-bitfield hdr-u32 8 1))
 
-          (setf sample-rate (get-sample-rate version sr-index)))
+                                        ;(setf channel-mode (ldb (byte 2 6) (ldb (byte 8 0) hdr-u32)))
+      (setf channel-mode (get-bitfield hdr-u32 7 2))
 
-        ;(setf padded (ldb (byte 1 1) (ldb (byte 8 8) hdr-u32)))
-        (setf padded (get-bitfield hdr-u32 9 1))
+                                        ;(setf mode-extension (ldb (byte 2 4) (ldb (byte 8 0) hdr-u32)))
+      (setf mode-extension (get-bitfield hdr-u32 5 2))
 
-        ;(setf private (ldb (byte 1 0) (ldb (byte 8 8) hdr-u32)))
-        (setf private (get-bitfield hdr-u32 8 1))
+                                        ;(setf copyright (ldb (byte 1 3) (ldb (byte 8 0) hdr-u32)))
+      (setf copyright (get-bitfield hdr-u32 3 1))
 
-        ;(setf channel-mode (ldb (byte 2 6) (ldb (byte 8 0) hdr-u32)))
-        (setf channel-mode (get-bitfield hdr-u32 7 2))
+                                        ;(setf original (ldb (byte 1 2) (ldb (byte 8 0) hdr-u32)))
+      (setf original (get-bitfield hdr-u32 2 1))
 
-        ;(setf mode-extension (ldb (byte 2 4) (ldb (byte 8 0) hdr-u32)))
-        (setf mode-extension (get-bitfield hdr-u32 5 2))
+                                        ;(setf emphasis (ldb (byte 2 0) (ldb (byte 8 0) hdr-u32)))
+      (setf emphasis (get-bitfield hdr-u32 1 2))
 
-        ;(setf copyright (ldb (byte 1 3) (ldb (byte 8 0) hdr-u32)))
-        (setf copyright (get-bitfield hdr-u32 3 1))
+      ;; check emphasis
+      (when (not (valid-emphasis emphasis))
+        (log-mpeg-frame "bad emphasis ~d" emphasis)
+        (return-from parse-header nil))
 
-        ;(setf original (ldb (byte 1 2) (ldb (byte 8 0) hdr-u32)))
-        (setf original (get-bitfield hdr-u32 2 1))
-
-        ;(setf emphasis (ldb (byte 2 0) (ldb (byte 8 0) hdr-u32)))
-        (setf emphasis (get-bitfield hdr-u32 1 2))
-
-        ;; check emphasis
-        (when (not (valid-emphasis emphasis))
-          (log-mpeg-frame "bad emphasis ~d" emphasis)
-          (return-from parse-header nil))
-
-        (log-mpeg-frame "good parse: ~a" me)
-        t))))
+      (log-mpeg-frame "good parse: ~a" me)
+      t)))
 
 (defmethod vpprint ((me frame) stream)
   (format stream "~a"
@@ -336,6 +358,7 @@ Bits   1-0 (2  bits): the emphasis"
 (defconstant +vbr-scale+   8)
 
 (defun get-side-info-size (version channel-mode)
+  (declare #.utils:*standard-optimize-settings*)
   (cond ((= (the fixnum version) (the fixnum +mpeg-1+))
          (cond ((= (the fixnum channel-mode) (the fixnum +channel-mode-mono+)) 17)
                (t 32)))
@@ -343,6 +366,7 @@ Bits   1-0 (2  bits): the emphasis"
                  (t 17)))))
 
 (defmethod check-vbr ((me frame) fn)
+  (declare #.utils:*standard-optimize-settings*)
   (log5::with-context "check-vbr"
     (with-frame-slots (me)
 
@@ -397,72 +421,72 @@ Bits   1-0 (2  bits): the emphasis"
             tag flags frames frames bytes tocs scale)))
 
 (defun find-first-sync (in)
-  (fastest
-    (log5:with-context "find-first-sync"
-
-      (log-mpeg-frame "Looking for first sync, begining at file position ~:d" (stream-seek in))
-      (let ((hdr-u32)
-            (count 0)
-            (pos))
-
-        (handler-case
-            (loop
-              (setf pos (stream-seek in))
-              (setf hdr-u32 (stream-read-u32 in))
-              (when (null hdr-u32)
-                (return-from find-first-sync nil))
-              (incf count)
-
-              (when (= (logand hdr-u32 #xffe00000) #xffe00000) ; magic number is potential sync frame header
-                (log-mpeg-frame "Potential sync bytes at ~:d: <~x>" pos hdr-u32)
-                (let ((hdr (make-instance 'frame :hdr-u32 hdr-u32 :pos pos)))
-                  (if (load-frame hdr :instream in :read-payload t)
-                      (progn
-                        (check-vbr hdr (stream-filename in))
-                        (log-mpeg-frame "Valid header being returned: ~a, searched ~:d times" hdr count)
-                        (return-from find-first-sync hdr))
-                      (progn
-                        (log-mpeg-frame "hdr wasn't valid: ~a" hdr))))))
-          (condition (c) (progn
-                           (warn-user "Condtion <~a> signaled while looking for first sync" c)
-                           (log-mpeg-frame "got a condition while looking for first sync: ~a" c)
-                           (error c)))) ; XXX should I propogate this, or just return nil
-        nil))))
+  (declare #.utils:*standard-optimize-settings*)
+  (log5:with-context "find-first-sync"
+
+    (log-mpeg-frame "Looking for first sync, begining at file position ~:d" (stream-seek in))
+    (let ((hdr-u32)
+          (count 0)
+          (pos))
+
+      (handler-case
+          (loop
+            (setf pos (stream-seek in))
+            (setf hdr-u32 (stream-read-u32 in))
+            (when (null hdr-u32)
+              (return-from find-first-sync nil))
+            (incf count)
+
+            (when (= (logand hdr-u32 #xffe00000) #xffe00000) ; magic number is potential sync frame header
+              (log-mpeg-frame "Potential sync bytes at ~:d: <~x>" pos hdr-u32)
+              (let ((hdr (make-instance 'frame :hdr-u32 hdr-u32 :pos pos)))
+                (if (load-frame hdr :instream in :read-payload t)
+                    (progn
+                      (check-vbr hdr (stream-filename in))
+                      (log-mpeg-frame "Valid header being returned: ~a, searched ~:d times" hdr count)
+                      (return-from find-first-sync hdr))
+                    (progn
+                      (log-mpeg-frame "hdr wasn't valid: ~a" hdr))))))
+        (condition (c) (progn
+                         (warn-user "Condtion <~a> signaled while looking for first sync" c)
+                         (log-mpeg-frame "got a condition while looking for first sync: ~a" c)
+                         (error c)))) ; XXX should I propogate this, or just return nil
+      nil)))
 
 (defmethod next-frame ((me frame) &key instream read-payload)
   "Get next frame.  If READ-PAYLOAD is true, read in contents for frame, else, seek to next frame header."
-  (fastest
-    (log5:with-context "next-frame"
-      (let ((nxt-frame (make-instance 'frame)))
-        (when (not (payload me))
-          (log-mpeg-frame "no payload load required in current frame, skipping from ~:d forward ~:d bytes"
-                          (stream-seek instream)
-                          (- (size me) 4) :current)
-          (stream-seek instream (- (size me) 4) :current))
-
-        (log-mpeg-frame "at pos ~:d, read-payload is ~a" (stream-seek instream) read-payload)
-        (if (load-frame nxt-frame :instream instream :read-payload read-payload)
-            nxt-frame
-            nil)))))
+  (declare #.utils:*standard-optimize-settings*)
+  (log5:with-context "next-frame"
+    (let ((nxt-frame (make-instance 'frame)))
+      (when (not (payload me))
+        (log-mpeg-frame "no payload load required in current frame, skipping from ~:d forward ~:d bytes"
+                        (stream-seek instream)
+                        (- (size me) 4) :current)
+        (stream-seek instream (- (size me) 4) :current))
+
+      (log-mpeg-frame "at pos ~:d, read-payload is ~a" (stream-seek instream) read-payload)
+      (if (load-frame nxt-frame :instream instream :read-payload read-payload)
+          nxt-frame
+          nil))))
 
 (defparameter *max-frames-to-read* most-positive-fixnum "when trying to determine bit-rate, etc, read at most this many frames")
 
 (defun map-frames (in func &key (start-pos nil) (read-payload nil) (max nil))
   "Loop through the MPEG audio frames in a file.  If *MAX-FRAMES-TO-READ* is set, return after reading that many frames."
-  (fastest
-    (log5:with-context "next-frame"
-      (log-mpeg-frame "mapping frames, start pos ~:d" start-pos)
+  (declare #.utils:*standard-optimize-settings*)
+  (log5:with-context "next-frame"
+    (log-mpeg-frame "mapping frames, start pos ~:d" start-pos)
 
-      (when start-pos
-        (stream-seek in start-pos :start))
+    (when start-pos
+      (stream-seek in start-pos :start))
 
-      (loop
-        for max-frames = (if max max *max-frames-to-read*)
-        for count = 0 then (incf count)
-        for frame = (find-first-sync in) then (next-frame frame :instream in :read-payload read-payload)
-        while (and frame (< count max-frames)) do
-          (log-mpeg-frame "map-frames: at pos ~:d, dispatching function" (pos frame))
-          (funcall func frame)))))
+    (loop
+      for max-frames = (if max max *max-frames-to-read*)
+      for count = 0 then (incf count)
+      for frame = (find-first-sync in) then (next-frame frame :instream in :read-payload read-payload)
+      while (and frame (< count max-frames)) do
+        (log-mpeg-frame "map-frames: at pos ~:d, dispatching function" (pos frame))
+        (funcall func frame))))
 
 (defclass mpeg-audio-info ()
   ((is-vbr      :accessor is-vbr      :initarg :is-vbr      :initform nil)
@@ -486,6 +510,7 @@ Bits   1-0 (2  bits): the emphasis"
 
 (defun calc-bit-rate-exhaustive (in start info)
   "Map every MPEG frame in IN and calculate the bit-rate"
+  (declare #.utils:*standard-optimize-settings*)
   (log5:with-context "calc-bit-rate-exhaustive"
     (let ((total-len 0)
           (last-bit-rate nil)
@@ -520,6 +545,7 @@ Bits   1-0 (2  bits): the emphasis"
    "Get MPEG Layer 3 audio information.
  If the first MPEG frame we find is a Xing/Info header, return that as info.
  Else, we assume CBR and calculate the duration, etc."
+  (declare #.utils:*standard-optimize-settings*)
    (log5:with-context "get-mpeg-audio-info"
      (let ((first-frame (find-first-sync in))
            (info (make-instance 'mpeg-audio-info)))

packages.lisp

@@ -3,8 +3,12 @@
 (in-package #:cl-user)
 
 (defpackage #:utils
-  (:export #:warn-user *break-on-warn-user* #:printable-array #:upto-null #:redirect
-           #:it #:fastest #:get-bitfield #:while #:aif #:awhen #:with-gensyms #:make-keyword #:dump-data)
+  (:export #:warn-user *break-on-warn-user* #:printable-array #:upto-null #:redirect #:memoize
+           #:it #:*standard-optimize-settings* #:get-bitfield #:while #:aif #:awhen #:with-gensyms #:make-keyword #:dump-data)
+  (:use #:common-lisp))
+
+(defpackage #:profile
+  (:export #:on #:off #:reset #:report)
   (:use #:common-lisp))
 
 (defpackage #:iso-639-2

profile.lisp

@@ -1,25 +1,32 @@
-;;; -*- Mode: Lisp;  show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: CL-USER; -*-
+;;; -*- Mode: Lisp;  show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: PROFILE; -*-
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 
 ;;;;;;;;;;;;;;;;;;;; Handy, dandy CCL profile functions ;;;;;;;;;;;;;;;;;;;;
 ;;;
-;;; Usage: load and compile this file, then at REPL, type "profile-on".  After
-;;; running programs, type "profile-report" to get a profile listing.
-;;; "profile-reset" clears counters
-;;; "profil-off" turns of profiling
-(in-package #:cl-user)
+;;; Usage: load and compile this file, then at REPL, type "profile:on".  After
+;;; running programs, type "profile:report" to get a profile listing.
+;;; "profile:reset" clears counters
+;;; "profil:off" turns of profiling
+(in-package #:profile)
+#-CCL (progn
+        (defun on     () (error "Not Yet"))
+        (defun off    () (error "Not Yet"))
+        (defun report () (error "Not Yet"))
+        (defun reset  () (error "Not Yet")))
 
-(defun profile-on ()
-  (dolist (p '("MP4-ATOM" "MPEG" "AUDIO-STREAMS" "ID3-FRAME" "UTILS" "LOGGING" "ISO-639-2" "ABSTRACT-TAG" "FLAC-FRAME"))
-    (let ((pkg (find-package p)))
-      (mon:monitor-all pkg)
-      (format t "Package ~a, ~:d~%" pkg (length mon:*monitored-functions*)))))
+#+CCL (progn
+        (defun on ()
+          (dolist (p '("MP4-ATOM" "MPEG" "AUDIO-STREAMS" "ID3-FRAME" "UTILS" "LOGGING" "ISO-639-2" "ABSTRACT-TAG" "FLAC-FRAME"))
+            (let ((pkg (find-package p)))
+              (mon:monitor-all pkg)
+              (format t "Package ~a, ~:d~%" pkg (length mon:*monitored-functions*))))
+          (format t "~&~&WARNING: YOU MUST TURN PROFILING OFF BEFORE RECOMPILING LIBRARY!!!~%"))
 
-(defun profile-report ()
-  (mon:report :nested :inclusive :threshold 0.0 :names :all))
+        (defun report (&key (sort-key :percent-time) (nested :exclusive))
+          (mon:report :sort-key sort-key :nested nested :threshold 0.0 :names :all))
 
-(defun profile-reset ()
-  (mon:reset-all-monitoring))
+        (defun reset ()
+          (mon:reset-all-monitoring))
 
-(defun profile-off ()
-  (mon:unmonitor))
+        (defun off ()
+          (mon:unmonitor)))

taglib.asd

@@ -8,6 +8,7 @@
   :license "Public Domain"
   :depends-on (#:log5 #:optima #:optima.ppcre)
   :components ((:file "packages")
+			   (:file "profile"       :depends-on ("packages"))
                (:file "utils"         :depends-on ("packages"))
                (:file "audio-streams" :depends-on ("packages" "utils"))
                (:file "mpeg"          :depends-on ("packages" "audio-streams" "utils"))

utils.lisp

@@ -2,14 +2,19 @@
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 (in-package #:utils)
 
-(defparameter *break-on-warn-user* nil "set to T if you'd like to stop in warn user")
+#+CCL (eval-when (:compile-toplevel :load-toplevel :exec)
+        (defvar *standard-optimize-settings* '(optimize (speed 3) (safety 0) (space 0) (debug 0))))
+
+;; #+SBCL (eval-when (:compile-toplevel :load-toplevel :execute)
+;;          (defvar *standard-optimize-settings* '(optimize (speed 3) (safety 0) (space 0) (debug 0))))
+
+(defparameter *break-on-warn-user* nil "set to T if you'd like to stop in warn-user")
 
-;;; COMPLETELY UNPORTABLE!!!
 (defun warn-user (format-string &rest args)
-  "print a warning error to *ERROR-OUTPUT* and continue"
+  "Print a warning error to *ERROR-OUTPUT* and continue"
   (when *break-on-warn-user* (break "Breaking in WARN-USER"))
   (format *error-output* "~&********************************************************************************~%")
-  (format *error-output* "~&WARNING in ~a:: " (ccl::%last-fn-on-stack 1))
+  #+CCL (format *error-output* "~&WARNING in ~a:: " (ccl::%last-fn-on-stack 1))
   (apply #'format *error-output* format-string args)
   (format *error-output* "~&**********************************************************************************~%"))
 
@@ -17,6 +22,7 @@
 
 (defun printable-array (array &optional (max-len *max-raw-bytes-print-len*))
   "Given an array, return a string of the first *MAX-RAW-BYTES-PRINT-LEN* bytes"
+  (declare #.utils:*standard-optimize-settings*)
   (let* ((len (length array))
          (print-len (min len max-len))
          (printable-array (make-array print-len :displaced-to array)))
@@ -24,6 +30,7 @@
 
 (defun upto-null (string)
   "Trim STRING to end at first NULL found"
+  (declare #.utils:*standard-optimize-settings*)
   (subseq string 0 (position #\Null string)))
 
 (defun dump-data (file-name data)
@@ -39,6 +46,7 @@
 (defun get-bitmask(start width)
   "Create a bit mask that begins at bit START (31 is MSB) and is WIDTH bits wide.
 Example: (get-bitmask 31 11) -->> #xffe00000"
+  (declare #.utils:*standard-optimize-settings*)
   (ash (- (ash 1 width) 1) (- (1+ start) width)))
 
 (defmacro get-bitfield (int start width)
@@ -70,6 +78,27 @@ The above will expand to (ash (logand #xFFFBB240 #xFFE00000) -21) at COMPILE tim
   `(aif ,test-form
         (progn ,@body)))
 
-(defmacro fastest (&body body)
-  `(locally (declare (optimize (speed 3) (safety 0) (debug 0)))
-     ,@body))
+(defun mk-memoize (func)
+  "Takes a normal function object and returns a memoized one"
+  (let* (;(count 0)
+         (hash-table (make-hash-table :test 'equal)))
+    #'(lambda (arg)
+        ;;(format t "Looking for <~a>~%" arg)
+        (multiple-value-bind (value foundp) (gethash arg hash-table)
+          ;;(incf count)
+
+          ;; (when (> count 20)
+          ;;   (break "Breaking as requested")
+          ;;   (setf count 0))
+
+          (if foundp
+              (progn
+                ;;(format t "Already seen <~a>~%" arg)
+                value)
+              (progn
+                ;;(format t "First time seen <~a>~%" arg)
+                (setf (gethash arg hash-table) (funcall func arg))))))))
+
+(defmacro memoize (func-name)
+  "Memoize function associated with Function-Name. Simplified version"
+  `(setf (symbol-function ,func-name) (utils::mk-memoize (symbol-function ,func-name))))