From 24f539087fa87b29b97c8e17ba53ff067406e200 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 29 Jan 2021 10:50:31 -0700 Subject: [PATCH] ffi/unsafe/schedler: add `unsafe-make-signal-received` --- pkgs/base/info.rkt | 2 +- .../scribblings/foreign/schedule.scrbl | 18 +++++++++++++++++ racket/collects/ffi/unsafe/schedule.rkt | 1 + racket/src/bc/src/schminc.h | 2 +- racket/src/bc/src/thread.c | 20 +++++++++++++++++++ racket/src/cs/primitive/unsafe.ss | 1 + racket/src/version/racket_version.h | 2 +- 7 files changed, 43 insertions(+), 3 deletions(-) diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 99e11037f4..64a1d12b15 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -14,7 +14,7 @@ ;; In the Racket source repo, this version should change only when ;; "racket_version.h" changes: -(define version "8.0.0.3") +(define version "8.0.0.4") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-doc/scribblings/foreign/schedule.scrbl b/pkgs/racket-doc/scribblings/foreign/schedule.scrbl index b9a746d775..2dca09cd55 100644 --- a/pkgs/racket-doc/scribblings/foreign/schedule.scrbl +++ b/pkgs/racket-doc/scribblings/foreign/schedule.scrbl @@ -109,3 +109,21 @@ For use with @racket[unsafe-set-sleep-in-thread!] by @racket[_foreground-sleep] or something that it triggers, causes the default sleeping function to request @racket[_foreground-sleep] to return.} + +@defproc[(unsafe-make-signal-received) (-> void?)]{ + +Returns a function that is like @racket[unsafe-signal-received], but +it can be called in any @tech[#:doc reference.scrbl]{place} or in any +OS thread as supported by @racketmodname[ffi/unsafe/os-thread] to +ensure a subsequent round of polling by the thread scheduler in the +@tech[#:doc reference.scrbl]{place} where +@racket[unsafe-make-signal-received] was called. + +Synchronizaiton between the result of +@racket[unsafe-make-signal-received] and the scheduler will ensure the +equivalent of @racket[(memory-order-release)] before the call to the +function produced by @racket[unsafe-make-signal-received] and the +equivalent of @racket[(memory-order-acquire)] before the scheduler's +invocation of pollers. + +@history[#:added "8.0.0.4"]} diff --git a/racket/collects/ffi/unsafe/schedule.rkt b/racket/collects/ffi/unsafe/schedule.rkt index 35c6e3b3c3..5cab0cf6b7 100644 --- a/racket/collects/ffi/unsafe/schedule.rkt +++ b/racket/collects/ffi/unsafe/schedule.rkt @@ -6,5 +6,6 @@ unsafe-poll-ctx-eventmask-wakeup unsafe-poll-ctx-milliseconds-wakeup unsafe-signal-received + unsafe-make-signal-received unsafe-set-sleep-in-thread!)) (provide (all-from-out '#%unsafe)) diff --git a/racket/src/bc/src/schminc.h b/racket/src/bc/src/schminc.h index 6ebd1d0957..0f5a6d4ed6 100644 --- a/racket/src/bc/src/schminc.h +++ b/racket/src/bc/src/schminc.h @@ -15,7 +15,7 @@ #define USE_COMPILED_STARTUP 1 -#define EXPECTED_PRIM_COUNT 1484 +#define EXPECTED_PRIM_COUNT 1485 #ifdef MZSCHEME_SOMETHING_OMITTED # undef USE_COMPILED_STARTUP diff --git a/racket/src/bc/src/thread.c b/racket/src/bc/src/thread.c index 4b185e729a..9e7eb501ef 100644 --- a/racket/src/bc/src/thread.c +++ b/racket/src/bc/src/thread.c @@ -404,6 +404,7 @@ static Scheme_Object *unsafe_poll_ctx_fd_wakeup(int argc, Scheme_Object **argv); static Scheme_Object *unsafe_poll_ctx_eventmask_wakeup(int argc, Scheme_Object **argv); static Scheme_Object *unsafe_poll_ctx_time_wakeup(int argc, Scheme_Object **argv); static Scheme_Object *unsafe_signal_received(int argc, Scheme_Object **argv); +static Scheme_Object *unsafe_make_signal_received(int argc, Scheme_Object **argv); static Scheme_Object *unsafe_set_sleep_in_thread(int argc, Scheme_Object **argv); static Scheme_Object *unsafe_make_place_local(int argc, Scheme_Object **argv); @@ -676,6 +677,7 @@ scheme_init_unsafe_thread (Scheme_Startup_Env *env) ADD_PRIM_W_ARITY("unsafe-poll-ctx-eventmask-wakeup", unsafe_poll_ctx_eventmask_wakeup, 2, 2, env); ADD_PRIM_W_ARITY("unsafe-poll-ctx-milliseconds-wakeup", unsafe_poll_ctx_time_wakeup, 2, 2, env); ADD_PRIM_W_ARITY("unsafe-signal-received", unsafe_signal_received, 0, 0, env); + ADD_PRIM_W_ARITY("unsafe-make-signal-received", unsafe_make_signal_received, 0, 0, env); ADD_PRIM_W_ARITY("unsafe-set-sleep-in-thread!", unsafe_set_sleep_in_thread, 2, 2, env); ADD_PRIM_W_ARITY("unsafe-os-thread-enabled?", unsafe_os_thread_enabled_p, 0, 0, env); @@ -5548,6 +5550,24 @@ Scheme_Object *unsafe_signal_received(int argc, Scheme_Object **argv) return scheme_void; } +static Scheme_Object *do_signal_received(int argc, Scheme_Object **argv, Scheme_Object *self) +{ + void *h = SCHEME_PRIM_CLOSURE_ELS(self)[0]; + scheme_signal_received_at(h); + return scheme_void; +} + +Scheme_Object *unsafe_make_signal_received(int argc, Scheme_Object **argv) +{ + void *h; + Scheme_Object *a[1]; + + h = scheme_get_signal_handle(); + a[0] = (Scheme_Object *)h; + return scheme_make_prim_closure_w_arity(do_signal_received, 1, a, + "unsafe-signal-received", 0, 0); +} + static void sleep_via_thread(float seconds, void *fds) { #ifdef OS_X diff --git a/racket/src/cs/primitive/unsafe.ss b/racket/src/cs/primitive/unsafe.ss index 80723c382c..914fcb8676 100644 --- a/racket/src/cs/primitive/unsafe.ss +++ b/racket/src/cs/primitive/unsafe.ss @@ -121,6 +121,7 @@ [unsafe-make-place-local (known-procedure/pure 2)] [unsafe-make-os-semaphore (known-procedure 1)] [unsafe-make-security-guard-at-root (known-procedure 15)] + [unsafe-make-signal-received (known-procedure/succeeds 1)] [unsafe-make-srcloc (known-procedure/pure 32)] [unsafe-mcar (known-procedure/succeeds 2)] [unsafe-mcdr (known-procedure/succeeds 2)] diff --git a/racket/src/version/racket_version.h b/racket/src/version/racket_version.h index 4e5dac3d7f..847a93ef8e 100644 --- a/racket/src/version/racket_version.h +++ b/racket/src/version/racket_version.h @@ -16,7 +16,7 @@ #define MZSCHEME_VERSION_X 8 #define MZSCHEME_VERSION_Y 0 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 3 +#define MZSCHEME_VERSION_W 4 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x