Move to store thread join cond/lock/results directly

* libguile/threads.h: Add join data directly on the thread instead of
using a Scheme-side weak table.  It's less complicated and it will let
the weak table implementation use locks in Scheme; otherwise you would
have threads depending on weak tables and vice versa.
* libguile/threads.c (scm_trace_thread, guilify_self_1): Init and mark
the new members.
(thread_join_cond, thread_join_lock, thread_join_results)
(thread_init_joinable_x, thread_set_join_results_x): New accessors.
* module/ice-9/threads.scm (call-with-new-thread, join-thread): Use the
new accessors.

libguile/threads.c

@@ -108,6 +108,10 @@ scm_trace_thread (struct scm_thread *thread,
   scm_trace_dynstack (&thread->dynstack, trace_edge, heap, trace_data);
 
   trace_edge (gc_edge (&thread->continuation_root), heap, trace_data);
+
+  trace_edge (gc_edge (&thread->join_cond), heap, trace_data);
+  trace_edge (gc_edge (&thread->join_lock), heap, trace_data);
+  trace_edge (gc_edge (&thread->join_results), heap, trace_data);
 }
 
 /* Guile-level thread objects are themselves GC-allocated.  A thread
@@ -413,6 +417,8 @@ guilify_self_1 (struct gc_mutator *mut, struct gc_stack_addr base,
   t->base = (SCM_STACKITEM *) gc_stack_addr_as_pointer (base);
   t->continuation_root = SCM_EOL;
   t->continuation_base = t->base;
+  t->join_cond = t->join_lock = t->join_results = SCM_BOOL_F;
+
   scm_i_pthread_cond_init (&t->sleep_cond, NULL);
   scm_i_vm_prepare_stack (&t->vm);
 
@@ -840,6 +846,56 @@ scm_cancel_thread (SCM thread)
 
 static SCM join_thread_var;
 
+SCM_DEFINE_STATIC (thread_join_cond, "%thread-join-cond", 1, 0, 0,
+                   (SCM thread), "")
+#define FUNC_NAME s_thread_join_cond
+{
+  SCM_VALIDATE_THREAD (1, thread);
+  return SCM_I_THREAD_DATA (thread)->join_cond;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE_STATIC (thread_join_lock, "%thread-join-lock", 1, 0, 0,
+                   (SCM thread), "")
+#define FUNC_NAME s_thread_join_lock
+{
+  SCM_VALIDATE_THREAD (1, thread);
+  return SCM_I_THREAD_DATA (thread)->join_lock;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE_STATIC (thread_join_results, "%thread-join-results", 1, 0, 0,
+                   (SCM thread), "")
+#define FUNC_NAME s_thread_join_results
+{
+  SCM_VALIDATE_THREAD (1, thread);
+  return SCM_I_THREAD_DATA (thread)->join_results;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE_STATIC (thread_init_joinable_x, "%thread-init-joinable!", 3, 0, 0,
+                   (SCM thread, SCM cond, SCM lock), "")
+#define FUNC_NAME s_thread_init_joinable_x
+{
+  SCM_VALIDATE_THREAD (1, thread);
+  SCM_VALIDATE_CONDVAR (2, cond);
+  SCM_VALIDATE_MUTEX (3, lock);
+  SCM_I_THREAD_DATA (thread)->join_cond = cond;
+  SCM_I_THREAD_DATA (thread)->join_lock = lock;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE_STATIC (thread_set_join_results_x, "%thread-set-join-results!",
+                   2, 0, 0, (SCM thread, SCM results), "")
+#define FUNC_NAME s_thread_set_join_results_x
+{
+  SCM_VALIDATE_THREAD (1, thread);
+  SCM_I_THREAD_DATA (thread)->join_results = results;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
 SCM
 scm_join_thread (SCM thread)
 {

libguile/threads.h

@@ -123,6 +123,12 @@ struct scm_thread {
   SCM_STACKITEM *auxiliary_stack_base;
 #endif
 
+  /* For joinable threads, a cond to wait on joining, and a lock to
+     protect the results.  #f if not joinable.  */
+  SCM join_cond;
+  SCM join_lock;
+  SCM join_results;
+
   /* JIT state; NULL until this thread needs to JIT-compile something.  */
   struct scm_jit_state *jit_state;
 };

