From a1e928350b643e619a58a84643182fcf5e717358 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 20 Jul 2018 08:34:12 -0600
Subject: [PATCH] foreign-call lock: repair for use during place termination

Now that `ffi/unsafe/alloc` deallocations are triggered by a place
exit, it's more likely that an ffi-call lock can be contended during a
place's termination. When that happens, the place cannot cooperate as
usual. Accomodate this rare situation by spinning.
---
 racket/src/foreign/foreign.c    | 7 ++++++-
 racket/src/foreign/foreign.rktc | 5 +++++
 racket/src/racket/src/place.c   | 5 +++++
 racket/src/racket/src/schpriv.h | 1 +
 4 files changed, 17 insertions(+), 1 deletion(-)

diff --git a/racket/src/foreign/foreign.c b/racket/src/foreign/foreign.c
index 68cba4993a..db1caa74ed 100644
--- a/racket/src/foreign/foreign.c
+++ b/racket/src/foreign/foreign.c
@@ -3256,6 +3256,11 @@ static void wait_ffi_lock(Scheme_Object *lock)
                  (uintptr_t)scheme_make_integer(scheme_current_place_id))) {
       /* obtained lock the fast way */
       break;
+    } else if (!scheme_place_can_receive()) {
+      /* We can get here while trying to terminate a place and run
+         custodian callbacks or other shutdown actions, and since
+         the place is shutting down, we can't commuincate with other
+         places; since we can't pause nicely, just spin */
     } else {
       Scheme_Object *owner, *new_val;
       owner = SCHEME_VEC_ELS(lock)[1];
@@ -3786,7 +3791,7 @@ static Scheme_Object *ffi_call_or_curry(const char *who, int curry, int argc, Sc
   scheme_register_finalizer(data, free_fficall_data, cif, NULL, NULL);
   a[0] = data;
 
-  scheme_performance_record_end("comp-ffi", &perf_state);
+  scheme_performance_record_end("comp-ffi-call", &perf_state);
 
   if (curry) {
     return scheme_make_prim_closure_w_arity(make_ffi_call_from_curried,
diff --git a/racket/src/foreign/foreign.rktc b/racket/src/foreign/foreign.rktc
index 54da9c1636..7264066931 100755
--- a/racket/src/foreign/foreign.rktc
+++ b/racket/src/foreign/foreign.rktc
@@ -2427,6 +2427,11 @@ static void wait_ffi_lock(Scheme_Object *lock)
                    (uintptr_t)scheme_make_integer(scheme_current_place_id))) {
         /* obtained lock the fast way */
         break;
+      } else if (!scheme_place_can_receive()) {
+        /* We can get here while trying to terminate a place and run
+           custodian callbacks or other shutdown actions, and since
+           the place is shutting down, we can't commuincate with other
+           places; since we can't pause nicely, just spin */
       } else {
         Scheme_Object *owner, *new_val;
         owner = SCHEME_VEC_ELS(lock)[1];
diff --git a/racket/src/racket/src/place.c b/racket/src/racket/src/place.c
index 012dc729a7..ddda79247b 100644
--- a/racket/src/racket/src/place.c
+++ b/racket/src/racket/src/place.c
@@ -3394,6 +3394,11 @@ Scheme_Object *scheme_place_async_channel_receive(Scheme_Object *ch) {
   return place_async_receive((Scheme_Place_Async_Channel *)ch);
 }
 
+int scheme_place_can_receive()
+{
+  return !!place_object;
+}
+
 /*========================================================================*/
 /*                       precise GC traversers                            */
 /*========================================================================*/
diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h
index 6dd64abd15..5be0cba9f7 100644
--- a/racket/src/racket/src/schpriv.h
+++ b/racket/src/racket/src/schpriv.h
@@ -3989,6 +3989,7 @@ void scheme_sort_resolve_ir_local_array(Scheme_IR_Local **a, intptr_t count);
 Scheme_Object *scheme_place_make_async_channel();
 void scheme_place_async_channel_send(Scheme_Object *ch, Scheme_Object *uo);
 Scheme_Object *scheme_place_async_channel_receive(Scheme_Object *ch);
+int scheme_place_can_receive();
 #endif
 int scheme_is_predefined_module_path(Scheme_Object *v);