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:
2026-05-15 22:11:25 +02:00
parent 3c18e75cf6
commit c9a91bf2be
11 changed files with 534 additions and 340 deletions
+102 -184
View File
@@ -898,51 +898,21 @@
)
)
#|
(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
(fmpg-instance-opened instance)
(fmpg-instance-format-ctx instance)
(let ((info (fmpg-instance-audio-info instance)))
(and info
(>= (ais-stream-index info) 0)))
(let ((dec (fmpg-instance-decoder instance)))
(and dec
(ds-codec-ctx dec)
(ds-swr-ctx dec)))
#t))
(let ((ready (and instance
(fmpg-instance-opened instance)
(fmpg-instance-format-ctx instance)
(let ((info (fmpg-instance-audio-info instance)))
(and info
(>= (ais-stream-index info) 0)))
(let ((dec (fmpg-instance-decoder instance)))
(and dec
(ds-codec-ctx dec)
(ds-swr-ctx dec)))
#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]
[(= (avpacket-stream-index pkt) wanted-stream) #t]
[(= ret AVERROR_EOF)
'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)
(pkt (av_packet_alloc) ? (eq? pkt #f) => 0)
(received (receive-result! instance dec)
? 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))
(ds-eof-seen! dec #t)
(av_packet_unref pkt)
#f]
[else
(let ((ret (avcodec_send_packet (ds-codec-ctx dec) pkt)))
(av_packet_unref pkt)
(let ((packet-status (read-selected-audio-packet! instance pkt)))
(cond
[(= ret AVERROR_EAGAIN)
(let ((received (receive-result! instance dec)))
(if received received (loop)))]
[(< ret 0) 0]
[(eq? packet-status 'eof)
(ds-eof-seen! dec #t)
(av_packet_unref pkt)
#f]
[(eq? packet-status 'error)
(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)
ret]
[else
(let ((received (receive-result! instance dec)))
(if received received (loop)))]))]
[else
(let ((received (receive-result! instance dec)))
(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)))
(av_packet_unref pkt)
(cond
[(= ret AVERROR_EAGAIN)
(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
(err-sound "read-selected-audio-packet!: unexpected result ~a"
packet-status)
-1]))]))
? packet-result => (r "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]
[else (receive-result! instance dec)])))
? drain-result => drain-result)
[(= ret AVERROR_EOF)
(ds-drained! dec #t)
#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