module/ice-9/threads.scm

@@ -102,9 +102,6 @@ no-op."
          (error "thread cancellation failed, throwing error instead???"))))
    thread))
 
-(define thread-join-data (make-object-property))
-(define %thread-results (make-object-property))
-
 (define* (call-with-new-thread thunk #:optional handler)
   "Call @code{thunk} in a new thread and with a new dynamic state,
 returning a new thread object representing the thread.  The procedure
@@ -146,15 +143,7 @@ Once @var{thunk} or @var{handler} returns, the return value is made the
                  (lambda ()
                    (lock-mutex mutex)
                    (set! thread (current-thread))
-                   ;; Rather than use the 'set!' syntax here, we use the
-                   ;; underlying 'setter' generic function to set the
-                   ;; 'thread-join-data' property on 'thread'.  This is
-                   ;; because 'set!' will try to resolve 'setter' in the
-                   ;; '(guile)' module, which means acquiring the
-                   ;; 'autoload' mutex.  If the calling thread is
-                   ;; already holding that mutex, this will result in
-                   ;; deadlock.  See <https://bugs.gnu.org/62691>.
-                   ((setter thread-join-data) thread (cons cv mutex))
+                   (%thread-init-joinable! thread cv mutex)
                    (signal-condition-variable cv)
                    (unlock-mutex mutex)
                    (call-with-unblocked-asyncs
@@ -163,16 +152,7 @@ Once @var{thunk} or @var{handler} returns, the return value is made the
                    (apply values args))))
            (lambda vals
              (lock-mutex mutex)
-             ;; Probably now you're wondering why we are going to use
-             ;; the cond variable as the key into the thread results
-             ;; object property.  It's because there is a possibility
-             ;; that the thread object itself ends up as part of the
-             ;; result, and if that happens we create a cycle whereby
-             ;; the strong reference to a thread in the value of the
-             ;; weak-key hash table used by the object property prevents
-             ;; the thread from ever being collected.  So instead we use
-             ;; the cv as the key.  Weak-key hash tables, amirite?
-             (set! (%thread-results cv) vals)
+             (%thread-set-join-results! thread vals)
              (broadcast-condition-variable cv)
              (unlock-mutex mutex)
              (apply values vals)))))
@@ -185,23 +165,24 @@ Once @var{thunk} or @var{handler} returns, the return value is made the
 (define* (join-thread thread #:optional timeout timeoutval)
   "Suspend execution of the calling thread until the target @var{thread}
 terminates, unless the target @var{thread} has already terminated."
-  (match (thread-join-data thread)
-    (#f (error "foreign thread cannot be joined" thread))
-    ((cv . mutex)
-     (lock-mutex mutex)
-     (let lp ()
-       (cond
-        ((%thread-results cv)
-         => (lambda (results)
-              (unlock-mutex mutex)
-              (apply values results)))
-        ((if timeout
-             (wait-condition-variable cv mutex timeout)
-             (wait-condition-variable cv mutex))
-         (lp))
-        (else
-         (unlock-mutex mutex)
-         timeoutval))))))
+  (define cv (%thread-join-cond thread))
+  (define mutex (%thread-join-lock thread))
+  (unless cv
+    (error "foreign thread cannot be joined" thread))
+  (lock-mutex mutex)
+  (let lp ()
+    (cond
+     ((%thread-join-results thread)
+      => (lambda (results)
+           (unlock-mutex mutex)
+           (apply values results)))
+     ((if timeout
+          (wait-condition-variable cv mutex timeout)
+          (wait-condition-variable cv mutex))
+      (lp))
+     (else
+      (unlock-mutex mutex)
+      timeoutval))))
 
 (define* (try-mutex mutex)
   "Try to lock @var{mutex}.  If the mutex is already locked, return