continuing cleanup; rewrote mp3 audio info code

audio-streams.lisp

@@ -2,7 +2,11 @@
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 
 (in-package #:audio-streams)
-;(in-package #:common-lisp-user)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defconstant +optimize-fastest+ '(optimize (speed 3) (safety 0) (debug 0)))
+  (defmacro fastest (&body body)
+    `(locally (declare ,+optimize-fastest+)
+       ,@body)))
 
 (log5:defcategory cat-log-stream)
 (defmacro log-stream (&rest log-stuff) `(log5:log-for (cat-log-stream) ,@log-stuff))
@@ -44,13 +48,8 @@
 
 (defmethod stream-close ((stream mem-stream))
   (with-mem-stream-slots (stream)
-    (when vect
-      (when fn
-        (setf fn nil)
-        (ccl:unmap-octet-vector vect)
-        (setf fn nil)))
-    (setf index nil)
-    (setf len nil)
+    (when fn
+      (ccl:unmap-octet-vector vect))
     (setf vect nil)))
 
 (defmethod stream-seek ((stream mem-stream) &optional (offset 0) (from :current))
@@ -67,14 +66,17 @@
 (defmethod stream-size ((stream mem-stream)) (len stream))
 
 (defun read-n-bytes (stream n-bytes &key (bits-per-byte 8))
-  (with-mem-stream-slots (stream)
-    (when (<= (+ index n-bytes) len)
-      (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))))
-    nil)
+  (fastest
+    (with-mem-stream-slots (stream)
+      (when (<= (+ index n-bytes) len)
+        (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))))
+    nil))
+
+(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))
 (defmethod stream-read-u16 ((stream mem-stream) &key (bits-per-byte 8)) (read-n-bytes stream 2 :bits-per-byte bits-per-byte))
