Callback from OS Thread in FFI lib

Questions & Answers
1

A question about callbacks from a C library, where the callback will be initiated from a OS thread.

I'd like to initiate a callback as a kind of signal from a C library.
The signal will carry one integer value.
The callback function will be registered from racket and the call to the callback function will be done from a thread started by the C library.

I've read the FFI manual, but I'm not sure what to do.
As I understand it, the callback can be called in 'atomic' mode.
I should not use semaphore-post there.

The signal signals that data is waiting to be retrieved from de C library.
So I would like to have a racket thread, waiting on a semaphore or mutex and in the callback function I'd like to post the semaphore or unlock the mutex, so that data will be retrieved without polling.

I'm not sure how to do this. Had several crashes.
Does anyone have a hint?

2

I’ve been thinking. Would an async-apply combined with atomic? #t and in the callback, using a put on an async os channel be enough, while using sync in a racket thread?

3

From my reading of the docs, you definitely need an async-apply. I would try #:async-apply (lambda (p) (p)) first; that might be sufficient. You also need to make sure the closure doesn't get collected by the GC; that's a likely cause of crashes. Calling semaphore-post in atomic mode should be fine (semaphore-wait is not, of course).

Here's a little example program that waits until it receives either SIGUSR1 or SIGUSR2 (tested on Linux x86-64; should work on Mac OS too but the signal numbers might be different):

#lang racket/base
(require ffi/unsafe
         ffi/unsafe/define)

(define _sighandler
  (_fun #:atomic? #t  ;; redundant on Racket CS
        #:async-apply (lambda (p) (p))
        [val : _int] -> _void))

(define-ffi-definer define-c #f)

(define-c signal
  (_fun [signum : _int]
        [handler : _sighandler]
        -> _void))

(define SIGUSR1 10)
(define SIGUSR2 12)

(define val #f)
(define lock (make-semaphore 0))
(define (unlock n)
  (set! val n)
  (semaphore-post lock))

(signal SIGUSR1 unlock) ;; ok, unlock is module-level def, won't get GC'd
(signal SIGUSR2 unlock)
;; (signal SIGUSR1 (lambda (n) (unlock n)))  ;; problem, closure gets GC'd
;; (signal SIGUSR2 (lambda (n) (unlock n)))
(collect-garbage)
(semaphore-wait lock)

(printf "val = ~v\n" val)

Run this program in one terminal, then run kill -s SIGUSR2 $pid (with the pid of the Racket process) in another. The first program should print 12 and terminate.

Using the commented-out calls to signal instead will likely crash because the anonymous closures get garbage collected. A fix would be to use #:keep to make sure they don't get collected before you're done with them. For example, you could replace the beginning of the program with the following:

(define handlers-box (box null))

(define _sighandler
  (_fun #:atomic? #t
        #:async-apply (lambda (p) (p))
        #:keep handlers-box
        [val : _int] -> _void))
4

Thanks a lot.

I've done following in my code:

(define (evt-apply thunk)
  (thunk))

;RKTWEBVIEW_QT_EXPORT void rkt_webview_register_evt_callback(void (*f)(int));
(define-rktwebview rkt_webview_register_evt_callback
  (_fun (_fun #:async-apply evt-apply #:atomic? #t
              _int -> _void) -> _void))

(define events-channel (make-os-async-channel))

(define (event-callback num)
  (os-async-channel-put events-channel num))

(rkt_webview_register_evt_callback event-callback)

(...)

(define (start-event-processing)
   (thread (λ ()
     (letrec
         ((f
           (λ ()
             (let ((waiting (sync events-channel)))
               (set! waiting (rkt_webview_events_waiting))
               ;(displayln (format "Events waiting: ~a" waiting))
               (while (> waiting 0)
                      (let* ((rkt-evt (rkt_webview_get_event)))
                        (if (eq? rkt-evt #f)
                            (displayln (format "Unexpected: event = nullptr"))
                            (let* ((data (rkt_data_t-data rkt-evt))
                                   (e (union-ref data 1))
                                   (wv (rkt_evt_t-w e))
                                   (evt (cast (rkt_evt_t-evt e)
                                                             _pointer
                                                             _string*/utf-8))
                                   )
                              (rkt_webview_free_data rkt-evt)
                              (let ((cb (hash-ref evt-cb-hash wv #f)))
                                (unless (eq? cb #f)
                                  (cb evt))))))
                      (set! waiting (- waiting 1))
                      )
               )
             (f))
           ))
       (f)))))

(define evt-processing-thread (start-event-processing))

And this seems to work nicely.

Now, I don't need to poll for events anymore and this helps keeping the CPU load in racker low.