much work on the player and hunting for a bug, which first seemed to be in ffmpeg-decoder, but eventually was found in a race condition in audio-placed-player.rkt and an allocation problem in libao-async-ffi-racket.rkt

audio-decoder.rkt

@@ -217,6 +217,7 @@
 
   (define/contract (audio-stop handle)
     (-> audio-handle? void?)
+    (dbg-sound "audio-stop called")
     (let ((stopper (audio-reader-stopper (audio-handle-driver handle))))
       (void (stopper (audio-handle-driver-handle handle)))))
       

audio-placed-player.rkt

@@ -13,7 +13,7 @@
 (define (eq-seconds? s1 s2)
   (let ((s1* (inexact->exact (round s1)))
         (s2* (inexact->exact (round s2))))
-    (= s1 s2)))
+    (= s1* s2*)))
 
 (define (placed-player ch-in)
   (let ((ch-evt #f)
@@ -29,7 +29,6 @@
         (current-bits -1)
         (current-rate -1)
         (current-channels -1)
-        (current-duration -1)
         (current-volume 100.0)
         (req-volume 100.0)
         (max-buf-secs 4)
@@ -38,7 +37,6 @@
         (player-state 'stopped)
         (decoder-buf-info #f)
         (decoder-meta #f)
-        (decoder #f)
         (feeding-audio #f)
         (feed-interrupted #f)
         )
@@ -66,12 +64,25 @@
           (place-channel-get ch-in)
           (async-channel-get ch-in)))
           
-    (define (audio-read-worker)
+    (define (audio-read-worker ao-dec file-id)
+      (set! feeding-audio #t)
       (set! play-thread
             (thread (λ ()
-                      (set! feeding-audio #t)
+                      (with-handlers ([exn:fail?
-                      (audio-read ao-dec)
+                                       (λ (e)
+                                         (dbg-sound "Exception in audio-read-worker: ~a" e)
                                          (set! feeding-audio #f)
+                                         (set! feed-interrupted #f)
+                                         (set! player-state 'stopped)
+                                         (evt (list 'exception (exn-message e))))])
+                        (dynamic-wind
+                         void
+                         (λ ()
+                           (dbg-sound "audio-read start")
+                           (audio-read ao-dec)
+                           (dbg-sound "audio-read end")
+                           )
+                         (λ () (set! feeding-audio #f)))
                         (state "audio-read-worker: just after audio-read" evt)
                         (if feed-interrupted
                             (set! feed-interrupted #f)
@@ -82,16 +93,24 @@
                                   (let ((nbfs (with-ao-h 'done
                                                 (ao-bufsize-async ao-h))))
                                     (if (eq? nbfs 'done)
-                                      'done
+                                        (begin
+                                          (set! bufsize 0)
+                                          'done)
                                         (cond
                                           ((eq? bufsize #f) (set! bufsize nbfs) (loop))
                                           ((= nbfs 0) (set! bufsize 0) 'done)
                                           ((> nbfs bufsize) (set! bufsize nbfs) 'done)
-                                        (else (set! bufsize nbfs) (sleep 0.1) (loop)))
+                                          (else
+                                           (check-paused)
+                                           (set! bufsize nbfs)
+                                           (sleep 0.1)
+                                           (loop)))
                                         )
                                     )
                                   )
-                              (when (= bufsize 0)
+                                ;; Alleen de actuele worker mag de globale spelerstatus beëindigen.
+                                ;; Een oude drain-worker mag hoogstens zichzelf opruimen.
+                                (when (and (= bufsize 0) (= file-id current-file-id))
                                   (set! player-state 'stopped)
                                   (state "audio-read-worker: after read with bufsize 0" evt))
                                 )
@@ -101,6 +120,7 @@
                       )
                     )
             )
+      )
 
     (define (check-volume)
       (unless (= req-volume current-volume)
@@ -117,13 +137,15 @@
             (with-ao-h 'no-op (ao-pause ao-h #t))
             (state "check-paused: player-state = paused" evt)
             (let loop ()
-              (sleep 0.3)
+              (sleep 0.1)
               (when (eq? player-state 'paused)
                 (loop)))
-            (when (eq? player-state 'playing)
+            ; If the player is no longer paused, we unpause the ao stream,
+            ; also if the player is no longer playing (i.e. player-state = stopped)
+            ; in which case, we expect ao-clear-async to have been executed, which
+            ; means the playing queue is empty. 
             (with-ao-h 'no-op (ao-pause ao-h #f))
-              (state "check-paused: player-stat = playing" evt)
+            (state (format "check-paused: player-state = ~a" player-state) evt)
-              )
             #t)
           #f))
 
@@ -138,36 +160,55 @@
              (duration (hash-ref buf-info 'duration))
              )
 
-        (set! decoder type)
         (set! decoder-buf-info buf-info)
 
-        (with-ao-h 'no-op
         (when (not (and
                     (= current-bits bits-per-sample)
                     (= current-rate rate)
                     (= current-channels channels)))
-            (ao-close ao-h)
+          ; If we need to reopen the ao device with different bit-rates,
-            (set! ao-h #f)))
+          ; we need to wait until the ao sample queue is empty
+          (let loop ()
+            (let* ((s (with-ao-h -1 (ao-at-second ao-h))))
+              (unless (or (= s -1) (eq-seconds? stored-seconds s))
+                (set! stored-seconds s)
+                (state "audio-play: seconds changes (III)" evt)))
+            (let ((bufsize (with-ao-h 0 (ao-bufsize-async ao-h))))
+              (if (= bufsize 0)
+                  (with-mutex ao-mutex
+                    (when (ao-valid? ao-h)
+                      (ao-close ao-h))
+                    (set! ao-h #f))
+                  (begin (sleep 0.1) (loop)))))
+          )
         
+        (with-mutex ao-mutex
           (when (eq? ao-h #f)
+            (dbg-sound "opening ao-h for ~a ~a" current-file-id files-playing) 
             (set! ao-h (ao-open-live bits-per-sample
                                      rate channels
                                      'native-endian))
+            )
+          (with-ao-h 'no-op
+            (ao-set-volume! ao-h current-volume)
             (set! current-bits bits-per-sample)
             (set! current-rate rate)
             (set! current-channels channels)
             )
+          )
 
         (check-volume)
         (with-ao-h 'no-op
+          (when (not (eq? player-state 'stopped))
             (ao-play ao-h current-file-id second duration buffer buf-len ao-type)
-          )
+            ))
         (check-paused)
 
-        (let* ((s (inexact->exact (round (* (ao-at-second ao-h) 10)))))
+        (let* ((s* (with-ao-h 0 (ao-at-second ao-h)))
+               (s (inexact->exact (round (* s* 10)))))
           (unless (= s current-deci-seconds)
             (set! current-deci-seconds s)
-            (set! current-seconds (ao-at-second ao-h))))
+            (set! current-seconds s*))) 
 
         (unless (eq-seconds? stored-seconds current-seconds)
           (set! stored-seconds current-seconds)
@@ -187,7 +228,7 @@
 
                 (unless (= s current-deci-seconds)
                   (set! current-deci-seconds s)
-                  (set! current-seconds (with-ao-h 0 (ao-at-second ao-h))))
+                  (set! current-seconds s*))
                 
                 (unless (eq-seconds? stored-seconds current-seconds)
                   (set! stored-seconds current-seconds)
@@ -216,31 +257,53 @@
       (set! current-bits -1)
       (set! current-rate -1)
       (set! current-channels -1)
-      (set! current-duration -1)
       (set! decoder-buf-info #f)
       (set! decoder-meta #f)
       )
     
     (define (stop-and-cleanup)
+      (dbg-sound "stop and cleanup called")
+      (set! feed-interrupted #t)
+
+      (with-ao-h 'no-op (ao-clear-async ao-h))
+      (set! player-state 'stopped)
       (unless (eq? ao-dec #f)
         (audio-stop ao-dec))
-      (with-ao-h 'no-op 
-          (ao-clear-async ao-h)
-        (ao-close ao-h))
-      (thread-wait play-thread)
       (set! ao-dec #f)
-      (set! ao-h #f)
+
-      (set! player-state 'stopped)
+      (with-ao-h 'no-op (ao-clear-async ao-h))
+      
+      (when (thread? play-thread) (thread-wait play-thread))
+      (set! play-thread #f)
+
+      (with-mutex ao-mutex
+        (when (ao-valid? ao-h)
+          (ao-close ao-h)
+          )
+        (set! ao-h #f))
+
+      (set! feed-interrupted #f)
+      (set! feeding-audio #f)
+      
       (cleanup)
-      (state "stop-and-cleanup: stopped/cleaned" evt)
+      
+      (state "stop-and-cleanup: stopped/cleaned" evt 'force)
+      
       player-state
       )
 
     (define (start file)
-      
+      (dbg-sound "starting ~a" file)
       (when feeding-audio
+        (dbg-sound "interrupting feed")
         (set! feed-interrupted #t)
-        (audio-stop ao-dec)
+        (with-ao-h 'no-op (ao-clear-async ao-h))
+        (set! player-state 'stopped)
+        (when (audio-handle? ao-dec)
+          (audio-stop ao-dec))
+        (dbg-sound "clearing ao-h queue")
+        (with-ao-h 'no-op (ao-clear-async ao-h))
+        (dbg-sound "waiting for feed to stop")
         (let loop ()
           (if feeding-audio
               (begin
@@ -249,9 +312,11 @@
               (with-ao-h 'no-op (ao-clear-async ao-h))
               )
           )
+        (dbg-sound "waiting for play thread")
+        (when (thread? play-thread) (thread-wait play-thread))
+        (dbg-sound "oke done")
         )
       
-      (set! ao-dec (audio-open file audio-meta audio-play))
       (set! current-file-id (+ current-file-id 1))
       (let ((f (build-path file)))
         (set! files-playing (cons
@@ -259,13 +324,16 @@
                              (filter (λ (e)
                                     (= (car e) (- current-file-id 1)))
                                   files-playing))))
+      (set! ao-dec (audio-open file audio-meta audio-play))
+      
       (when (eq? player-state 'stopped)
         (set! player-state 'playing))
-      (audio-read-worker))
+      (audio-read-worker ao-dec current-file-id))
 
     (define (pause paused)
-      (set! player-state (if paused 'paused 'playing)))
+      (when (or (eq? player-state 'paused)
-
+                (eq? player-state 'playing))
+        (set! player-state (if paused 'paused 'playing))))
       
     (define (seek percentage)
       (with-ao-h 'no-op
@@ -283,7 +351,7 @@
             (hash-set! h 'decoder (if (audio-handle? ao-dec) (audio-kind ao-dec) #f))
             (hash-set! h 'msg msg)
             (hash-set! h 'file (let ((r (filter (λ (e)
-                                                  (eq? (car e) m-id))
+                                                  (and (not (eq? m-id #f)) (= (car e) m-id)))
                                                 files-playing)))
                                  (if (null? r) #f (cdar r))))
             (hash-set! h 'state player-state)
@@ -308,72 +376,107 @@
           )
 
         (let ((m-id (hash-ref h 'at-music-id)))
-          (unless (or (eq? m-id #f) (= m-id 0) )
+          (unless (and (null? force) (or (eq? m-id #f) (= m-id 0)))
             (cb (list 'state h))))
         )
       )
 
     (let loop ()
       (let* ((data (get))
-             (cmd (car data)))
+             (cmd (car data))
+             (in-rpc #f))
 
-        (early-return
+        (define-syntax do-rpc
-         ((? (eq? cmd 'quit) => (stop-and-cleanup)
+          (syntax-rules (in-rpc)
-             ~ (begin
+            ((_ b1 ...)
-                 (state "quit" evt 'force)
+             (begin
-                 (put '(quit)))))
+               (set! in-rpc #t)
+               (let ((r (begin b1 ...)))
+                 (set! in-rpc #f)
+                 (put r))))))
         
         (with-handlers ([exn:fail? (λ (e)
                                      (if (eq? ch-evt #f)
                                          (raise e)
-                                          (evt (list 'exception e))))])
-           (if (eq? cmd 'init)
                                          (begin
+                                           (evt (list 'exception
+                                                      (exn-message e)))
+                                           (when in-rpc
+                                             (put (list 'error
+                                                        (exn-message e)))
+                                             (set! in-rpc #f))
+                                           (loop))
+                                         ))])
+
+           (cond
+             ((eq? cmd 'quit) (do-rpc
+                               (stop-and-cleanup)
+                               (state "quit" evt 'force)
+                               '(quit)))
+             ((eq?  cmd 'init) (do-rpc
                                 (set! ch-out (cadr data))
                                 (set! ch-evt (caddr data))
-                (put '(initialized)))
+                                '(initialized))
-               (begin
+                               (loop))
+             (else 
               (when (or (eq? ch-out #f) (eq? ch-evt #f))
                 (error "placed player not initialized"))
+          
+              (unless (eq? cmd 'quit)
                 (cond
                   ((eq? cmd 'buf-seconds)
-                    (set! min-buf-secs (if (< (cadr data) 2) 2 (cadr data)))
+                   (do-rpc
-                    (set! max-buf-secs (if (> (caddr data) 30) 30 (caddr data)))
+                    (let* ((clamp (λ (x) (min 30 (max 2 x))))
-                    (put '(ok))
+                           (a (clamp (cadr data)))
-                    )
+                           (b (clamp (caddr data))))
+                      (set! min-buf-secs (min a b))
+                      (set! max-buf-secs (max a b))
+                      '(ok))))
                   ((eq? cmd 'open)
+                   (do-rpc 
                     (let ((file (cadr data)))
                       (start file)
-                      (put '(ok))
+                      '(ok))))
-                      ))
                   ((eq? cmd 'seek)
+                   (do-rpc 
                     (let ((percentage (cadr data)))
                       (seek percentage)
-                      (put '(ok))))
+                      '(ok))))
                   ((eq? cmd 'pause)
+                   (do-rpc
                     (let ((paused (cadr data)))
                       (pause paused)
-                      (put '(ok))))
+                      '(ok))))
                   ((eq? cmd 'paused)
-                    (put (list (eq? player-state 'paused))))
+                   (do-rpc
+                    (list (eq? player-state 'paused))))
                   ((eq? cmd 'volume)
+                   (do-rpc
                     (let ((percentage (cadr data)))
-                      (volume percentage)
+                      (volume (exact->inexact percentage))
-                      (put '(ok))))
+                      '(ok))))
                   ((eq? cmd 'get-volume)
-                    (put (list current-volume)))
+                   (do-rpc
+                    (list current-volume)))
                   ((eq? cmd 'stop)
+                   (do-rpc
                     (stop-and-cleanup)
-                    (put '(ok)))
+                    '(ok)))
                   ((eq? cmd 'state)
-                    (state "'state command" put))
+                   (do-rpc
+                    (let ((st #f))
+                      (state "'state command" (λ (s) (set! st s)) 'force)
+                      st)))
                   (else
-                    (error (format "Unknown command ~a" cmd)))
+                   (do-rpc
+                    (list 'error (format "Unknown command ~a" cmd))))
+                  )
+                (loop)
+                )
               )
              )
           )
         )
-         (loop)))
       )
     )
   )

ffmpeg-decoder.rkt

@@ -128,7 +128,9 @@
               (ffi-handler 'read
                            (lambda (info pos buffer size)
                              (if (eq? info 'done)
-                                 (set-ffmpeg-handle-stop! handle #t)
+                                 (begin
+                                   (dbg-sound "ffmpeg read: ~a ~a ~a" info pos size)
+                                   (set-ffmpeg-handle-stop! handle #t))
                                  (give-audio handle info pos buffer size)))
                            (lambda (pcm-pos rate channels sample-bits sample-bytes pcm-length)
                              (handle-format handle pcm-pos rate channels sample-bits sample-bytes pcm-length)))
@@ -138,6 +140,7 @@
       (ffi-handler 'delete)))
 
   (define (ffmpeg-seek handle percentage)
+    (dbg-sound "ffmpeg-seek ~a" percentage)
     (let ((fmt (ffmpeg-handle-format handle)))
       (let ((total-samples (hash-ref fmt 'total-samples 0)))
         (unless (or
@@ -149,6 +152,7 @@
             (set-ffmpeg-handle-seek! handle sample))))))
 
   (define (ffmpeg-stop handle)
+    (dbg-sound "ffmpeg-stop called")
     (set-ffmpeg-handle-stop! handle #t)
     (while (ffmpeg-handle-reading handle)
            (sleep 0.01)))

ffmpeg-definitions.rkt

@@ -898,41 +898,8 @@
     )
   )
 
-#|
-(define (fill-audio-info! self)
-  (let* ((ctx  (fmpg-instance-format-ctx self))
-         (info (fmpg-instance-audio-info self)))
-
-    (ais-clear! info)
-    (ais-stream-count! info (count-audio-streams ctx))
-
-    (let/assert
-     ((best            (av_find_best_stream ctx AVMEDIA_TYPE_AUDIO -1 -1 #f 0) (a->=? 0) #f)
-      (stream          (avformat_stream ctx best) a-!nullptr? #f)
-      (par             (avstream-codec stream) a-!nullptr? #f)
-      (codec-type      (avcodec-pars-codec_type par) (a-=? AVMEDIA_TYPE_AUDIO) #f)
-      (sample-rate     (avcodec-pars-sample_rate par) (a->? 0) #f)
-      (channels        (avcodec-pars-channels par) (a->? 0) #f)
-      (stream-seconds  (stream_duration_seconds stream))
-      (seconds         (if (< stream-seconds 0.0)
-                           (format_duration_seconds ctx)
-                           stream-seconds))
-      )
-      (begin
-        (ais-stream-index! info best)
-        (ais-rate! info sample-rate)
-        (ais-channels! info channels)
-        (ais-duration-ms! info (milliseconds_from_seconds seconds))
-        (ais-duration-samples! info (samples_from_seconds seconds sample-rate))
-        #t
-        )
-      )
-    )
-  )
-|#
-
 (define (instance-ready? instance)
-  (and instance
+  (let ((ready (and instance
                     (fmpg-instance-opened instance)
                     (fmpg-instance-format-ctx instance)
                     (let ((info (fmpg-instance-audio-info instance)))
@@ -942,7 +909,10 @@
                       (and dec
                            (ds-codec-ctx dec)
                            (ds-swr-ctx dec)))
-       #t))
+                    #t)))
+    (unless ready
+      (err-sound "instance not ready!"))
+    ready))
 
 
 
@@ -973,31 +943,6 @@
    #t)
   )
 
-#|
-(define (init-codec-context! self)
-  (let/assert
-   ((dec          (fmpg-instance-decoder self))
-    (info         (fmpg-instance-audio-info self))
-    (ctx          (fmpg-instance-format-ctx self))
-    (stream-index (ais-stream-index info))
-    (stream       (avformat_stream ctx stream-index) a-!nullptr? #f)
-    (par          (avstream-codec stream) a-!nullptr? #f)
-    (codec        (let ((c (avcodec_find_decoder (avcodec-pars-codec_id par))))
-                    (ds-codec! dec c)
-                    c)
-                  a-!nullptr? #f)
-    (codec-ctx    (let ((c (avcodec_alloc_context3 codec)))
-                    (ds-codec-ctx! dec c)
-                    c)
-                  a-!nullptr? #f)
-    (ret-par      (avcodec_parameters_to_context codec-ctx par) (a->=? 0) #f)
-    (ret-open     (avcodec_open2 codec-ctx codec #f) (a->=? 0) #f)
-    (frame        (let ((f (av_frame_alloc)))
-                    (ds-frame! dec f)
-                    f)
-                  a-!nullptr? #f))
-   #t))
-|#
 
 (define (init-resampler! self)
   (early-return
@@ -1031,32 +976,6 @@
    )
   )
 
-#|
-(define (init-resampler! self)
-  (let/assert
-   ((dec       (fmpg-instance-decoder self))
-    (codec-ctx (ds-codec-ctx dec) a-!nullptr? #f)
-    (par       (avcodec_parameters_alloc) a-!nullptr? #f))
-   (let ((result
-          (let/assert
-           ((ret-par  (avcodec_parameters_from_context par codec-ctx) (a->=? 0) #f)
-            (layout   (AVCodecParameters-ch_layout par))
-            (channels (AVChannelLayout-nb_channels layout) (a->? 0) #f)
-            (rate     (avcodec-pars-sample_rate par) (a->? 0) #f)
-            (fmt      (avcodec-pars-format par))
-            (ret-swr  (let-values (((ret swr-ctx)
-                                    (swr_alloc_set_opts2 (ds-swr-ctx dec)
-                                                         layout FMPG_OUTPUT_FMT rate
-                                                         layout fmt rate
-                                                         0 #f)))
-                        (ds-swr-ctx! dec swr-ctx)
-                        ret)
-                      (a->=? 0) #f)
-            (ret-init (swr_init (ds-swr-ctx dec)) (a->=? 0) #f))
-           #t)))
-     (avcodec_parameters_free par)
-     result)))
-|#
 
 (define (init-decoder! self)
   (let ((dec (fmpg-instance-decoder self)))
@@ -1243,13 +1162,16 @@
 
 
 (define (receive-available-frames! self)
-  (let ((dec (fmpg-instance-decoder self)) (produced 0))
+  (let ((dec (fmpg-instance-decoder self))
+        (produced 0))
     (let loop ()
       (let ((ret (avcodec_receive_frame (ds-codec-ctx dec) (ds-frame dec))))
         (cond
           [(= ret AVERROR_EAGAIN) produced]
           [(= ret AVERROR_EOF) (ds-drained! dec #t) produced]
-          [(< ret 0) -1]
+          [(< ret 0)
+           (err-sound "Got retvalue ~a from avcodec_receive_frame" ret)
+           -1]
           [else
            (let ((ok? (append-converted-frame! self (ds-frame dec))))
              (av_frame_unref (ds-frame dec))
@@ -1260,17 +1182,27 @@
                  -1))])))))
 
 
+
 (define (read-selected-audio-packet! self pkt)
   (let ((wanted-stream (ais-stream-index (fmpg-instance-audio-info self))))
     (let loop ()
       (let ((ret (av_read_frame (fmpg-instance-format-ctx self) pkt)))
         (cond
-          [(< ret 0) #f]
+          [(= ret AVERROR_EOF)
-          [(= (avpacket-stream-index pkt) wanted-stream) #t]
+           'eof]
+
+          [(< ret 0)
+           (err-sound "av_read_frame failed: ~a" ret)
+           'error]
+
+          [(= (avpacket-stream-index pkt) wanted-stream)
+           'packet]
+
           [else
            (av_packet_unref pkt)
            (loop)])))))
 
+
 (define (drain-resampler! self)
   (let* ((dec (fmpg-instance-decoder self))
          (info (fmpg-instance-audio-info self))
@@ -1330,123 +1262,109 @@
     )
   )
 
-
 (define (fmpg-decode-next! instance)
 
-  ;; #f = continue, 0/1 = return value.
+  (define (r m r . e)
+    (when (or (eq? r #f) (< r 0))
+      (err-sound "fmpg-decode-next! : ~a - ~a - ~a" m r e))
+    r)
+
+  ;; #f = continue, 1 = pcm available, negative = error.
   (define (receive-result! self dec)
     (let ((produced (receive-available-frames! self)))
       (cond
-        [(< produced 0) 0]
+        [(< produced 0) -1]
         [(produced-pcm? produced dec) 1]
         [else #f])))
 
+  (define (send-packet-result! dec pkt)
+    (let ((ret (avcodec_send_packet (ds-codec-ctx dec) pkt)))
+      (av_packet_unref pkt)
+      ret))
+
   (early-return
-   ((? (not (instance-ready? instance)) => 0)
+   ((? (not (instance-ready? instance)) => (r "instance-ready" -1))
 
     (dec (fmpg-instance-decoder instance))
 
     (do (ds-clear-output! dec))
 
-    (received (receive-result! instance dec) ? received => received)
+    (received (receive-result! instance dec)
-    (pkt (av_packet_alloc) ? (eq? pkt #f) => 0)
+              ? received => (r "receive-result!" received))
+
+    (pkt (av_packet_alloc)
+         ? (eq? pkt #f) => (r "av_packet_alloc" -1))
 
     (packet-result
      (let loop ()
        (cond
          [(ds-eof-seen dec) #f]
 
-         [(not (read-selected-audio-packet! instance pkt))
+         [else
+          (let ((packet-status (read-selected-audio-packet! instance pkt)))
+            (cond
+              [(eq? packet-status 'eof)
                (ds-eof-seen! dec #t)
                (av_packet_unref pkt)
                #f]
 
-         [else
+              [(eq? packet-status 'error)
-          (let ((ret (avcodec_send_packet (ds-codec-ctx dec) pkt)))
                (av_packet_unref pkt)
+               -1]
+
+              [(eq? packet-status 'packet)
+               (let ((ret (send-packet-result! dec pkt)))
                  (cond
                    [(= ret AVERROR_EAGAIN)
                     (let ((received (receive-result! instance dec)))
                       (if received received (loop)))]
-              [(< ret 0) 0]
+
+                   [(< ret 0)
+                    ret]
+
                    [else
                     (let ((received (receive-result! instance dec)))
-                 (if received received (loop)))]))]))
+                      (if received received (loop)))]))]
-     ? packet-result => packet-result
-     ~ (av_packet_free pkt))
 
-    (do
-     (av_packet_free pkt))
-
-    (drain-result
-     (and (not (ds-drained dec))
-          (let ((ret (avcodec_send_packet (ds-codec-ctx dec) #f)))
-            (cond
-              [(and (< ret 0) (not (= ret AVERROR_EOF))) 0]
-              [else (receive-result! instance dec)])))
-     ? drain-result => drain-result)
-
-    (produced (drain-resampler! instance)))
-
-   (if (produced-pcm? produced dec) 1 0)
-   )
-  )
-
-#|
-(define (fmpg-decode-next! instance)
-
-  ;; #f = continue, 0/1 = return value.
-  (define (receive-result! self dec)
-    (let ((produced (receive-available-frames! self)))
-      (cond
-        [(< produced 0) 0]
-        [(produced-pcm? produced dec) 1]
-        [else #f])))
-
-  (early-return
-   ((? (not (instance-ready? instance)) => 0)
-    (dec (fmpg-instance-decoder instance))
-    (do (ds-clear-output! dec))
-    (received (receive-result! instance dec) ? received => received)
-    (pkt (av_packet_alloc) ? (eq? pkt #f) => 0)
-
-    (packet-result
-     (let loop ()
-         (unless (ds-eof-seen dec)
-           (cond
-             [(not (read-selected-audio-packet! instance pkt))
-              (ds-eof-seen! dec #t)
-              (av_packet_unref pkt)
-              #f]
               [else
-              (let ((ret (avcodec_send_packet (ds-codec-ctx dec) pkt)))
+               (err-sound "read-selected-audio-packet!: unexpected result ~a"
-                (av_packet_unref pkt)
+                          packet-status)
-                (cond
+               -1]))]))
-                  [(= ret AVERROR_EAGAIN)
+     ? packet-result => (r "packet-result" packet-result)
-                   (let ((r (receive-result! instance dec))) (if r r (loop)))]
-                  [(< ret 0) 0]
-                  [else
-                   (let ((r (receive-result! instance dec)))
-                     (if r r (loop)))]))])))
-     ? packet-result => packet-result
      ~ (av_packet_free pkt))
 
     (do (av_packet_free pkt))
 
+    ;; If all packets have been read, flush the decoder.
     (drain-result
      (and (not (ds-drained dec))
           (let ((ret (avcodec_send_packet (ds-codec-ctx dec) #f)))
             (cond
-              [(and (< ret 0) (not (= ret AVERROR_EOF))) 0]
+              [(= ret AVERROR_EOF)
-              [else (receive-result! instance dec)])))
+               (ds-drained! dec #t)
-     ? drain-result => drain-result)
+               #f]
+
+              [(= ret AVERROR_EAGAIN)
+               (receive-result! instance dec)]
+
+              [(< ret 0)
+               ret]
+
+              [else
+               (receive-result! instance dec)])))
+     ? drain-result => (r "drain-result" drain-result))
+
+    ;; After decoder drain, flush any delayed samples from swresample.
+    (produced (drain-resampler! instance)
+              ? (< produced 0) => (r "drain-resampler!" produced)))
+
+   (cond
+     [(produced-pcm? produced dec) 1]
+     [else
+      (dbg-sound "fmpg-decode-next!: eof/no more pcm")
+      0])))
 
-    (produced (drain-resampler! instance)))
 
-   (if (produced-pcm? produced dec) 1 0)
-   )
-  )
-|#
 
 (define (fmpg-seek-ms! instance target-pos-ms)
   (early-return

ffmpeg-ffi.rkt

@@ -16,7 +16,16 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
   (define (ok? r)
-    (not (= r 0)))
+    (> r 0))
+  
+  (define (decode-ok? r)
+    (= r 1))
+
+  (define (decode-eof? r)
+    (= r 0))
+
+  (define (decode-error? r)
+    (< r 0))
   
   (define (filename->string filename)
     (cond
@@ -149,10 +158,14 @@
         (reset!)
         #t))
 
+    #|
     (define (read cb format-cb)
       (when (= current-pcm-pos 0)
         (ffmpeg-format format-cb))
-      (if (ok? (fmpg-decode-next! fh))
+      (let ((dec-val (fmpg-decode-next! fh)))
+        (unless (ok? dec-val)
+          (err-sound "return value of fmpg-decode-next = ~a" dec-val))
+        (if (ok? dec-val)
             (let-values ([(buffer size) (copy-current-buffer fh)])
               (cond
                 [(or (eq? buffer #f) (<= size 0)) (read cb format-cb)]
@@ -161,6 +174,29 @@
                    (set! current-pcm-pos (fmpg-buffer-end-sample fh))
                    (cb 'data pcm-pos buffer size))]))
             (cb 'done -1 #f 0))
+        #t))
+    |#
+    (define (read cb format-cb)
+      (when (= current-pcm-pos 0)
+        (ffmpeg-format format-cb))
+      (let ((dec-val (fmpg-decode-next! fh)))
+        (cond
+          [(decode-ok? dec-val)
+           (let-values ([(buffer size) (copy-current-buffer fh)])
+             (cond
+               [(or (eq? buffer #f) (<= size 0))
+                (read cb format-cb)]
+               [else
+                (let ((pcm-pos (fmpg-buffer-start-sample fh)))
+                  (set! current-pcm-pos (fmpg-buffer-end-sample fh))
+                  (cb 'data pcm-pos buffer size))]))]
+
+          [(decode-eof? dec-val)
+           (cb 'done -1 #f 0)]
+
+          [else
+           (err-sound "fmpg-decode-next failed: ~a" dec-val)
+           (cb 'done -1 #f 0)]))
       #t)
 
     (define (seek pcm-pos)

libao-async-ffi-racket.rkt

@@ -225,12 +225,13 @@
   )
 
 
-(define (needed-bytes h)
+(define (needed-bytes h elem-buflen)
   (let ((req-bytes (/ (ao-handle-dev-bits-per-sample h) 8))
         (rate-s (ao-handle-dev-rate h))
         (channels (ao-handle-dev-channels h))
         )
-    (/ (* req-bytes rate-s channels ao-buf-ms) 1000)
+    (let ((needed-for-ao (/ (* req-bytes rate-s channels ao-buf-ms) 1000)))
+      (max needed-for-ao elem-buflen))
     )
   )
 
@@ -256,7 +257,7 @@
             (begin
               (set-ao-handle-current-elem! h elem)
               (set! cb elem)
-              (let* ((ns (needed-bytes h))
+              (let* ((ns (needed-bytes h (queue-elem-buflen elem)))
                      (new-buf (alloc-buf h ns)))
                 (m-memcpy new-buf (queue-elem-buf cb) (queue-elem-buflen cb))
                 (reuse-buf h (queue-elem-buf cb))

libao-async-ffi.rkt

@@ -22,8 +22,23 @@
          ao_volume_async
          make-BufferInfo_t
          ao_version
+         ao-playback-buf-ms
+         ao-set-playback-buf-ms!
+         ao_sample_queue_len
          )
 
+
+(define pb 250)
+
+(define (ao-playback-buf-ms)
+  pb)
+
+(define (ao-set-playback-buf-ms! ms)
+  (set! pb ms))
+
+(define (ao_sample_queue_len h)
+  0)
+
 (define _BufferType_t
   (_enum '(ao = 1
            flac = 2

libmpg123-ffi.rkt

@@ -405,7 +405,7 @@ int main(int argc, char *argv[])
       )
 
     (define (init file)
-      (let ((r (mpg123_open mh file)))
+      (let ((r (mpg123_open mh (format "~a" file))))
         (unless (eq? r 'MPG123_OK)
           (error (format "mpg123_open: ~a" (mpg123_plain_strerror r))))
         )

play-test.rkt

@@ -6,15 +6,17 @@
          racket/runtime-path
          racket/path
          early-return
+         "tests.rkt"
          )
 
-(define place-mode #t)
+(define place-mode #f)
+
+(define run-queue #f)
+(define (set-test a)
+  (set! run-queue a))
 
-(define-runtime-path tests "../racket-audio-test")
-(define test-file2 (build-path tests "idyll.flac"))
-(define test-file3 (build-path tests "mahler-1.mp3"))
-(define test-file4 (build-path tests "mahler-2.mp3"))
 (define play-queue (list test-file2 test-file3 test-file4))
+
 (define current-sec -1)
 
 (define (to-time-str s*)
@@ -53,19 +55,26 @@
   )
 
 (define (audio-player-eof h)
+  (dbg-sound "audio-player-eof called")
+  (when (eq? run-queue 'queue)
     (if (null? play-queue)
         (audio-quit! h)
         (begin
           (audio-play! h (car play-queue))
           (set! play-queue (cdr play-queue))
           )
-      )
+        ))
+  (when (eq? run-queue 'once)
+    (set! run-queue #f)
+    (audio-play! h test-file3))
   )
 
 (define h (make-audio-player audio-player-state
                              audio-player-eof
                              #:use-place place-mode))
 
+(sl-log-to-display)
 (audio-player-eof h)
 
 
+

private/utils.rkt

@@ -38,23 +38,51 @@
   ;; Mutex definitions
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-  (define (make-mutex)
+  (define-struct mutex
-  (make-semaphore 1))
+    (thread count mut own) #:mutable)
+
+  (define make-mutex-struct make-mutex)
+  
+  (set! make-mutex (λ ()
+                     (make-mutex-struct #f 0 (make-semaphore 1) (make-semaphore 1))))
 
   (define (mutex-lock m)
-    (semaphore-wait m))
+    (semaphore-wait (mutex-own m))
+    (if (eq? (mutex-thread m) (current-thread))
+        (begin
+          (set-mutex-count! m (+ (mutex-count m) 1))
+          (semaphore-post (mutex-own m))
+          )
+        (begin
+          (semaphore-post (mutex-own m))
+          (semaphore-wait (mutex-mut m))
+          (set-mutex-count! m 1)
+          (set-mutex-thread! m (current-thread)))
+        )
+    )
 
   (define (mutex-unlock m)
-    (semaphore-post m))
+    (semaphore-wait (mutex-own m))
+    (let ((count (mutex-count m)))
+      (set! count (- count 1))
+      (set-mutex-count! m count)
+      (if (= count 0)
+          (begin
+            (set-mutex-thread! m #f)
+            (semaphore-post (mutex-own m))
+            (semaphore-post (mutex-mut m)))
+          (semaphore-post (mutex-own m)))
+      )
+    )
 
   (define-syntax with-mutex
     (syntax-rules ()
       ((_ m b1 ...)
        (begin
-         (semaphore-wait m)
+         (dynamic-wind
-         (let ((r (begin b1 ...)))
+          (λ () (mutex-lock m))
-           (semaphore-post m)
+          (λ () b1 ...)
-           r)))))
+          (λ () (mutex-unlock m)))))))
 
 
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

tests.rkt

@@ -0,0 +1,79 @@
+#lang racket/base
+
+(require racket/runtime-path
+         "private/utils.rkt"
+         "libmpg123-ffi.rkt"
+         "audio-decoder.rkt"
+         )
+
+(provide mp3-ffi-read-test
+         decoder-read-test
+         test-file1
+         test-file2
+         test-file3
+         test-file4
+         test-file5)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; test audio
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-runtime-path tests "../racket-audio-test")
+
+(define test-file1 (build-path tests "idyll.mp3"))
+(define test-file2 (build-path tests "idyll.flac"))
+(define test-file3 (build-path tests "mahler-1.mp3"))
+(define test-file4 (build-path tests "mahler-2.mp3"))
+(define test-file5 (build-path tests "mahler-1.opus"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; test functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; mp3 read test ffi
+
+(define (mp3-ffi-read-test)
+  (let* ((file test-file1)
+         (state #f)
+         (audio '())
+         (formats '())
+         (h (mpg123-ffi-decoder-handler))
+         )
+    (h 'new)
+    (h 'init file)
+    (let loop ()
+      (h 'read
+         (λ (kind pos buf done)
+           (set! state kind)
+           (set! audio (cons (list kind pos done) audio)))
+         (λ (pos rate channels sample-bits sample-bytes length)
+           (set! formats (cons (list rate channels sample-bits sample-bytes length) formats))))
+      (unless (eq? state 'done)
+        (loop)))
+    (h 'close)
+    (h 'delete)
+
+    (displayln (format "got ~a audio samples (~a)" (length audio) (car audio)))
+    (displayln (format "got ~a formats (~a)" (length formats) (car formats)))
+    ))
+
+;;; decoder read test
+      
+(define (decoder-read-test file)
+  (let* ((state #f)
+         (audio '())
+         (formats '())
+         (h (audio-open file
+                        (λ (reader-type ao-type handle meta)
+                          (set! formats (cons (list reader-type ao-type meta) formats)))
+                        (λ (reader-type ao-type handle buf-info audio-buffer buf-len)
+                          (set! audio
+                                (cons (list reader-type ao-type buf-info buf-len) audio)))
+                        )))
+    (audio-read h)
+
+    (displayln (format "got ~a audio samples (~a)" (length audio) (car audio)))
+    (displayln (format "got ~a formats (~a)" (length formats) (car formats)))
+    )
+  )
+