@@ -83,25 +85,26 @@
 (defmethod stream-read-u64 ((stream mem-stream) &key (bits-per-byte 8)) (read-n-bytes stream 8 :bits-per-byte bits-per-byte))
 
 (defmethod stream-read-sequence ((stream mem-stream) size &key (bits-per-byte 8))
-  (with-mem-stream-slots (stream)
-    (when (> (+ index size) len)
-      (setf size (- len index)))
-    (ecase bits-per-byte
-      (8 (let ((octets (make-array size :element-type 'octet :displaced-to vect :displaced-index-offset index :adjustable nil)))
-           (incf index size)
-           (values octets size)))
-      (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))))))
+  (fastest
+    (with-mem-stream-slots (stream)
+      (when (> (+ index size) len)
+        (setf size (- len index)))
+      (ecase bits-per-byte
+        (8 (let ((octets (make-array size :element-type 'octet :displaced-to vect :displaced-index-offset index :adjustable nil)))
+             (incf index size)
+             (values octets size)))
+        (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)))))))
 
 (defclass mp3-file-stream (mem-stream)
   ((id3-header :accessor id3-header :initform nil :documentation "holds all the ID3 info")

id3-frame.lisp

@@ -866,6 +866,7 @@ Note: extended headers are subject to unsynchronization, so make sure that INSTR
       (when (or (= version 3) (= version 4))
         (setf frame-flags (stream-read-u16 instream))
         (when (not (valid-frame-flags version frame-flags))
+          (log-id3-frame "Invalid frame flags found ~a, will ignore" (print-frame-flags version frame-flags nil))
           (warn-user "Invalid frame flags found ~a, will ignore" (print-frame-flags version frame-flags nil))))
 
       (log-id3-frame "making frame: id:~a, version: ~d, len: ~:d, flags: ~a"

mp4-atom.lisp

@@ -232,7 +232,8 @@ Loop through this container and construct constituent atoms"
 (defmacro simple-a-b-decode (type)
   `(defmethod decode-ilst-data-atom ((type (eql +itunes-ilst-data+)) atom (atom-parent-type (eql ,type)) mp4-file)
      (let ((tmp (stream-read-u16 mp4-file)))
-       (format t "ilist decode, parent = ~a: ~x~%" (as-string atom-parent-type) tmp))
+       (declare (ignore tmp)))
+       ;(format t "ilist decode, parent = ~a: ~x~%" (as-string atom-parent-type) tmp))
      (let ((a) (b))
        (setf a (stream-read-u16 mp4-file))
        (setf b (stream-read-u16 mp4-file))

mpeg.lisp

@@ -2,6 +2,12 @@
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 (in-package #:mpeg)
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defconstant +optimize-fastest+ '(optimize (speed 3) (safety 0) (debug 0)))
+  (defmacro fastest (&body body)
+    `(locally (declare ,+optimize-fastest+)
+       ,@body)))
+
 (log5:defcategory cat-log-mpeg-frame)
 (defmacro log-mpeg-frame (&rest log-stuff) `(log5:log-for (cat-log-mpeg-frame) ,@log-stuff))
 
@@ -77,25 +83,25 @@
                     (= (the fixnum version) (the fixnum +mpeg-2.5+))) 576)))))
 
 (defclass frame ()
-  ((pos            :accessor pos :initarg :pos)
-   (hdr-u32        :accessor hdr-u32 :initarg :hdr-u32)
-   (samples        :accessor samples :initarg :samples)
-   (sync           :accessor sync :initarg :sync)
-   (version        :accessor version :initarg :version)
-   (layer          :accessor layer :initarg :layer)
-   (protection     :accessor protection :initarg :protection)
-   (bit-rate       :accessor bit-rate :initarg :bit-rate)
-   (sample-rate    :accessor sample-rate :initarg :sample-rate)
-   (padded         :accessor padded :initarg :padded)
-   (private        :accessor private :initarg :private)
-   (channel-mode   :accessor channel-mode :initarg :channel-mode)
+  ((pos            :accessor pos            :initarg :pos)
+   (hdr-u32        :accessor hdr-u32        :initarg :hdr-u32)
+   (samples        :accessor samples        :initarg :samples)
+   (sync           :accessor sync           :initarg :sync)
+   (version        :accessor version        :initarg :version)
+   (layer          :accessor layer          :initarg :layer)
+   (protection     :accessor protection     :initarg :protection)
+   (bit-rate       :accessor bit-rate       :initarg :bit-rate)
+   (sample-rate    :accessor sample-rate    :initarg :sample-rate)
+   (padded         :accessor padded         :initarg :padded)
+   (private        :accessor private        :initarg :private)
+   (channel-mode   :accessor channel-mode   :initarg :channel-mode)
    (mode-extension :accessor mode-extension :initarg :mode-extension)
-   (copyright      :accessor copyright :initarg :copyright)
-   (original       :accessor original :initarg :original)
-   (emphasis       :accessor emphasis :initarg :emphasis)
-   (size           :accessor size :initarg :size)
-   (vbr            :accessor vbr :initarg :vbr)
-   (payload        :accessor payload :initarg :payload))
+   (copyright      :accessor copyright      :initarg :copyright)
+   (original       :accessor original       :initarg :original)
+   (emphasis       :accessor emphasis       :initarg :emphasis)
+   (size           :accessor size           :initarg :size)
+   (vbr            :accessor vbr            :initarg :vbr)
+   (payload        :accessor payload        :initarg :payload))
   (:default-initargs :pos nil :hdr-u32 nil :samples 0 :sync 0 :version 0 :layer 0 :protection 0 :bit-rate 0
                      :sample-rate 0 :padded 0 :private 0 :channel-mode 0 :mode-extension 0
                      :copyright 0 :original 0 :emphasis 0 :size nil :vbr nil :payload nil))
@@ -171,81 +177,84 @@
                               (+ (* 72  (/ bit-rate sample-rate)) padded)))))))
 
 (defmethod load-frame ((me frame) &key instream (read-payload nil))
-  (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))))
+  "Load an MPEG frame from current file position"
+  (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)))))
 
 (defmethod parse-header ((me frame))
-  (log5:with-context "parse-header"
-    (with-frame-slots (me)
-      (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))
-
-      (setf version (ldb (byte 2 3) (ldb (byte 8 16) hdr-u32)))
-      (when (not (valid-version version))
-        (log-mpeg-frame "bad version ~d" version)
-        (return-from parse-header nil))
-
-      (setf layer (ldb (byte 2 1) (ldb (byte 8 16) hdr-u32)))
-      (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 samples (get-samples-per-frame version layer))
-
-      (let ((br-index (the fixnum (ldb (byte 4 4) (ldb (byte 8 8) hdr-u32)))))
-        (when (not (valid-bit-rate-index br-index))
-          (log-mpeg-frame "bad bit-rate index ~d" br-index)
+  (fastest
+    (log5:with-context "parse-header"
+      (with-frame-slots (me)
+        (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))
-        (setf bit-rate (get-bit-rate version layer br-index)))
 
-      (let ((sr-index (the fixnum (ldb (byte 2 2) (ldb (byte 8 8) hdr-u32)))))
-        (when (not (valid-sample-rate-index sr-index))
-          (log-mpeg-frame "bad sample-rate index ~d" sr-index)
+        (setf version (ldb (byte 2 3) (ldb (byte 8 16) hdr-u32)))
+        (when (not (valid-version version))
+          (log-mpeg-frame "bad version ~d" version)
           (return-from parse-header nil))
-        (setf sample-rate (get-sample-rate version sr-index)))
 
-      (setf padded (ldb (byte 1 1) (ldb (byte 8 8) hdr-u32)))
-      (setf private (ldb (byte 1 0) (ldb (byte 8 8) hdr-u32)))
+        (setf layer (ldb (byte 2 1) (ldb (byte 8 16) hdr-u32)))
+        (when (not (valid-layer layer))
+          (log-mpeg-frame "bad layer ~d" layer)
+          (return-from parse-header nil))
 
-      (setf channel-mode (ldb (byte 2 6) (ldb (byte 8 0) hdr-u32)))
-      (setf mode-extension (ldb (byte 2 4) (ldb (byte 8 0) hdr-u32)))
-      (setf copyright (ldb (byte 1 3) (ldb (byte 8 0) hdr-u32)))
-      (setf original (ldb (byte 1 2) (ldb (byte 8 0) hdr-u32)))
-      (setf emphasis (ldb (byte 2 0) (ldb (byte 8 0) hdr-u32)))
-      (when (not (valid-emphasis emphasis))
-        (log-mpeg-frame "bad emphasis ~d" emphasis)
-        (return-from parse-header nil))
+        (setf protection (ldb (byte 1 0) (ldb (byte 8 16) hdr-u32)))
+        (setf samples (get-samples-per-frame version layer))
+
+        (let ((br-index (the fixnum (ldb (byte 4 4) (ldb (byte 8 8) hdr-u32)))))
+          (when (not (valid-bit-rate-index br-index))
+            (log-mpeg-frame "bad bit-rate index ~d" br-index)
+            (return-from parse-header nil))
+          (setf bit-rate (get-bit-rate version layer br-index)))
+
+        (let ((sr-index (the fixnum (ldb (byte 2 2) (ldb (byte 8 8) hdr-u32)))))
+          (when (not (valid-sample-rate-index sr-index))
+            (log-mpeg-frame "bad sample-rate index ~d" sr-index)
+            (return-from parse-header nil))
+          (setf sample-rate (get-sample-rate version sr-index)))
+
+        (setf padded (ldb (byte 1 1) (ldb (byte 8 8) hdr-u32)))
+        (setf private (ldb (byte 1 0) (ldb (byte 8 8) hdr-u32)))
+
+        (setf channel-mode (ldb (byte 2 6) (ldb (byte 8 0) hdr-u32)))
+        (setf mode-extension (ldb (byte 2 4) (ldb (byte 8 0) hdr-u32)))
+        (setf copyright (ldb (byte 1 3) (ldb (byte 8 0) hdr-u32)))
+        (setf original (ldb (byte 1 2) (ldb (byte 8 0) hdr-u32)))
+        (setf emphasis (ldb (byte 2 0) (ldb (byte 8 0) hdr-u32)))
+        (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"
@@ -263,12 +272,12 @@
                 (format s "~%frame payload[~:d] = ~a~%" (length payload) payload))))))
 
 (defclass vbr-info ()
-  ((tag    :accessor tag :initarg :tag)
-   (flags  :accessor flags :initarg :flags)
+  ((tag    :accessor tag    :initarg :tag)
+   (flags  :accessor flags  :initarg :flags)
    (frames :accessor frames :initarg :frames)
-   (bytes  :accessor bytes :initarg :bytes)
-   (tocs   :accessor tocs :initarg :tocs)
-   (scale  :accessor scale :initarg :scale))
+   (bytes  :accessor bytes  :initarg :bytes)
+   (tocs   :accessor tocs   :initarg :tocs)
+   (scale  :accessor scale  :initarg :scale))
   (:default-initargs :tag nil :flags 0 :frames nil :bytes nil :tocs nil :scale nil))
 
 (defmacro with-vbr-info-slots ((instance) &body body)
@@ -292,6 +301,8 @@
     (with-frame-slots (me)
       (let ((i (get-side-info-size version channel-mode)))
         (log-mpeg-frame "array index = ~d, payload size = ~d" i (length payload))
+        (when (>= i (length payload))
+          (return-from check-vbr nil))
         (when (or (and (= (aref payload (+ i 0)) (char-code #\X))
                        (= (aref payload (+ i 1)) (char-code #\i))
                        (= (aref payload (+ i 2)) (char-code #\n))
@@ -330,109 +341,114 @@
             tag flags frames bytes tocs scale)))
 
 (defun find-first-sync (in)
-  (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)
-              (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)
-                      (log-mpeg-frame "Valid header being returned: ~a, searched ~:d times" hdr count)
-                      (return-from find-first-sync hdr))
-                    (progn
+  (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)
+                (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)
+                        (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)))
+          (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)
-  (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))))
+  (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)))))
 
 (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))
-  (log5:with-context "next-frame"
-    (log-mpeg-frame "mapping frames, start pos ~:d" start-pos)
+  (fastest
+    (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)
+      (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))))
-
-(defun get-mpeg-bit-rate-exhaustive (in)
-  (let ((n-frames 0)
-        (total-len 0)
-        (last-bit-rate nil)
-        (bit-rate-total 0)
-        (vbr nil))
-    (map-frames in (lambda (f)
-                     (incf n-frames)
-                     (incf total-len (float (/ (samples f) (sample-rate f))))
-                     (incf bit-rate-total (bit-rate f))
-                     (if (null last-bit-rate)
-                         (setf last-bit-rate (bit-rate f))
-                         (progn
-                           (when (not (= last-bit-rate (bit-rate f)))
-                             (setf vbr t))
-                           (setf last-bit-rate (bit-rate f)))))
-                :read-payload nil)
-    (if (or (zerop n-frames) (zerop bit-rate-total))
-        (values nil nil nil)
-        (values vbr (float (/ bit-rate-total n-frames)) total-len))))
-
-(defun get-mpeg-bit-rate-ff (in)
-  (let ((ff (find-first-sync in)))
-    (if (not ff)
-        (return-from get-mpeg-bit-rate-ff (values nil nil)))
-    (if (vbr ff)
-        (let* ((len (float (* (frames (vbr ff)) (/ (samples ff) (sample-rate ff)))))
-               (br (float (/ (* 8 (bytes (vbr ff)) ) len))))
-          (values t br len))
-        (values nil nil nil))))
+          (log-mpeg-frame "map-frames: at pos ~:d, dispatching function" (pos frame))
+          (funcall func frame)))))
+
+;; (defun get-mpeg-bit-rate-exhaustive (in)
+;;   (let ((n-frames 0)
+;;         (total-len 0)
+;;         (last-bit-rate nil)
+;;         (bit-rate-total 0)
+;;         (vbr nil))
+;;     (map-frames in (lambda (f)
+;;                      (incf n-frames)
+;;                      (incf total-len (float (/ (samples f) (sample-rate f))))
+;;                      (incf bit-rate-total (bit-rate f))
+;;                      (if (null last-bit-rate)
+;;                          (setf last-bit-rate (bit-rate f))
+;;                          (progn
+;;                            (when (not (= last-bit-rate (bit-rate f)))
+;;                              (setf vbr t))
+;;                            (setf last-bit-rate (bit-rate f)))))
+;;                 :read-payload nil)
+;;     (if (or (zerop n-frames) (zerop bit-rate-total))
+;;         (values nil nil nil)
+;;         (values vbr (float (/ bit-rate-total n-frames)) total-len))))
+
+;; (defun get-mpeg-bit-rate-ff (in)
+;;   (let ((ff (find-first-sync in)))
+;;     (if (not ff)
+;;         (return-from get-mpeg-bit-rate-ff (values nil nil)))
+;;     (if (vbr ff)
+;;         (let* ((len (float (* (frames (vbr ff)) (/ (samples ff) (sample-rate ff)))))
+;;                (br (float (/ (* 8 (bytes (vbr ff)) ) len))))
+;;           (values t br len))
+;;         (values nil nil nil))))
 
 (defclass mpeg-audio-info ()
-  ((is-vbr      :accessor is-vbr :initarg :is-vbr :initform nil)
-   (bit-rate    :accessor bit-rate :initarg :bit-rate :initform nil)
+  ((is-vbr      :accessor is-vbr      :initarg :is-vbr      :initform nil)
+   (n-frames    :accessor n-frames    :initarg :n-frames    :initform 0)
+   (bit-rate    :accessor bit-rate    :initarg :bit-rate    :initform nil)
    (sample-rate :accessor sample-rate :initarg :sample-rate :initform nil)
-   (len         :accessor len :initarg :len :initform nil)
-   (version     :accessor version :initarg :version :initform nil)
-   (layer       :accessor layer :initarg :layer :initform nil)))
+   (len         :accessor len         :initarg :len         :initform nil)
+   (version     :accessor version     :initarg :version     :initform nil)
+   (layer       :accessor layer       :initarg :layer       :initform nil)))
 
 (defmethod vpprint ((me mpeg-audio-info) stream)
-  (with-slots (is-vbr sample-rate  bit-rate len version layer) me
-    (format stream "~a, ~a, ~:[CBR,~;VBR,~] sample rate: ~:d Hz, bit rate: ~:d Kbps, duration: ~:d:~2,'0d"
+  (with-slots (is-vbr sample-rate bit-rate len version layer n-frames) me
+    (format stream "~:d frames read, ~a, ~a, ~:[CBR,~;VBR,~] sample rate: ~:d Hz, bit rate: ~:d Kbps, duration: ~:d:~2,'0d"
+            n-frames
             (get-mpeg-version-string version)
             (get-layer-string layer)
             is-vbr
@@ -441,66 +457,62 @@
             (floor (/ len 60)) (round (mod len 60)))))
 
 
-(defun get-mpeg-audio-info (in &key (max-frames *max-frames-to-read*))
-  "Get MPEG Layer 3 audio information."
+(defun get-mpeg-audio-info (in &key) ;; (max-frames *max-frames-to-read*))
+  "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."
   (log5:with-context "get-mpeg-audio-info"
-    (let ((pos (stream-seek in))
-          (first-frame (find-first-sync in))
+    (let ((first-frame (find-first-sync in))
           (info (make-instance 'mpeg-audio-info)))
 
       (log-mpeg-frame "search for first frame yielded ~a" (vpprint first-frame nil))
       (when (null first-frame)
         (return-from get-mpeg-audio-info nil))
 
-      (with-slots (is-vbr sample-rate bit-rate len version layer) info
+      (with-slots (is-vbr sample-rate bit-rate len version layer n-frames) info
         (setf version (version first-frame))
         (setf layer (layer first-frame))
         (setf sample-rate (sample-rate first-frame))
+
         (if (vbr first-frame)
             (progn
               (log-mpeg-frame "found Xing/Info header")
+              (setf n-frames 1)
               (setf is-vbr t)
               (setf len (float (* (frames (vbr first-frame)) (/ (samples first-frame) (sample-rate first-frame)))))
               (setf bit-rate  (float (/ (* 8 (bytes (vbr first-frame)) ) len))))
-            (let ((n-frames 0)
-                  (total-len 0)
-                  (last-bit-rate nil)
-                  (bit-rate-total 0)
-                  (vbr nil))
-              (stream-seek in pos :start)
-              (log-mpeg-frame "no Xing/Info, so mapping frames")
-              (map-frames in (lambda (f)
-                               (incf n-frames)
-                               (incf total-len (float (/ (samples f) (sample-rate f))))
-                               (incf bit-rate-total (bit-rate f))
-                               (if (null last-bit-rate)
-                                   (setf last-bit-rate (bit-rate f))
-                                   (progn
-                                     (when (not (= last-bit-rate (bit-rate f)))
-                                       (setf vbr t))
-                                     (setf last-bit-rate (bit-rate f)))))
-                          :read-payload nil :max max-frames)
-              (if (or (< n-frames 10) (zerop bit-rate-total))
-                  (progn
-                    (log-mpeg-frame "couldn't get audio-info: only got ~d frames" n-frames)
-                    (return-from get-mpeg-audio-info nil))
-                  (progn
-                    (setf is-vbr vbr)
-                    (setf len total-len)
-                    (setf bit-rate (float (/ bit-rate-total n-frames))))))))
-      info)))
-
-
-#|
-
-if we have a xing header, we use
-  num-frames, num-bytes from xing header and
-  sample-rate and layer info (to get num samples/sec---for layer 3 its 1152)
-
-then:
-
-  length in seconds is  =  num-frames * (1152 / sample-rate)
-  bit-rate is = (8 * num-bytes) / length in seconds, then divide by 1000 to get kbits/sec
----------
-
-|#
+            (let* ((first (pos first-frame))
+                   (last (- (audio-streams:stream-size in) (if (id3-frame::v21-tag-header (id3-header in)) 128 0)))
+                   (n-frames (round (/ (float (- last first)) (float (size first-frame)))))
+                   (n-sec   (round (/ (float (* (size first-frame) n-frames)) (float (* 125 (float (/ (bit-rate first-frame) 1000))))))))
+              (setf is-vbr nil)
+              (setf len n-sec)
+              (setf bit-rate (float (bit-rate first-frame))))))
+
+            info)))
+
+              ;; If you want to calculate exhaustively, replace the LET* above with this code
+              ;; (let ((total-len 0)
+              ;;     (last-bit-rate nil)
+              ;;     (bit-rate-total 0)
+              ;;     (vbr nil))
+              ;; (log-mpeg-frame "no Xing/Info, so mapping frames")
+              ;; (map-frames in (lambda (f)
+              ;;                  (incf n-frames)
+              ;;                  (incf total-len (float (/ (samples f) (sample-rate f))))
+              ;;                  (incf bit-rate-total (bit-rate f))
+              ;;                  (if (null last-bit-rate)
+              ;;                      (setf last-bit-rate (bit-rate f))
+              ;;                      (progn
+              ;;                        (when (not (= last-bit-rate (bit-rate f)))
+              ;;                          (setf vbr t))
+              ;;                        (setf last-bit-rate (bit-rate f)))))
+              ;;             :read-payload nil :start-pos 0 :max max-frames)
+              ;; (if (or (< n-frames 10) (zerop bit-rate-total))
+              ;;     (progn
+              ;;       (log-mpeg-frame "couldn't get audio-info: only got ~d frames" n-frames)
+              ;;       (return-from get-mpeg-audio-info nil))
+              ;;     (progn
+              ;;       (setf is-vbr vbr)
+              ;;       (setf len total-len)
+              ;;       (setf bit-rate (float (/ bit-rate-total n-frames))))))))

taglib-tests.asd

@@ -3,7 +3,6 @@
 ;;;
 
 ;(pushnew :I-AM-MARKV *features*)
-;(pushnew :USE-MMAP *features*)
 
 (asdf:defsystem #:taglib-tests
   :description "Simple demo/test code for taglib"

taglib-tests.lisp

@@ -91,7 +91,7 @@
                                           (when file
                                             (mp4-tag:show-tags file :raw raw)))))))))
 
-(defun time-test (dir &key (file-system-encoding :utf-8) (do-audio-processing t))
+(defun time-test (&optional (dir "Queen") &key (file-system-encoding :utf-8) (do-audio-processing t))
   "Time parsing of DIR."
   (let ((mp3-count 0)
         (mp4-count 0)
@@ -112,3 +112,45 @@
         (time (do-dir dir)))
       (format t "~:d MP3s, ~:d MP4s, ~:d Others~%"
               mp3-count mp4-count other-count))))
+
+(defun touch-every-byte (fn)
+  (let ((f))
+    (unwind-protect
+         (progn
+           (setf f (make-file-stream fn))
+           (do ((b (stream-read-u8 f) (stream-read-u8 f)))
+               ((null b))))
+      (when f (stream-close f)))))
+
+
+(defun time-test-x (dir)
+  "Time reading every byte of every audio file in dir (for comparision with time-test above"
+  (let ((mp3-count 0)
+        (mp4-count 0)
+        (other-count 0))
+    (labels ((do-dir (dir)
+               (osicat:walk-directory dir (lambda (f)
+                                            (let ((full-name (merge-pathnames (ccl:current-directory) (pathname f))))
+                                              (cond ((utils:has-extension f "mp3")
+                                                     (incf mp3-count)
+                                                     (touch-every-byte full-name))
+                                                    ((utils:has-extension f "m4a")
+                                                     (incf mp4-count)
+                                                     (touch-every-byte full-name))
+                                                    (t
+                                                     (incf other-count))))))))
+      (time (do-dir dir)))
+    (format t "~:d MP3s, ~:d MP4s, ~:d Others~%"
+              mp3-count mp4-count other-count)))
+
+(defun frame-test (fn)
+  (let* ((n 0)
+         (last 0)
+         (s (make-file-stream fn)))
+    (mpeg::map-frames s
+                      (lambda (f)
+                        (let* ((here (stream-seek s 0))
+                               (gap (- here last)))
+                          (incf n)
+                          (setf last here)
+                          (format t "~9d:: pos ~:d, ~:d, ~:d~%" n here (mpeg::size f) gap))) :start-pos 0)))

utils.lisp

@@ -9,9 +9,9 @@
   "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))
+  (format *error-output* "~&WARNING in ~a:: " (ccl::%last-fn-on-stack 1))
   (apply #'format *error-output* format-string args)
-  (format *error-output* "**********************************************************************************~%"))
+  (format *error-output* "~&**********************************************************************************~%"))
 
 (defparameter *max-raw-bytes-print-len* 10 "Max number of octets to print from an array")