diff --git a/pkgs/racket-test-core/tests/racket/foreign-test.rktl b/pkgs/racket-test-core/tests/racket/foreign-test.rktl index 4e823a7fb9..71fe4a0371 100644 --- a/pkgs/racket-test-core/tests/racket/foreign-test.rktl +++ b/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) diff --git a/racket/src/cs/io.sls b/racket/src/cs/io.sls index 857bb94e35..53a4c56928 100644 --- a/racket/src/cs/io.sls +++ b/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)) diff --git a/racket/src/cs/rumble.sls b/racket/src/cs/rumble.sls index a7c52577b1..5d9392696f 100644 --- a/racket/src/cs/rumble.sls +++ b/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 diff --git a/racket/src/cs/rumble/foreign.ss b/racket/src/cs/rumble/foreign.ss index 6e1838eb45..57dd08c976 100644 --- a/racket/src/cs/rumble/foreign.ss +++ b/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 (set-async-callback-poll-wakeup! wakeup) - (set! async-callback-poll-wakeup wakeup)) +(define make-async-callback-poll-wakeup (lambda () void)) +(define (set-make-async-callback-poll-wakeup! make-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) diff --git a/racket/src/io/unsafe/schedule.rkt b/racket/src/io/unsafe/schedule.rkt index 299d2c511b..df62b529c3 100644 --- a/racket/src/io/unsafe/schedule.rkt +++ b/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))