[racket] FFI question: a callback that will be called by some foreign thread

At Sun, 11 Jul 2010 09:58:39 -0500, Chongkai Zhu wrote:
> Using FFI, one can use _cprocedure to pass Scheme procedures to foreign 
> functions as C callback. For my case, if the callback function is called 
> from a different C thread (unknow to PLT FFI), it crashes. Adding 
> #:atomic? #t doesn't help. Is there a workaround, or could I conclude 
> that FFI can't pass a Scheme procedure to be used as a C callback from 
> foreign threads?

There was no way to use a Racket procedure as a C callback that is
invoked a foreign thread. That possibility seems useful, though, and it
requires an extension to the FFI, so I've added something minimal.

A new `#:async-apply' optional argument to `_fun' lets you handle the
case that a callback is invoked in a foreign thread. The callback still
has to run in the OS thread that runs Racket, but the foreign thread
blocks until the callback produces a result.

The `#:async-apply' function introduces one level of indirection: it
receives a thunk that encapsulates the callback invocation from a
foreign thread. The job of the `#:async-apply' function is to schedule
the callback to run in some suitable thread; the `#:async-apply'
function itself runs in an unspecified Racket thread and in atomic
mode, which may be too constrained an environment for the callback
function. When the thunk-encapsulated callback completes, the foreign
thread receives the result and continues (i.e., the `#:async-apply'
function doesn't have to do anything afterward).

This new mode doesn't provide a way to run Racket code in multiple OS
threads. It just provides a way to have callbacks in foreign threads
trigger evaluation in the Racket thread.

An example use (that does nothing useful other than demonstrate
`#:async-apply') is below. It should work for Linux or Mac OS X. You
can double-check that commenting out the `#:async-apply' part of the
`_callback' definition produces a crash.

;----------------------------------------

#lang racket
(require ffi/unsafe
         ffi/unsafe/atomic)

;; A queue that implements locking by atomic actions,
;; since an async-apply function cannot block on a lock.
(define sema (make-semaphore))
(define queue null)
(define (enqueue thunk)
  (set! queue (append queue (list thunk)))
  (semaphore-post sema))
(define (dequeue)
  (semaphore-wait sema)
  (start-atomic)
  (let ([v (car queue)])
    (set! queue (cdr queue))
    (end-atomic)
    v))

;; Thread to run async calls in the background:
(thread (lambda ()
          (let loop ()
            (let ([thunk (dequeue)])
              (thunk)
              (loop)))))

(define _callback (_fun #:async-apply enqueue
                        _pointer -> _pointer))

(define _pthread (_cpointer 'pthread))

(define pthread-create
  (get-ffi-obj 'pthread_create #f
               (_fun (t : (_ptr o _pthread))
                     (_pointer = #f)
                     _callback
                     (_pointer = #f)
                     -> (r : _int)
                     -> (if (zero? r)
                            t
                            (error "thread create failed")))))

(define done (make-semaphore))
(define t (pthread-create (lambda ignored 
                            (printf "running\n")
                            (semaphore-post done)
                            #f)))
(sync done)