flac problems for os threads solved.

libflac-ffi.rkt

@@ -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))