changing conditional compilation to be based off lisp type rather than something I pushed into *features*

taglib-tests.asd

@@ -5,7 +5,5 @@
   :description "Simple demo/test code for taglib"
   :author "Mark VandenBrink"
   :license "Public Domain"
-  :depends-on (#:taglib
-               #+ENABLE-MP #:chanl
-               #:cl-fad)
+  :depends-on (#:taglib #:cl-fad #+(or :ccl :sbcl :abcl) #:chanl)
   :components ((:file "taglib-tests")))

taglib-tests.lisp

@@ -72,110 +72,111 @@
             :file-system-encoding file-system-encoding :func nil))))
 
 ;;;; multi-thread code below
-#+ENABLE-MP (progn
+#+(or :ccl :sbcl :abcl)
+(progn
 
-(defparameter *end-thread*  #xdeadbeef)
-(defparameter *max-threads* 4)
+  (defparameter *end-thread*  #xdeadbeef)
+  (defparameter *max-threads* 4)
 
 ;;; Simple structure to hold a thread's results
-(defstruct chanl-results
-  name
-  mp3-count
-  flac-count
-  mp4-count
-  other-count)
-
-(defun mp-do-audio-dir (&key (dir "/home/markv/Music/Queen")
-                             (file-system-encoding :utf-8)
-                             (func nil))
-  "Walk :DIR and FUNCALL specified function for each file audio found."
-  (set-pathname-encoding file-system-encoding)
-  (let ((channel      (make-instance 'chanl:unbounded-channel))
-        (dead-channel (make-instance 'chanl:unbounded-channel))
-        (mp3-count   0)
-        (flac-count  0)
-        (mp4-count   0)
-        (other-count 0))
-
-    ;; This function is run by each thread
-    ;; Thread sits in a loop, reading from CHAN.  If that read
-    ;; returns the integer *END-THREAD*, then thread exits; otherwise,
-    ;; it runs DO-AUDIO-FILE on the file passed in.
-    (labels ((thread-reader ()
-               (declare (special *me*))
-               (let ((f)
-                     (results (make-chanl-results :name *me* :mp3-count 0
-                                                  :flac-count 0 :mp4-count 0
-                                                  :other-count 0)))
-                 (loop
-                   (with-slots (name mp3-count mp4-count flac-count other-count) results
-                     (setf f (chanl:recv channel))
-                     (when (and (typep f 'integer)
-                                (= f *end-thread*))
-                       (chanl:send dead-channel results)
-                       (return-from thread-reader nil))
-
-                     (do-audio-file :file f
-                       :func (lambda (s)
-                               (cond ((typep s 'id3-frame:mp3-file)
-                                      (incf mp3-count))
-                                     ((typep s 'flac-frame:flac-file)
-                                      (incf flac-count))
-                                     ((typep s 'mp4-atom:mp4-file)
-                                      (incf mp4-count))
-                                     ((null s)
-                                      (incf other-count)))
-                               (when (and (not (null s)) func)
-                                 (funcall func s)))))))))
-
-      ;; first, add all files in DIR to CHANNEL
-      (cl-fad:walk-directory dir (lambda (f) (chanl:send channel f)))
-
-      ;; At this point, CHANNEL is stuffed with files.
-      ;; Now, send *MAX-THREADS* "ends" (at end of CHANNEL) and
-      ;; spawn *MAX-THREADS* threads
-      (dotimes (i *max-threads*)
-        (chanl:send channel *end-thread*))
-      (dotimes (i *max-threads*)
-        (chanl:pcall
-         #'thread-reader
-         :initial-bindings `((*me* ,(format nil "reader-thread-~d" i)))))
-
-      ;; sit in loop until we read *MAX-THREADS* results
-      (block thread-reap
-        (let ((i 0)
-              results)
-
-          (format t "Waiting on ~d threads~%" *max-threads*)
-          (loop
-            (force-output *standard-output*)
-            (setf results (chanl:recv dead-channel))
-            (format t "~4t~a died, ~:d MP3s, ~:d MP4s, ~:d FLACs, ~:d Others~%"
-                    (chanl-results-name results)
-                    (chanl-results-mp3-count results)
-                    (chanl-results-mp4-count results)
-                    (chanl-results-flac-count results)
-                    (chanl-results-other-count results))
-            (force-output *standard-output*)
-
-            (incf mp3-count (chanl-results-mp3-count results))
-            (incf mp4-count (chanl-results-mp4-count results))
-            (incf flac-count (chanl-results-flac-count results))
-            (incf other-count (chanl-results-other-count results))
-            (incf i)
-
-            (when (= i *max-threads*)
-              (return-from thread-reap *max-threads*)))))
-
-      (format t "All threads done~%")
-      (format t "~&~:d MP3s, ~:d MP4s, ~:d FLACS, ~:d Others, for a total of ~:d files~%"
-              mp3-count mp4-count flac-count other-count
-              (+ mp3-count mp4-count flac-count other-count)))))
-
-(defun mp-time-test (&key (dir "/home/markv/Music/Queen")
-                          (file-system-encoding :utf-8) (do-audio-processing t))
-  "Time parsing of DIR."
-  (set-pathname-encoding file-system-encoding)
-  (let ((audio-streams:*get-audio-info* do-audio-processing))
-    (time (mp-do-audio-dir :dir dir :file-system-encoding file-system-encoding :func nil))))
-)
+  (defstruct chanl-results
+    name
+    mp3-count
+    flac-count
+    mp4-count
+    other-count)
+
+  (defun mp-do-audio-dir (&key (dir "/home/markv/Music/Queen")
+                               (file-system-encoding :utf-8)
+                               (func nil))
+    "Walk :DIR and FUNCALL specified function for each file audio found."
+    (set-pathname-encoding file-system-encoding)
+    (let ((channel      (make-instance 'chanl:unbounded-channel))
+          (dead-channel (make-instance 'chanl:unbounded-channel))
+          (mp3-count   0)
+          (flac-count  0)
+          (mp4-count   0)
+          (other-count 0))
+
+      ;; This function is run by each thread
+      ;; Thread sits in a loop, reading from CHAN.  If that read
+      ;; returns the integer *END-THREAD*, then thread exits; otherwise,
+      ;; it runs DO-AUDIO-FILE on the file passed in.
+      (labels ((thread-reader ()
+                 (declare (special *me*))
+                 (let ((f)
+                       (results (make-chanl-results :name *me* :mp3-count 0
+                                                    :flac-count 0 :mp4-count 0
+                                                    :other-count 0)))
+                   (loop
+                     (with-slots (name mp3-count mp4-count flac-count other-count) results
+                       (setf f (chanl:recv channel))
+                       (when (and (typep f 'integer)
+                                  (= f *end-thread*))
+                         (chanl:send dead-channel results)
+                         (return-from thread-reader nil))
+
+                       (do-audio-file :file f
+                         :func (lambda (s)
+                                 (cond ((typep s 'id3-frame:mp3-file)
+                                        (incf mp3-count))
+                                       ((typep s 'flac-frame:flac-file)
+                                        (incf flac-count))
+                                       ((typep s 'mp4-atom:mp4-file)
+                                        (incf mp4-count))
+                                       ((null s)
+                                        (incf other-count)))
+                                 (when (and (not (null s)) func)
+                                   (funcall func s)))))))))
+
+        ;; first, add all files in DIR to CHANNEL
+        (cl-fad:walk-directory dir (lambda (f) (chanl:send channel f)))
+
+        ;; At this point, CHANNEL is stuffed with files.
+        ;; Now, send *MAX-THREADS* "ends" (at end of CHANNEL) and
+        ;; spawn *MAX-THREADS* threads
+        (dotimes (i *max-threads*)
+          (chanl:send channel *end-thread*))
+        (dotimes (i *max-threads*)
+          (chanl:pcall
+           #'thread-reader
+           :initial-bindings `((*me* ,(format nil "reader-thread-~d" i)))))
+
+        ;; sit in loop until we read *MAX-THREADS* results
+        (block thread-reap
+          (let ((i 0)
+                results)
+
+            (format t "Waiting on ~d threads~%" *max-threads*)
+            (loop
+              (force-output *standard-output*)
+              (setf results (chanl:recv dead-channel))
+              (format t "~4t~a died, ~:d MP3s, ~:d MP4s, ~:d FLACs, ~:d Others~%"
+                      (chanl-results-name results)
+                      (chanl-results-mp3-count results)
+                      (chanl-results-mp4-count results)
+                      (chanl-results-flac-count results)
+                      (chanl-results-other-count results))
+              (force-output *standard-output*)
+
+              (incf mp3-count (chanl-results-mp3-count results))
+              (incf mp4-count (chanl-results-mp4-count results))
+              (incf flac-count (chanl-results-flac-count results))
+              (incf other-count (chanl-results-other-count results))
+              (incf i)
+
+              (when (= i *max-threads*)
+                (return-from thread-reap *max-threads*)))))
+
+        (format t "All threads done~%")
+        (format t "~&~:d MP3s, ~:d MP4s, ~:d FLACS, ~:d Others, for a total of ~:d files~%"
+                mp3-count mp4-count flac-count other-count
+                (+ mp3-count mp4-count flac-count other-count)))))
+
+  (defun mp-time-test (&key (dir "/home/markv/Music/Queen")
+                            (file-system-encoding :utf-8) (do-audio-processing t))
+    "Time parsing of DIR."
+    (set-pathname-encoding file-system-encoding)
+    (let ((audio-streams:*get-audio-info* do-audio-processing))
+      (time (mp-do-audio-dir :dir dir :file-system-encoding file-system-encoding :func nil))))
+  )

taglib.asd

@@ -1,16 +1,14 @@
 ;;; -*- Mode: Lisp;  show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: CL-USER; -*-
 ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
 
-(pushnew :DBG *features*)
-;;; Theoretically, CLISP should run multi-threaded, but it keeps crashing...
-#+(or :ccl :sbcl :abcl) (pushnew :ENABLE-MP *features*)
+(pushnew :dbg *features*)
+
 (asdf:defsystem #:taglib
   :description "Pure Lisp implementation to read (and write, perhaps, one day) tags"
   :author "Mark VandenBrink"
   :license "Public Domain"
   :depends-on (#:optima #:optima.ppcre #:flexi-streams
-                        #+ENABLE-MP #:bordeaux-threads
-                        )
+                        #+(or :ccl :sbcl :abcl) #:bordeaux-threads)
   :components ((:file "packages")
                (:file "profile"       :depends-on ("packages"))
                (:file "utils"         :depends-on ("packages"))

utils.lisp

@@ -87,13 +87,16 @@ The above will expand to (ash (logand #xFFFBB240 #xFFE00000) -21) at COMPILE tim
 ;;; Note: CCL hash-tables are thread-safe, but some other implementations
 ;;; don't appear to be...
 (defstruct locked-hash-table lock hash-table)
-#+ENABLE-MP (defmacro with-lock ((l) &body body)
-              `(bt:with-lock-held (,l)
-                 ,@body))
-#-ENABLE-MP (defmacro with-lock ((l) &body body)
-              (declare (ignore l))
-              `(progn
-                 ,@body))
+#+(or :ccl :sbcl :abcl)
+(defmacro with-lock ((l) &body body)
+  `(bt:with-lock-held (,l)
+     ,@body))
+
+#-(or :ccl :sbcl :abcl)
+(defmacro with-lock ((l) &body body)
+  (declare (ignore l))
+  `(progn
+     ,@body))
 
 (defun mk-memoize (func-name)
   "Takes a normal function object and returns a memoized one"