From: mkant+@cs.cmu.edu (Mark Kantrowitz)
Newsgroups: comp.lang.lisp
Subject: Re: Playing sparcaudio directly from lisp
Keywords: Lucid sparcaudio
Date: 8 Jan 93 00:24:04 GMT
Article-I.D.: cs.C0IEG8.G5n.1
Organization: School of Computer Science, Carnegie Mellon

In article <1993Jan7.210217.21559@cs.cornell.edu> raman@cs.cornell.edu (T. V. Raman) writes:
>I plan to start using sparc audio extensively inside a clos program,
>(playing sound files)  and at present I am just calling the shell and
>invoking the play program.
>
>As I am also using the multitasking environment, (the playing of a
>sound is a process)
>things do slow down my clos application.
>
>How much of a performance benefit will I get if I rewrite play in
>lucid directly? I will avoid the overhead of starting a shell each
>time,  but will this be offset by the fact that I will be reading the
>data and writing it out to /dev/audio in lisp?
>
>Finally if it would be worthwhile to write such a thing, how would one
>write an efficient version in lisp?  I have never done buffered I/O in
>lisp, and the play program written in C uses  buffered reads and
>writes for efficiency.

I wrote the following code for Allegro CL. As you can see by
experimentation with the code and variations on it, playing the sound
files from Lisp is much too slow. Lisp file IO just isn't fast enough.
If you're going to play sound files, you'll have to do much of the
work in C, and then use a foreign function interface to run the code. 

Interestingly enough, using "cat ~a > ~a &" instead of "cat ~a > ~a"
in the run-shell-command causes the sparc to occasionally crash due to
a Mach bug. I don't know whether they've fixed the bug. (The problem does
not occur under SunOS.)


--mark

;;; ****************************************************************
;;; output-sounds.lisp *********************************************
;;; ****************************************************************
;;; Mon Aug 17 21:50:37 1992 by Mark Kantrowitz <mkant@GLINDA.OZ.CS.CMU.EDU>
;;; output-sounds.lisp -- 4574 bytes

;;; Outputs sounds files under Allegro on SPARCs.

;;; ********************************
;;; read-audio-filehdr *************
;;; ********************************

(defun read-ascii-string (file-stream num-bytes)
  (let ((result (make-string num-bytes)))
    (dotimes (i num-bytes)
      (setf (elt result i) (code-char (read-byte file-stream))))
    (string-right-trim (list (code-char 0)) result)))
  
(defun read-32-bit-integer (file-stream)
  (let ((result 0))
    (dotimes (i 4)
      (setf result (ash result 8))
      (incf result (read-byte file-stream)))
    result))

(defstruct (audio-filehdr (:conc-name afhdr-))
  ;; For SPARC ULAW audio files, the magic number should be #x2e736e64.
  magic-number		; magic number, 4 chars (bytes)
  header-size		; offset to the data location (byte size of header)
  data-size		; number of bytes of data
  data-format		; the data format code
  sampling-rate		; the sampling rate
  channel-count		; the number of channels
  info			; optional text information
  )

(defun read-audio-filehdr (file-stream)
  ;; Returns an instance of the audio-filehdr structure.
  (let ((audio-filehdr (make-audio-filehdr)))
    (setf (afhdr-magic-number audio-filehdr)  (read-ascii-string file-stream 4)
	  (afhdr-header-size audio-filehdr)   (read-32-bit-integer file-stream)
	  (afhdr-data-size audio-filehdr)     (read-32-bit-integer file-stream)
	  (afhdr-data-format audio-filehdr)   (read-32-bit-integer file-stream)
	  (afhdr-sampling-rate audio-filehdr) (read-32-bit-integer file-stream)
	  (afhdr-channel-count audio-filehdr) (read-32-bit-integer file-stream)
	  )
    (setf (afhdr-info audio-filehdr) 
	  (read-ascii-string file-stream (- (afhdr-header-size audio-filehdr)
					    24)))
    audio-filehdr))

;;; ********************************
;;; Output-Sounds ******************
;;; ********************************

(defvar *phoneme-directory* "/afs/cs/project/oz/oz2/mark/Speech/phonemes/")
(defvar *temp-sound-file* "/tmp/tmp-sound.raw")

(defun write-sounds (sounds sound-dir out-stream)
  (dolist (file sounds)
    (with-open-file (in (concatenate 'string sound-dir file)
			:direction :input
			:element-type 'unsigned-byte)
      (let ((audio-filehdr (read-audio-filehdr in)))
	;; (print audio-filehdr)
	(do ((byte (read-byte in nil nil)(read-byte in nil nil)))
	    ((null byte))
	  (write-byte byte out-stream))
	#|
	  (dotimes (i (afhdr-data-size audio-filehdr))
	    (setf byte (read-byte in nil nil))
	    (if (null byte)
		(return)
		(write-byte byte out)))
           |#
	))))

(defun play-sounds (&optional (sounds '("AA" "r"))
			      &key (blocked nil)
			      (sound-dir *phoneme-directory*)
			      (audio-dev "/dev/audio"))
  (cond (blocked
	 (with-open-file (out *temp-sound-file*
			      :direction :output
			      :if-exists :supersede
			      :if-does-not-exist :create
			      :element-type 'unsigned-byte)
	   (write-sounds sounds sound-dir out))
	 (excl:run-shell-command (format nil "cat ~a > ~a" 
					 *temp-sound-file* audio-dev)))
	(t
	 (with-open-file (out audio-dev
			      :direction :output
			      :if-exists :overwrite
			      :element-type 'unsigned-byte)
	   (write-sounds sounds sound-dir out)))))

;;; ********************************
;;; Dead Code **********************
;;; ********************************

#|
(defun read-sound-files (&optional (sounds '("AA" "r"))
				   (dir *phoneme-directory*))
  (let ((output nil))
    (dolist (file sounds)
      (with-open-file (in (concatenate 'string dir file) :direction :input
			  :element-type 'unsigned-byte)
	(let ((audio-filehdr (read-audio-filehdr in)))
	  ;; (print audio-filehdr)
	  (do ((byte (read-byte in nil nil)(read-byte in nil nil)))
	      ((null byte))
	    (push byte output)))))
    (nreverse output)))

(defun play-bytes (bytes &optional (audio "/dev/audio"))
  (with-open-file (out audio :direction :output :if-exists :overwrite
		       :element-type 'unsigned-byte)
    (dolist (byte bytes)
      (write-byte byte out))))

(defun write-sound-bytes-to-file (bytes ofile)
  (with-open-file (out ofile :direction :output :if-exists :overwrite
		       :if-does-not-exist :create
		       :element-type 'unsigned-byte)
    (dolist (byte bytes)
      (write-byte byte out))))
|#

;;; *EOF*
Newsgroups: comp.lang.lisp