Initial plain dispatcher

diff --git a/alsa-dispatcher.lsp b/alsa-dispatcher.lsp
new file mode 100644 (file)
index 0000000..8468a12
--- /dev/null
+++ b/alsa-dispatcher.lsp
@@ -0,0 +1,185 @@
+;; This is the main script for the pcm-dispatch tool
+;; last main-arg nominates the configuration file
+
+; ############################################################
+; misc API
+(signal 1 (fn (x) (exit 0)))
+(signal 2 (fn (x) (exit 0)))
+(signal 15 (fn (x) (exit 0)))
+
+(define (die N)
+  (when (args) (write-line 2 (join (map string (args)) " ")))
+  (when (number? N) (exit N)))
+
+(define (enlist X) (if (list? X) X (list X)))
+
+(define (comment? LINE) (and (regex "^\\s*(#|$)" LINE 0) true))
+
+(define (first-word LINE) (and (regex "^\\s*(\\S+)" LINE 0) $1))
+
+(define (prog1 X) X)
+
+(define (read-config-line LINE)
+  (map (fn (x) (if (regex "^([^=]+)=(.*)" x) (list $1 $2) x))
+       (map trim (find-all "([^, ]+)" LINE $1 0))))
+
+;; ############################################################
+;; Load Configuration (~/.alsa-dispatcher)
+; Format: one-liners for each option, ignoring comment lines starting
+; with # and blank lines.
+(constant
+ 'HOME (env "HOME")
+ 'CONFIG (format "%s/.alsa-dispatcher" HOME)
+ 'CFGLINES (if (read-file CONFIG) (clean comment? (parse $it "\n" ))
+             '("bt,latency=1000" "plughw"))
+ 'CFGMAP (map read-config-line CFGLINES)
+ 'PCM-LIST (map first-word CFGLINES)
+ )
+
+(define (cfg-lookup PCM KEY DEFAULT)
+  (if (if (assoc PCM CFGMAP) (lookup KEY $it)) (read-expr $it) DEFAULT))
+
+; ############################################################
+; libc API
+(constant 'libc.so.6 "/lib/x86_64-linux-gnu/libc.so.6")
+; https://www.gnu.org/software/libc/manual/html_mono/libc.html
+
+;; (dup2 OLDFD NEWFD) - Duplicate file descriptor OLDFD onto NEWFD,
+;; closing the latter first if open.
+(import libc.so.6 "dup2" "int"
+        "int" ; int oldfd
+        "int" ; int newfd
+        )
+
+; ############################################################
+; libasound API
+(constant 'libasound.so "/usr/lib/x86_64-linux-gnu/libasound.so")
+; https://www.alsa-project.org/alsa-doc/alsa-lib/
+; /usr/include/asm-generic/errno-base.h
+
+;; Used constants
+(constant
+ 'SND_PCM_STREAM_PLAYBACK 0
+ 'SND_PCM_MODE_BLOCK 0 ; this mode label is invented here
+ 'SND_PCM_FORMAT_S16_LE 2
+ 'SND_PCM_ACCESS_RW_INTERLEAVED 3
+ )
+
+;; (snd_pcm_close PCM) - Close PCM handle. Closes the given PCM handle
+;; and frees all associated resources. (The PCM reference is probably
+;; "invalid" after closing)
+(import libasound.so "snd_pcm_close" "int"
+        "void*" ; snd_pcm_t *pcm
+        )
+
+;; (snd_pcm_drain PCM) - Stop PCM whilst preserving pending frames.
+;; For playback wait for all pending frames to be played and then stop
+;; the PCM. For capture stop PCM permitting to retrieve residual
+;; frames.
+(import libasound.so "snd_pcm_drain" "int"
+        "void*" ; snd_pcm_t *pcm
+        )
+
+;; (snd_pcm_open NAME STREAM MODE) - Opens a PCM and returns its
+;; handle or nil. Actual error code is discarded.
+(letex ((IMP (import libasound.so "snd_pcm_open" "int"
+                     "void*" ; snd_pcm_t **pcmp [output]
+                     "char*" ; const char *name
+                     "int"   ; snd_pcm_stream_t stream
+                     "int"   ; int mode
+                     )))
+  (constant 'snd_pcm_open ; redefine the symbol to wrap the import
+   (fn (NAME STREAM MODE)
+     (let ((PCM (pack "Lu" 0)))
+       (when (= (IMP PCM NAME STREAM MODE)) ((unpack "Lu" PCM) 0))))))
+
+;; (snd_pcm_set_params PCM FMT ACCESS CH RATE RESAMPLE LATENCY) - Set
+;; the hardware and software parameters in a simple way.
+(import libasound.so "snd_pcm_set_params" "int"
+        "void*" ; snd_pcm_t *pcm
+        "int"   ; snd_pcm_format_t format
+        "int"   ; snd_pcm_access_t access
+        "unsigned int" ; unsigned int channels
+        "unsigned int" ; unsigned int rate
+        "int"   ;int soft_resample
+        "unsigned int" ; unsigned int latency
+        )
+
+;; (snd_pcm_wait PCM TIMEOUT) - Wait for a PCM to become ready.
+;; Returns a positive value on success otherwise a negative error code
+;; (-EPIPE [-32] for the xrun and -ESTRPIPE [-86] for the suspended
+;; status, others for general errors)
+(import libasound.so "snd_pcm_wait" "int"
+       "void*" ; snd_pcm_t *pcm
+        "int"   ; int timeout 
+        )
+
+;; (snd_pcm_writei PCM BUFFER FRAMES) - Write interleaved frames to a
+;; PCM. If the blocking behaviour is selected and the PCM is running,
+;; then routine waits until all requested frames are played or put to
+;; the playback ring buffer. The returned number of frames can be less
+;; only if a signal or underrun occurred.
+(import libasound.so "snd_pcm_writei" "long" ; snd_pcm_uframes_t 
+       "void*" ; snd_pcm_t *pcm
+        "void*" ; const void *buffer
+        "long"   ; snd_pcm_uframes_t size
+        )
+
+;; Open a PCM by name
+(define (open-pcm NAME)
+  (snd_pcm_open NAME SND_PCM_STREAM_PLAYBACK SND_PCM_MODE_BLOCK))
+
+;; Setup PCM 
+(define (setup-pcm PCM)
+  (snd_pcm_set_params PCM
+                      (cfg-lookup PCM "format" SND_PCM_FORMAT_S16_LE)
+                      SND_PCM_ACCESS_RW_INTERLEAVED
+                      (cfg-lookup PCM "channels" 2)
+                      (cfg-lookup PCM "rate" 48000)
+                      1 ; soft resample (0/1)
+                      (cfg-lookup PCM "latency" 100000) ; (microseconds)
+                      ))
+
+;; ############################################################
+; The main program
+
+;; redirect stdout/err to /dev/null
+(when nil
+  (let ((REDIR (open "/dev/null" "append")))
+    (when (< REDIR) (exit 1))
+    (when (< (libc:dup2 REDIR 2)) (exit 1))
+    (when (< (libc:dup2 REDIR 1)) (exit 1))
+    (close REDIR)
+  ))
+
+; find the first usable PCM
+(setf PCM (unless (dolist (NAME PCM-LIST (open-pcm NAME)))
+            (die 1 "No PCM available")))
+
+; configure the PCM
+(when (!= (setf E (setup-pcm PCM)))
+  (snd_pcm_close PCM)
+  (die 1 "set params" E))
+
+(setf N 0 x 0 E 0 i 0)
+
+(setf CACHE nil)
+(while (> (or (setf N (read 0 BUFFER 20000000)) 0))
+  ;(println "reading " N)
+  (setf CACHE BUFFER)
+  (while (> N) 
+    ;;(ready PCM)
+    (when (< (setf E (snd_pcm_writei PCM CACHE (/ N 4))))
+      (snd_pcm_close PCM)
+      (die 1 "writing" E N))
+    (setf E (* E 4))
+    (setf CACHE (E CACHE))
+    ;(println "wrote " E)
+    (dec N E)
+    )
+  )
+
+(snd_pcm_wait PCM -1)
+(snd_pcm_drain PCM)
+(snd_pcm_close PCM)
+(exit 0)