lazy ffmpeg

This commit is contained in:
2026-06-10 02:04:33 +02:00
parent 5c719ea4a0
commit 0b5d8a21b4
3 changed files with 140 additions and 43 deletions
+1 -1
View File
@@ -73,7 +73,7 @@ On Windows, the package downloader fetches the native DLL bundle from the
Codeberg `racket-sound-lib` release area. The current bundle URL pattern is: Codeberg `racket-sound-lib` release area. The current bundle URL pattern is:
```text ```text
https://codeberg.org/hnmdijkema/racket-sound-lib/releases/download/1-1-1/windows-x86_64.zip https://codeberg.org/hnmdijkema/racket-sound-lib/releases/download/1-1-2/windows-x86_64.zip
``` ```
The archive is installed below Racket's addon directory by The archive is installed below Racket's addon directory by
+138 -41
View File
@@ -109,10 +109,47 @@
(def-avformat avformat_version (_fun -> _uint)) (def-avformat avformat_version (_fun -> _uint))
(def-swresample swresample_version (_fun -> _uint)) (def-swresample swresample_version (_fun -> _uint))
(define avutil-version-major (quotient (avutil_version) 65536)) ;; Version functions are regular FFmpeg symbols, but they must not be called
(define avcodec-version-major (quotient (avcodec_version) 65536)) ;; unconditionally at module-load time. When one of the native FFmpeg
(define avformat-version-major (quotient (avformat_version) 65536)) ;; libraries is missing, define-ffi-definer creates a make-not-available
(define swresample-version-major (quotient (swresample_version) 65536)) ;; procedure. Calling that procedure here would make (require ...) fail even
;; for callers that do not use FFmpeg. Keep the runtime version as #f when the
;; library is unavailable and use the highest supported major only to choose a
;; harmless struct layout for the dormant bindings.
(define (packed-version->list v)
(list (quotient v 65536) (remainder (quotient v 256) 256) (remainder v 256)))
(define (ffmpeg-default-major lib)
(cadr (hash-ref valid-ffmpeg-versions lib)))
(define (ffmpeg-version-packed/false lib version-proc)
(with-handlers ([exn:fail? (λ (e) #f)])
(and lib (version-proc))))
(define avutil-version-packed (ffmpeg-version-packed/false libavutil avutil_version))
(define avcodec-version-packed (ffmpeg-version-packed/false libavcodec avcodec_version))
(define avformat-version-packed (ffmpeg-version-packed/false libavformat avformat_version))
(define swresample-version-packed (ffmpeg-version-packed/false libswresample swresample_version))
(define (ffmpeg-packed-version lib)
(cond ((eq? lib 'avutil) avutil-version-packed)
((eq? lib 'avcodec) avcodec-version-packed)
((eq? lib 'avformat) avformat-version-packed)
((or (eq? lib 'swr)
(eq? lib 'swresample)) swresample-version-packed)
(else (error (format "Unknown library '~a" lib)))))
(define (ffmpeg-runtime-major lib)
(let ((v (ffmpeg-packed-version lib)))
(and v (car (packed-version->list v)))))
(define (ffmpeg-layout-major lib)
(or (ffmpeg-runtime-major lib) (ffmpeg-default-major lib)))
(define avutil-version-major (ffmpeg-layout-major 'avutil))
(define avcodec-version-major (ffmpeg-layout-major 'avcodec))
(define avformat-version-major (ffmpeg-layout-major 'avformat))
(define swresample-version-major (ffmpeg-layout-major 'swresample))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Version check ;; Version check
@@ -123,16 +160,16 @@
;; so the rest of the module can choose version-dependent layouts. ;; so the rest of the module can choose version-dependent layouts.
(define (ffmpeg-version lib) (define (ffmpeg-version lib)
;; FFmpeg packs versions as major<<16 | minor<<8 | micro. ;; FFmpeg packs versions as major<<16 | minor<<8 | micro.
(let ((v (λ (v) (list (quotient v 65536) (remainder (quotient v 256) 256) (remainder v 256))))) ;; If the requested library is missing, call its make-not-available stub so
(cond ((eq? lib 'avutil) (v (avutil_version))) ;; callers get the same error style as every other unavailable FFI binding.
((eq? lib 'avcodec) (v (avcodec_version))) (let ((v (ffmpeg-packed-version lib)))
((eq? lib 'avformat) (v (avformat_version))) (cond (v (packed-version->list v))
((eq? lib 'avutil) (packed-version->list (avutil_version)))
((eq? lib 'avcodec) (packed-version->list (avcodec_version)))
((eq? lib 'avformat) (packed-version->list (avformat_version)))
((or (eq? lib 'swr) ((or (eq? lib 'swr)
(eq? lib 'swresample)) (v (swresample_version))) (eq? lib 'swresample)) (packed-version->list (swresample_version)))
(else (error (format "Unknown library '~a" lib))) (else (error (format "Unknown library '~a" lib))))))
)
)
)
;; Formats the runtime version of an FFmpeg library as text. ;; Formats the runtime version of an FFmpeg library as text.
;; This is mainly used in error messages and logging. ;; This is mainly used in error messages and logging.
@@ -141,31 +178,64 @@
;; Support ffmpeg 6, 7 and 8 ;; Support ffmpeg 6, 7 and 8
;; Checks at load time whether the detected FFmpeg major versions are supported. ;; Logs at load time whether the detected FFmpeg major versions are supported.
;; The struct layouts below are deliberately partial and major-version-dependent; ;; The struct layouts below are deliberately partial and major-version-dependent,
;; therefore an unknown major version must fail early and loudly. ;; so actual FFmpeg entry points call ensure-ffmpeg-library! before using them.
(define (ffmpeg-raise-unavailable! lib)
;; Deliberately call the library's version binding. When the native library
;; is missing this is the make-not-available stub installed by
;; define-ffi-definer, so the normal FFI unavailable-library message is kept.
(cond ((eq? lib 'avutil) (avutil_version))
((eq? lib 'avcodec) (avcodec_version))
((eq? lib 'avformat) (avformat_version))
((or (eq? lib 'swr)
(eq? lib 'swresample)) (swresample_version))
(else (error (format "Unknown library '~a" lib)))))
(define (ensure-ffmpeg-library! lib)
;; Keep require-time lazy: missing and unsupported libraries are only errors
;; at the boundary where FFmpeg functionality is actually used.
(let ((v (ffmpeg-packed-version lib)))
(cond
((not v) (ffmpeg-raise-unavailable! lib))
(else
(let* ((major-version (car (packed-version->list v)))
(from (car (hash-ref valid-ffmpeg-versions lib)))
(until (cadr (hash-ref valid-ffmpeg-versions lib))))
(when (or (< major-version from) (> major-version until))
(error
(format "Unsupported major version of ffmpeg library ~a: ~a (~a).
Supported range: ~a - ~a"
lib major-version (ffmpeg-version-string lib) from until)))))))
#t)
(define (ensure-ffmpeg-libraries! libs)
(for-each ensure-ffmpeg-library! libs)
#t)
(define (ensure-ffmpeg-decoder!)
;; The FFmpeg decoder path uses demuxing, decoding, avutil helpers and
;; swresample for conversion to the internal S32 PCM output.
(ensure-ffmpeg-libraries! '(avutil avcodec avformat swresample)))
(define-syntax check-support (define-syntax check-support
(syntax-rules () (syntax-rules ()
((_ lib version-hash) ((_ lib version-hash)
(let ((from (car (hash-ref version-hash lib))) (let ((from (car (hash-ref version-hash lib)))
(until (cadr (hash-ref version-hash lib)))) (until (cadr (hash-ref version-hash lib))))
;; Only the major version determines whether the C struct layouts below are safe. ;; Probe only for logging. Do not fail at require-time: even unsupported
(let ((major-version (car (ffmpeg-version lib)))) ;; versions should not break users that do not call FFmpeg functionality.
(let ((major-version (ffmpeg-runtime-major lib)))
(cond (cond
((not major-version)
(warn-sound "FFmpeg library ~a is not available; FFmpeg bindings stay dormant until the library is installed" lib))
((or (< major-version from) (> major-version until)) ((or (< major-version from) (> major-version until))
(error (warn-sound "Unsupported ffmpeg library ~a - version ~a; FFmpeg calls will fail until a supported version is installed"
(format "Unsupported major version of ffmpeg library ~a: ~a (~a).\nSupported range: ~a - ~a" lib (ffmpeg-version-string lib)))
'lib major-version (ffmpeg-version-string lib) from until)))
(else (else
(info-sound "Supported ffmpeg library ~a - version ~a between ~a and ~a" (info-sound "Supported ffmpeg library ~a - version ~a between ~a and ~a"
lib (ffmpeg-version-string lib) from until) lib (ffmpeg-version-string lib) from until))))))))
)
)
)
)
)
)
)
(check-support 'avutil valid-ffmpeg-versions) (check-support 'avutil valid-ffmpeg-versions)
(check-support 'avcodec valid-ffmpeg-versions) (check-support 'avcodec valid-ffmpeg-versions)
@@ -272,6 +342,7 @@
(_fun _AVChannelLayout-pointer -> _void)) (_fun _AVChannelLayout-pointer -> _void))
(define (ffmpeg-make-default-channel-layout channels) (define (ffmpeg-make-default-channel-layout channels)
(ensure-ffmpeg-library! 'avutil)
(let ((p (cast (malloc (ctype-sizeof _AVChannelLayout) 'atomic-interior) (let ((p (cast (malloc (ctype-sizeof _AVChannelLayout) 'atomic-interior)
_pointer _pointer
_AVChannelLayout-pointer))) _AVChannelLayout-pointer)))
@@ -279,7 +350,9 @@
p)) p))
(define (ffmpeg-channel-layout-uninit! p) (define (ffmpeg-channel-layout-uninit! p)
(when p (av_channel_layout_uninit p)) (when p
(ensure-ffmpeg-library! 'avutil)
(av_channel_layout_uninit p))
#t) #t)
; _AVCodecParameters: ; _AVCodecParameters:
@@ -617,7 +690,10 @@
;; This prevents decoder-storage from keeping an old native pointer after cleanup. ;; This prevents decoder-storage from keeping an old native pointer after cleanup.
(define (swr_free ctx) (define (swr_free ctx)
(if ctx (if ctx
(begin (swr_free/raw ctx) #f) (begin
(ensure-ffmpeg-library! 'swresample)
(swr_free/raw ctx)
#f)
#f)) #f))
(def-avformat avformat_close_input/raw (_fun (_ptr io _AVFormatContext-pointer/null) (def-avformat avformat_close_input/raw (_fun (_ptr io _AVFormatContext-pointer/null)
@@ -675,7 +751,7 @@
(begin (av_frame_free/raw frm) #f) (begin (av_frame_free/raw frm) #f)
#f)) #f))
(def-swresample swr_alloc_set_opts2 (def-swresample swr_alloc_set_opts2/raw
(_fun (ps : (_ptr io _SwrContext)) (_fun (ps : (_ptr io _SwrContext))
_AVChannelLayout-pointer ; out_ch_layout _AVChannelLayout-pointer ; out_ch_layout
_AVSampleFormat ; out_sample_fmt _AVSampleFormat ; out_sample_fmt
@@ -686,10 +762,18 @@
_int ; log_offset _int ; log_offset
_pointer ; log_ctx _pointer ; log_ctx
-> (r : _int) -> (r : _int)
-> (values r ps))) -> (values r ps)) #:c-id swr_alloc_set_opts2)
(def-swresample swr_init (define (swr_alloc_set_opts2 ps out-ch-layout out-sample-fmt out-sample-rate in-ch-layout in-sample-fmt in-sample-rate log-offset log-ctx)
(_fun _SwrContext -> _int)) (ensure-ffmpeg-library! 'swresample)
(swr_alloc_set_opts2/raw ps out-ch-layout out-sample-fmt out-sample-rate in-ch-layout in-sample-fmt in-sample-rate log-offset log-ctx))
(def-swresample swr_init/raw
(_fun _SwrContext -> _int) #:c-id swr_init)
(define (swr_init ctx)
(ensure-ffmpeg-library! 'swresample)
(swr_init/raw ctx))
(def-avcodec avcodec_parameters_alloc (def-avcodec avcodec_parameters_alloc
(_fun -> _AVCodecParameters-pointer/null)) (_fun -> _AVCodecParameters-pointer/null))
@@ -728,14 +812,26 @@
(_fun _AVFrame-pointer -> _int64)) (_fun _AVFrame-pointer -> _int64))
(def-swresample swr_get_out_samples (def-swresample swr_get_out_samples/raw
(_fun _SwrContext _int -> _int)) (_fun _SwrContext _int -> _int) #:c-id swr_get_out_samples)
(def-swresample swr_convert (define (swr_get_out_samples ctx in-samples)
(_fun _SwrContext _pointer _int _pointer _int -> _int)) (ensure-ffmpeg-library! 'swresample)
(swr_get_out_samples/raw ctx in-samples))
(def-swresample swr_get_delay (def-swresample swr_convert/raw
(_fun _SwrContext _int64 -> _int64)) (_fun _SwrContext _pointer _int _pointer _int -> _int) #:c-id swr_convert)
(define (swr_convert ctx out out-count in in-count)
(ensure-ffmpeg-library! 'swresample)
(swr_convert/raw ctx out out-count in in-count))
(def-swresample swr_get_delay/raw
(_fun _SwrContext _int64 -> _int64) #:c-id swr_get_delay)
(define (swr_get_delay ctx base)
(ensure-ffmpeg-library! 'swresample)
(swr_get_delay/raw ctx base))
(def-avutil av_samples_get_buffer_size (def-avutil av_samples_get_buffer_size
(_fun _pointer _int _int _AVSampleFormat _int -> _int)) (_fun _pointer _int _int _AVSampleFormat _int -> _int))
@@ -1260,6 +1356,7 @@
;; Opens an audio file and initializes all decode state. ;; Opens an audio file and initializes all decode state.
;; The function fails safely with 0: at every failed step, the half-open instance is closed. ;; The function fails safely with 0: at every failed step, the half-open instance is closed.
(define (fmpg-open-file! instance filename) (define (fmpg-open-file! instance filename)
(ensure-ffmpeg-decoder!)
;; First check the API preconditions: valid instance, not already open, ;; First check the API preconditions: valid instance, not already open,
;; no old format context, and a filename that FFmpeg can open. ;; no old format context, and a filename that FFmpeg can open.
(let/assert (let/assert
+1 -1
View File
@@ -27,7 +27,7 @@
(define version-major 1) (define version-major 1)
(define version-minor 1) (define version-minor 1)
(define version-patch 1) (define version-patch 2)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal functions ;; Internal functions