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
This commit is contained in:
+224
-121
@@ -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,37 +64,59 @@
|
||||
(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)
|
||||
(audio-read ao-dec)
|
||||
(set! feeding-audio #f)
|
||||
(state "audio-read-worker: just after audio-read" evt)
|
||||
(if feed-interrupted
|
||||
(set! feed-interrupted #f)
|
||||
(begin
|
||||
(evt '(audio-done))
|
||||
(let ((bufsize #f))
|
||||
(let loop ()
|
||||
(let ((nbfs (with-ao-h 'done
|
||||
(ao-bufsize-async ao-h))))
|
||||
(if (eq? nbfs 'done)
|
||||
'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)))
|
||||
)
|
||||
(with-handlers ([exn:fail?
|
||||
(λ (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)
|
||||
(begin
|
||||
(evt '(audio-done))
|
||||
(let ((bufsize #f))
|
||||
(let loop ()
|
||||
(let ((nbfs (with-ao-h 'done
|
||||
(ao-bufsize-async ao-h))))
|
||||
(if (eq? nbfs '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
|
||||
(check-paused)
|
||||
(set! bufsize nbfs)
|
||||
(sleep 0.1)
|
||||
(loop)))
|
||||
)
|
||||
)
|
||||
)
|
||||
;; 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))
|
||||
)
|
||||
(when (= bufsize 0)
|
||||
(set! player-state 'stopped)
|
||||
(state "audio-read-worker: after read with bufsize 0" evt))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -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)
|
||||
(with-ao-h 'no-op (ao-pause ao-h #f))
|
||||
(state "check-paused: player-stat = playing" evt)
|
||||
)
|
||||
; 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 (format "check-paused: player-state = ~a" player-state) evt)
|
||||
#t)
|
||||
#f))
|
||||
|
||||
@@ -138,40 +160,59 @@
|
||||
(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)
|
||||
(set! ao-h #f)))
|
||||
(when (not (and
|
||||
(= current-bits bits-per-sample)
|
||||
(= current-rate rate)
|
||||
(= current-channels channels)))
|
||||
; If we need to reopen the ao device with different bit-rates,
|
||||
; 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)))))
|
||||
)
|
||||
|
||||
(when (eq? ao-h #f)
|
||||
(set! ao-h (ao-open-live bits-per-sample
|
||||
rate channels
|
||||
'native-endian))
|
||||
(set! current-bits bits-per-sample)
|
||||
(set! current-rate rate)
|
||||
(set! current-channels channels)
|
||||
(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)
|
||||
(state"audio-play: seconds changed (I)" evt))
|
||||
(state "audio-play: seconds changed (I)" evt))
|
||||
|
||||
(let* ((buf-size (with-ao-h 0 (ao-bufsize-async ao-h)))
|
||||
(buf-seconds (exact->inexact (/ buf-size
|
||||
@@ -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)))
|
||||
|
||||
(early-return
|
||||
((? (eq? cmd 'quit) => (stop-and-cleanup)
|
||||
~ (begin
|
||||
(state "quit" evt 'force)
|
||||
(put '(quit)))))
|
||||
(cmd (car data))
|
||||
(in-rpc #f))
|
||||
|
||||
(with-handlers ([exn:fail? (λ (e)
|
||||
(if (eq? ch-evt #f)
|
||||
(raise e)
|
||||
(evt (list 'exception e))))])
|
||||
(if (eq? cmd 'init)
|
||||
(begin
|
||||
(set! ch-out (cadr data))
|
||||
(set! ch-evt (caddr data))
|
||||
(put '(initialized)))
|
||||
(begin
|
||||
(when (or (eq? ch-out #f) (eq? ch-evt #f))
|
||||
(error "placed player not initialized"))
|
||||
(cond
|
||||
((eq? cmd 'buf-seconds)
|
||||
(set! min-buf-secs (if (< (cadr data) 2) 2 (cadr data)))
|
||||
(set! max-buf-secs (if (> (caddr data) 30) 30 (caddr data)))
|
||||
(put '(ok))
|
||||
)
|
||||
((eq? cmd 'open)
|
||||
(define-syntax do-rpc
|
||||
(syntax-rules (in-rpc)
|
||||
((_ b1 ...)
|
||||
(begin
|
||||
(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)
|
||||
(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))
|
||||
'(initialized))
|
||||
(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)
|
||||
(do-rpc
|
||||
(let* ((clamp (λ (x) (min 30 (max 2 x))))
|
||||
(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))
|
||||
))
|
||||
((eq? cmd 'seek)
|
||||
'(ok))))
|
||||
((eq? cmd 'seek)
|
||||
(do-rpc
|
||||
(let ((percentage (cadr data)))
|
||||
(seek percentage)
|
||||
(put '(ok))))
|
||||
((eq? cmd 'pause)
|
||||
'(ok))))
|
||||
((eq? cmd 'pause)
|
||||
(do-rpc
|
||||
(let ((paused (cadr data)))
|
||||
(pause paused)
|
||||
(put '(ok))))
|
||||
((eq? cmd 'paused)
|
||||
(put (list (eq? player-state 'paused))))
|
||||
((eq? cmd 'volume)
|
||||
'(ok))))
|
||||
((eq? cmd 'paused)
|
||||
(do-rpc
|
||||
(list (eq? player-state 'paused))))
|
||||
((eq? cmd 'volume)
|
||||
(do-rpc
|
||||
(let ((percentage (cadr data)))
|
||||
(volume percentage)
|
||||
(put '(ok))))
|
||||
((eq? cmd 'get-volume)
|
||||
(put (list current-volume)))
|
||||
((eq? cmd 'stop)
|
||||
(volume (exact->inexact percentage))
|
||||
'(ok))))
|
||||
((eq? cmd 'get-volume)
|
||||
(do-rpc
|
||||
(list current-volume)))
|
||||
((eq? cmd 'stop)
|
||||
(do-rpc
|
||||
(stop-and-cleanup)
|
||||
(put '(ok)))
|
||||
((eq? cmd 'state)
|
||||
(state "'state command" put))
|
||||
(else
|
||||
(error (format "Unknown command ~a" cmd)))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
(loop)))
|
||||
'(ok)))
|
||||
((eq? cmd 'state)
|
||||
(do-rpc
|
||||
(let ((st #f))
|
||||
(state "'state command" (λ (s) (set! st s)) 'force)
|
||||
st)))
|
||||
(else
|
||||
(do-rpc
|
||||
(list 'error (format "Unknown command ~a" cmd))))
|
||||
)
|
||||
(loop)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
Reference in New Issue
Block a user