flac problems for os threads solved.

2026-06-29 15:10:15 +02:00
parent c4e1a78527
commit b38983109b
4 changed files with 206 additions and 51 deletions
@@ -15,8 +15,6 @@
           flac-stop
           flac-seek
           (all-from-out "flac-definitions.rkt")
-           kinds
-           last-buffer last-buf-len
           )

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -42,24 +40,13 @@
  (define (flac-stream-state handle)
    ((flac-handle-ffi-decoder-handler handle) 'state))

-
-  (define kinds (make-hash))
-  (define last-buffer #f)
-  (define last-buf-len #f)
-
-
-   (define (process-frame handle h mem-out)
+  (define (process-frame handle h mem-out)
     (let* ([cb-audio (flac-handle-cb-audio handle)]
            [type     (hash-ref h 'number-type)]
            [buf-size (bytes-length mem-out)])

       (hash-set! h 'duration (flac-duration handle))

-       (set! last-buffer mem-out)
-       (set! last-buf-len buf-size)
-
-       (hash-set! kinds type #t)
-
       (when (procedure? cb-audio)
         (cb-audio h mem-out buf-size))

@@ -380,27 +380,46 @@
 ;; FLAC Callback function definitions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-  
+;; libFLAC keeps the C callback pointers that are passed to
+;; FLAC__stream_decoder_init_file and calls them later from
+;; FLAC__stream_decoder_process_single. When process_single runs in a
+;; Racket thread with #:pool 'own, those callbacks can arrive from a
+;; different OS thread than the ordinary Racket coroutine-thread OS
+;; thread. Use #:async-apply so Racket can transfer such callback
+;; invocations safely, and use a per-decoder #:keep box so the generated
+;; callback stubs stay reachable as long as the decoder can call them.
+(define (flac-callback-async-apply thunk)
+  (thunk))
+
 ;typedef FLAC__StreamDecoderWriteStatus(* FLAC__StreamDecoderWriteCallback) (const FLAC__StreamDecoder *decoder, const FLAC__Frame *frame, const FLAC__int32 *const buffer[], void *client_data)
-(define _FLAC__StreamDecoderWriteCallback
-  (_fun _FLAC__StreamDecoder-pointer
-        _FLAC__Frame-pointer
-        FLAC__int32** 
-        _FLAC__Data-pointer
-        -> _int))
+(define (make-FLAC__StreamDecoderWriteCallback keep-box)
+  (_cprocedure
+   (list _FLAC__StreamDecoder-pointer
+         _FLAC__Frame-pointer
+         FLAC__int32**
+         _FLAC__Data-pointer)
+   _int
+   #:async-apply flac-callback-async-apply
+   #:keep keep-box))

 ;typedef void(* FLAC__StreamDecoderMetadataCallback) (const FLAC__StreamDecoder *decoder, const FLAC__StreamMetadata *metadata, void *client_data)
-(define _FLAC__StreamDecoderMetadataCallback
-  (_fun _FLAC__StreamDecoder-pointer
-        _FLAC__StreamMetadata-pointer
-        _FLAC__Data-pointer
-        -> _void))
+(define (make-FLAC__StreamDecoderMetadataCallback keep-box)
+  (_cprocedure
+   (list _FLAC__StreamDecoder-pointer
+         _FLAC__StreamMetadata-pointer
+         _FLAC__Data-pointer)
+   _void
+   #:async-apply flac-callback-async-apply
+   #:keep keep-box))

-(define _FLAC__StreamDecoderErrorCallback
-  (_fun _FLAC__StreamDecoder-pointer
-        _int
-        _FLAC__Data-pointer
-        -> _void))
+(define (make-FLAC__StreamDecoderErrorCallback keep-box)
+  (_cprocedure
+   (list _FLAC__StreamDecoder-pointer
+         _int
+         _FLAC__Data-pointer)
+   _void
+   #:async-apply flac-callback-async-apply
+   #:keep keep-box))


 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -439,10 +458,10 @@
 (define-libflac FLAC__stream_decoder_init_file
  (_fun _FLAC__StreamDecoder-pointer
        _string/utf-8
-        _FLAC__StreamDecoderWriteCallback
-        _FLAC__StreamDecoderMetadataCallback
-        _FLAC__StreamDecoderErrorCallback
-        _FLAC__Data-pointer  ; Seen by Jens Axel Søgaard - Is already present in FLAC 1.4.3 
+        _pointer
+        _pointer
+        _pointer
+        _FLAC__Data-pointer  ; Seen by Jens Axel Søgaard - Is already present in FLAC 1.4.3
        -> _int))

 (define-libflac FLAC__stream_decoder_process_single
@@ -524,26 +543,46 @@
  (define fl #f)
  (define flac-file #f)
  (define client-data #f)
-  
+  (define callback-keepers (box null))
+
+  (define (make-decoder-callback proc type)
+    ;; Convert the Racket procedure to a C function pointer with a type
+    ;; that uses callback-keepers as #:keep. The raw pointer is passed to
+    ;; libFLAC, while the keeper box retains the generated callback stub
+    ;; until delete releases it after FLAC__stream_decoder_finish/delete.
+    (cast proc type _pointer))
+
  ;(define (write-callback fl frame buffer client-data)
  ;  (set! write-data (append write-data (list (cons frame buffer))))
  ;  0)
  (define (write-callback fl frame buffer client-data)
-  (set! write-data (cons (copy-flac-frame frame buffer) write-data))
-    0)
+    (with-handlers ([exn:fail?
+                     (lambda (e)
+                       ;; Never let a Racket exception escape through a C
+                       ;; callback. Return FLAC__STREAM_DECODER_WRITE_STATUS_ABORT.
+                       (set! error-no -2)
+                       1)])
+      (set! write-data (cons (copy-flac-frame frame buffer) write-data))
+      0))

  ;(define (meta-callback fl meta client-data)
  ;  (let ((meta-clone (FLAC__metadata_object_clone meta)))
  ;    (unless (eq? meta-clone #f)
  ;      (set! meta-data (append meta-data (list meta-clone))))))
  (define (meta-callback fl meta client-data)
-    (let ((meta-clone (FLAC__metadata_object_clone meta)))
-      (unless (eq? meta-clone #f)
-        (set! meta-data (cons meta-clone meta-data)))))
+    (with-handlers ([exn:fail?
+                     (lambda (e)
+                       ;; Metadata callbacks return void; remember failure and
+                       ;; let the decoder state/error path report it.
+                       (set! error-no -3)
+                       (void))])
+      (let ((meta-clone (FLAC__metadata_object_clone meta)))
+        (unless (eq? meta-clone #f)
+          (set! meta-data (cons meta-clone meta-data))))))

  (define (error-callback fl errno client-data)
    (set! error-no errno)
-    )
+    (void))

  (define (new)
    (dbg-sound "flac-ffi 'new")
@@ -554,13 +593,25 @@

  (define (init file)
    (dbg-sound "flac-ffi 'init")
-    (let ((r (FLAC__stream_decoder_init_file
-              fl
-              file
-              write-callback
-              meta-callback
-              error-callback
-              client-data)))
+    (let* ((write-callback-ptr
+            (make-decoder-callback
+             write-callback
+             (make-FLAC__StreamDecoderWriteCallback callback-keepers)))
+           (meta-callback-ptr
+            (make-decoder-callback
+             meta-callback
+             (make-FLAC__StreamDecoderMetadataCallback callback-keepers)))
+           (error-callback-ptr
+            (make-decoder-callback
+             error-callback
+             (make-FLAC__StreamDecoderErrorCallback callback-keepers)))
+           (r (FLAC__stream_decoder_init_file
+               fl
+               file
+               write-callback-ptr
+               meta-callback-ptr
+               error-callback-ptr
+               client-data)))
      (set! flac-file file)
      r))

@@ -571,8 +622,10 @@
        (begin
          (FLAC__stream_decoder_finish fl)
          (FLAC__stream_decoder_delete fl)
-          (set! fl #f)))
-    )
+          (set! fl #f)
+          ;; libFLAC cannot call the callbacks anymore after finish/delete,
+          ;; so the generated callback stubs can now be released.
+          (set-box! callback-keepers null))))

  (define (process-single)
    (FLAC__stream_decoder_process_single fl))
@@ -0,0 +1,69 @@
+#lang racket/base
+
+(require "../flac-decoder.rkt")
+
+(define (test-flac-thread flac-path #:pool [pool #f])
+  (define result-ch (make-channel))
+
+  (define (start)
+    (thread
+     (lambda ()
+       (with-handlers ([exn:fail?
+                        (lambda (e)
+                          (channel-put result-ch
+                                       (list 'error (exn-message e))))])
+         (define frames 0)
+         (define buffers 0)
+         (define bytes 0)
+         (define fmt #f)
+
+         (define h
+           (flac-open
+            flac-path
+
+            ;; stream-info callback
+            (lambda (info)
+              (set! fmt info)
+              (printf "format: ~s\n" info)
+              (flush-output))
+
+            ;; audio callback
+            (lambda (info buffer len)
+              (set! buffers (add1 buffers))
+              (set! bytes (+ bytes len))
+              (define blocksize (hash-ref info 'blocksize #f))
+              (when (integer? blocksize)
+                (set! frames (+ frames blocksize)))
+
+              ;; af en toe iets printen, zodat je ziet dat hij loopt
+              (when (zero? (modulo buffers 500))
+                (printf "buffers=~a bytes=~a frames=~a\n"
+                        buffers bytes frames)
+                (flush-output)))))
+
+         (unless h
+           (error 'test-flac-thread "could not open FLAC file: ~a" flac-path))
+
+         (define state (flac-read h))
+
+         (channel-put result-ch
+                      (list 'ok
+                            'state state
+                            'buffers buffers
+                            'bytes bytes
+                            'frames frames
+                            'format fmt))))
+     #:pool pool)
+    )
+   
+  (start)
+  (start)
+  (start)
+
+  (channel-get result-ch)
+  (channel-get result-ch)
+  (channel-get result-ch)
+  )
+
+
+; (test-flac-thread "\\\\panderleou\\music\\Jazz\\LA4\\LA4 - Zaca\\01 Zaca.flac")
@@ -0,0 +1,46 @@
+#lang racket/base
+
+(require "../main.rkt"
+         "../audio-encoder.rkt")
+
+
+(define (convert-to-opus flac-in opus-out)
+  (let* ((opus-kbps 224)
+         (settings (hash 'bitrate (* opus-kbps 1000)
+                         'vbr #t))
+         )
+    (with-handlers ([exn? (λ (e)
+                            (displayln (format "~a" e))
+                            (when (file-exists? opus-out)
+                              (delete-file opus-out))
+                            #f)])
+      (let ((result (audio-encode flac-in opus-out
+                                  settings
+                                  #:encoder 'opus
+                                  #:copy-tags? #t)))
+        #t)
+      )
+    )
+  )
+
+(define (times-3-convert flac-in opus-out1 opus-out2 opus-out3 #:pool [pool #f])
+  (define (start opus-out)
+    (thread (λ ()
+              (displayln (format "Starting conversion: ~a" opus-out))
+              (convert-to-opus flac-in opus-out)
+              (displayln (format"  converted: ~a" opus-out))
+              #t
+              ) #:pool pool)
+    )
+
+  (let* ((t1 (start opus-out1))
+         (t2 (start opus-out2))
+         (t3 (start opus-out3))
+         )
+    (thread-wait t1)
+    (thread-wait t2)
+    (thread-wait t3)
+    )
+  )
+
+; (convert-to-opus  "\\\\panderleou\\music\\Jazz\\LA4\\LA4 - Zaca\\01 Zaca.flac" "c:\\tmp\\test.opus" )