keep late will executors live with pending wills

If a late will executor has pending will, then it needs to stay
live until the enclosing place has terminated (and post-custodian
callbacks are run). Otherwise, `ffi/unsafe/alloc` can lose values
that it expects to finalize, and it reports an "internal error".

The late will executor for `register-finalizer` from `ffi/unsafe`
was kept live in traditional Racket, but only as an accident of
custodian shutdown in a terminating place: the shutdown process skips
threads, since that work is technically not necessary. Relying on that
coincidence is asking for trouble, though, so implement retention more
deliberately.

racket/src/cs/rumble/will-executor.ss

@@ -13,6 +13,8 @@
 (define-thread-local the-will-stacks (make-weak-eq-hashtable))
 (define-thread-local the-stubborn-will-stacks (make-weak-eq-hashtable))
 
+(define-thread-local stubborn-will-executors-with-pending (make-eq-hashtable))
+
 (define-record-type (will-executor create-will-executor will-executor?)
   (fields guardian will-stacks (mutable ready) notify stubborn?))
 
@@ -56,6 +58,9 @@
     (cond
      [(pair? l)
       (will-executor-ready-set! executor (cdr l))
+      (when (and (will-executor-stubborn? executor)
+                 (null? (cdr l)))
+        (hashtable-delete! stubborn-will-executors-with-pending executor))
       (enable-interrupts)
       (car l)]
      [else
@@ -89,7 +94,11 @@
                   (hashtable-set! will-stacks v l)
                   (guardian v)])
                 ((will-executor-notify e))
-                (will-executor-ready-set! e (cons (cons proc v) (will-executor-ready e)))]))))
+                (will-executor-ready-set! e (cons (cons proc v) (will-executor-ready e)))
+                (when (will-executor-stubborn? e)
+                  ;; Ensure that a stubborn will executor stays live
+                  ;; in this place as long as there are wills to execute
+                  (hashtable-set! stubborn-will-executors-with-pending e #t))]))))
         (loop)))))
 
 (define (poll-will-executors)

racket/src/racket/include/schthread.h

@@ -256,6 +256,7 @@ typedef struct Thread_Local_Variables {
   struct Scheme_Config *initial_config_;
   struct Scheme_Thread *swap_target_;
   struct Scheme_Object *scheduled_kills_;
+  struct Scheme_Hash_Table *stubborn_will_executors_with_pending_;
   int do_atomic_;
   int missed_context_switch_;
   int all_breaks_disabled_;
@@ -640,6 +641,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
 #define initial_config XOA (scheme_get_thread_local_variables()->initial_config_)
 #define swap_target XOA (scheme_get_thread_local_variables()->swap_target_)
 #define scheduled_kills XOA (scheme_get_thread_local_variables()->scheduled_kills_)
+#define stubborn_will_executors_with_pending XOA (scheme_get_thread_local_variables()->stubborn_will_executors_with_pending_)
 #define do_atomic XOA (scheme_get_thread_local_variables()->do_atomic_)
 #define missed_context_switch XOA (scheme_get_thread_local_variables()->missed_context_switch_)
 #define all_breaks_disabled XOA (scheme_get_thread_local_variables()->all_breaks_disabled_)

racket/src/racket/src/thread.c

@@ -127,6 +127,8 @@ READ_ONLY static Scheme_Object *initial_inspector;
 
 THREAD_LOCAL_DECL(static Scheme_Plumber *initial_plumber);
 
+THREAD_LOCAL_DECL(static Scheme_Hash_Table *stubborn_will_executors_with_pending = NULL);
+
 THREAD_LOCAL_DECL(Scheme_Config *initial_config);
 
 #ifndef MZ_PRECISE_GC
@@ -8676,6 +8678,16 @@ static void activate_will(void *o, void *data)
       w->first = a;
     w->last = a;
     scheme_post_sema(w->sema);
+
+    if (w->is_stubborn) {
+      /* Ensure that a stubborn will executor stays live in this place
+         as long as there are wills to execute. */
+      if (!stubborn_will_executors_with_pending) {
+        REGISTER_SO(stubborn_will_executors_with_pending);
+        stubborn_will_executors_with_pending = scheme_make_hash_table(SCHEME_hash_ptr);
+      }
+      scheme_hash_set(stubborn_will_executors_with_pending, (Scheme_Object *)w, scheme_true);
+    }
   }
 }
 
@@ -8686,8 +8698,11 @@ static Scheme_Object *do_next_will(WillExecutor *w)
 
   a = w->first;
   w->first = a->next;
-  if (!w->first)
+  if (!w->first) {
     w->last = NULL;
+    if (w->is_stubborn)
+      scheme_hash_set(stubborn_will_executors_with_pending, (Scheme_Object *)w, NULL);
+  }
   
   o[0] = a->o;
   a->o = NULL;

racket/src/thread/will-executor.rkt

@@ -32,6 +32,9 @@
 (define (make-will-executor)
   (do-make-will-executor host:make-will-executor))
 
+;; The returned wrapper will executor isn't necessarily retained when
+;; there are pending wills, but the underlying one is retained, and
+;; that implies that finalized values won't get lost
 (define (make-stubborn-will-executor)
   (do-make-will-executor host:make-stubborn-will-executor))