ffi/unsafe/schedler: add unsafe-make-signal-received

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]))

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"]}

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))

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

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

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)]

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