cs: fix callbacks from arbitrary threads

The "wakeup" function needs to be retained from the place
that will run the callback.

pkgs/racket-test-core/tests/racket/foreign-test.rktl

@@ -723,10 +723,12 @@
 (when test-async?
   (define (check async like)
     (define foreign_thread_callback (get-ffi-obj 'foreign_thread_callback test-lib 
-                                                 (_fun (_fun #:async-apply async
+                                                 (_fun #:blocking? #t
+                                                       (_fun #:async-apply async
                                                              _intptr -> _intptr)
                                                        _intptr
-                                                       (_fun -> _void)
+                                                       (_fun #:async-apply (lambda (f) (f))
+                                                             -> _void)
                                                        -> _intptr)))
     (test (like 16) foreign_thread_callback (lambda (v) (add1 v)) 16 sleep))
   (check (lambda (f) (f)) add1)

racket/src/cs/io.sls

@@ -469,5 +469,5 @@
   (set-error-display-eprintf! (lambda (fmt . args)
                                 (apply 1/fprintf (|#%app| 1/current-error-port) fmt args)))
   (set-ffi-get-lib-and-obj! ffi-get-lib ffi-get-obj ptr->address)
-  (set-async-callback-poll-wakeup! 1/unsafe-signal-received)
+  (set-make-async-callback-poll-wakeup! unsafe-make-signal-received)
   (set-get-machine-info! get-machine-info))

racket/src/cs/rumble.sls

@@ -609,7 +609,7 @@
           (rename [ffi-lib* ffi-lib])
           set-ffi-get-lib-and-obj!        ; not exported to Racket
           poll-async-callbacks            ; not exported to Racket
-          set-async-callback-poll-wakeup! ; not exported to Racket
+          set-make-async-callback-poll-wakeup! ; not exported to Racket
           set-foreign-eval!               ; not exported to Racket
 
           unsafe-unbox

racket/src/cs/rumble/foreign.ss

@@ -1755,7 +1755,8 @@
 (define (foreign-place-init!)
   (current-async-callback-queue (make-async-callback-queue (make-mutex)
                                                            (make-condition)
-                                                           '())))
+                                                           '()
+                                                           (make-async-callback-poll-wakeup))))
 
 ;; Can be called in any Scheme thread
 (define (call-as-atomic-callback thunk atomic? async-apply async-callback-queue)
@@ -1800,7 +1801,7 @@
                                               (condition-broadcast (async-callback-queue-condition q))
                                               (mutex-release m))
                                             (async-callback-queue-in q)))
-      (async-callback-poll-wakeup)
+      ((async-callback-queue-wakeup q))
       (let loop ()
         (unless (unbox result-done?)
           (when need-interrupts?
@@ -1819,11 +1820,11 @@
   (set! scheduler-start-atomic start-atomic)
   (set! scheduler-end-atomic end-atomic))
 
-(define async-callback-poll-wakeup void)
+(define make-async-callback-poll-wakeup (lambda () void))
-(define (set-async-callback-poll-wakeup! wakeup)
+(define (set-make-async-callback-poll-wakeup! make-wakeup)
-  (set! async-callback-poll-wakeup wakeup))
+  (set! make-async-callback-poll-wakeup make-wakeup))
 
-(define-record async-callback-queue (lock condition in))
+(define-record async-callback-queue (lock condition in wakeup))
 
 (define-virtual-register current-async-callback-queue #f)
 

racket/src/io/unsafe/schedule.rkt

@@ -8,6 +8,7 @@
          unsafe-poll-ctx-eventmask-wakeup
          unsafe-poll-ctx-milliseconds-wakeup
          unsafe-signal-received
+         unsafe-make-signal-received
          unsafe-set-sleep-in-thread!)
 
 (define (unsafe-poller proc)
@@ -54,5 +55,10 @@
 (define (unsafe-signal-received)
   (rktio_signal_received rktio))
 
+(define (unsafe-make-signal-received)
+  (let ([rktio rktio]) ; capture current place's `rktio`
+    (lambda()
+      (rktio_signal_received rktio))))
+
 (define (unsafe-set-sleep-in-thread! do-sleep woke-fd)
   (sandman-set-background-sleep! do-sleep woke-fd))