Ensure the signal-delivery thread is completely stopped before fork

* libguile/scmsigs.c: Use raw pthread_create / pthread_join instead of
Guile's scm_spawn_thread, to ensure that the thread is entirely stopped
before a fork.
* libguile/scmsigs.h (scm_i_is_signal_delivery_thread): New internal
procedure, replacing a manual check against scm_i_signal_delivery_thread.
* libguile/threads.c: Use the new procedure.

Based on a patch by Rob Browning.  Thanks!

libguile/scmsigs.c

@@ -27,6 +27,7 @@
 #include <fcntl.h>      /* for mingw */
 #include <signal.h>
 #include <stdio.h>
+#include <string.h>
 #include <errno.h>
 
 #ifdef HAVE_PROCESS_H
@@ -85,12 +86,13 @@ static SCM *signal_handlers;
 static SCM signal_handler_asyncs;
 static SCM signal_handler_threads;
 
-/* The signal delivery thread.  */
+enum thread_state { STOPPED, RUNNING, STOPPING };
-SCM scm_i_signal_delivery_thread = SCM_BOOL_F;
 
 /* The mutex held when launching the signal delivery thread.  */
 static scm_i_pthread_mutex_t signal_delivery_thread_mutex =
   SCM_I_PTHREAD_MUTEX_INITIALIZER;
+static enum thread_state signal_delivery_thread_state = STOPPED;
+static scm_i_pthread_t signal_delivery_pthread;
 
 
 /* saves the original C handlers, when a new handler is installed.
@@ -151,7 +153,7 @@ read_signal_pipe_data (void * data)
   return NULL;
 }
   
-static SCM
+static void*
 signal_delivery_thread (void *data)
 {
   int sig;
@@ -198,23 +200,43 @@ signal_delivery_thread (void *data)
 
   close (signal_pipe[0]);
   signal_pipe[0] = -1;
+  signal_delivery_thread_state = STOPPED;
 
-  return SCM_UNSPECIFIED; /* not reached unless all other threads exited */
+  return NULL; /* not reached unless all other threads exited */
+}
+
+static void*
+run_signal_delivery_thread (void *arg)
+{
+  return scm_with_guile (signal_delivery_thread, arg);
 }
 
 static void
 start_signal_delivery_thread (void)
 {
-  SCM signal_thread;
-
   scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex);
 
+  if (signal_delivery_thread_state != STOPPED)
+    abort ();
+
   if (pipe2 (signal_pipe, O_CLOEXEC) != 0)
     scm_syserror (NULL);
-  signal_thread = scm_spawn_thread (signal_delivery_thread, NULL,
+
-				    scm_handle_by_message,
+  signal_delivery_thread_state = RUNNING;
-				    "signal delivery thread");
+
-  scm_i_signal_delivery_thread = signal_thread;
+  /* As with the finalizer thread, we use the raw pthread API and
+     scm_with_guile, to avoid blocking on any lock that scm_spawn_thread
+     might want to take.  */
+  int err = pthread_create (&signal_delivery_pthread, NULL,
+                            run_signal_delivery_thread, NULL);
+  if (err)
+    {
+      close (signal_pipe[0]); signal_pipe[0] = -1;
+      close (signal_pipe[1]); signal_pipe[1] = -1;
+      fprintf (stderr, "error creating signal delivery thread: %s\n",
+               strerror (err));
+      signal_delivery_thread_state = STOPPED;
+    }
 
   scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex);
 }
@@ -227,22 +249,43 @@ scm_i_ensure_signal_delivery_thread ()
   scm_i_pthread_once (&once, start_signal_delivery_thread);
 }
 
+/* Precondition: there is only the current thread and possibly the
+   signal delivery thread.  */
 static void
 stop_signal_delivery_thread ()
 {
   scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex);
+  if (signal_delivery_thread_state != RUNNING)
+    goto done;
 
-  if (scm_is_true (scm_i_signal_delivery_thread))
+  signal_delivery_thread_state = STOPPING;
+  close (signal_pipe[1]);
+  signal_pipe[1] = -1;
+
+  int res = pthread_join (signal_delivery_pthread, NULL);
+  if (res)
+    fprintf (stderr, "error joining signal delivery thread: %s\n",
+             strerror (res));
+  else
     {
-      close (signal_pipe[1]);
+      if (signal_delivery_thread_state != STOPPED)
-      signal_pipe[1] = -1;
+        abort ();
-      scm_join_thread (scm_i_signal_delivery_thread);
-      scm_i_signal_delivery_thread = SCM_BOOL_F;
     }
 
+ done:
   scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex);
 }
 
+static int
+is_signal_delivery_thread (scm_i_pthread_t thread)
+{
+  scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex);
+  int res = (signal_delivery_thread_state == RUNNING &&
+             pthread_equal (thread, signal_delivery_pthread));
+  scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex);
+  return res;
+}
+
 #else /* !SCM_USE_PTHREAD_THREADS */
 
 static void
@@ -274,6 +317,12 @@ stop_signal_delivery_thread ()
   return;
 }
 
+static int
+is_signal_delivery_thread (scm_i_pthread_t thread)
+{
+  return 0;
+}
+
 #endif /* !SCM_USE_PTHREAD_THREADS */
 
 /* Perform pre-fork cleanup by stopping the signal delivery thread.  */
@@ -283,6 +332,12 @@ scm_i_signals_pre_fork ()
   stop_signal_delivery_thread ();
 }
 
+int
+scm_i_is_signal_delivery_thread (struct scm_thread *t)
+{
+  return is_signal_delivery_thread (t->pthread);
+}
+
 /* Perform post-fork setup by restarting the signal delivery thread if
    it was active before fork.  This happens in both the parent and the
    child process.  */
@@ -753,15 +808,20 @@ SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
 void
 scm_i_close_signal_pipe()
 {
-  /* SIGNAL_DELIVERY_THREAD_MUTEX is only locked while the signal delivery
+  /* There is at most one other Guile thread.  It may be the signal
-     thread is being launched.  The thread that calls this function is
+     delivery thread.  If it is the signal delivery thread, the mutex
-     already holding the thread admin mutex, so if the delivery thread hasn't
+     will not be locked.  If the mutex is locked, then, we have nothing
-     been launched at this point, it never will be before shutdown.  */
+     to do.  */
-  scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex);
+  if (scm_i_pthread_mutex_trylock (&signal_delivery_thread_mutex))
+    return;
 
 #if SCM_USE_PTHREAD_THREADS
-  if (scm_is_true (scm_i_signal_delivery_thread))
+  if (signal_delivery_thread_state == RUNNING)
-    close (signal_pipe[1]);
+    {
+      signal_delivery_thread_state = STOPPING;
+      close (signal_pipe[1]);
+      signal_pipe[1] = -1;
+    }
 #endif
 
   scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex);

libguile/scmsigs.h

@@ -1,7 +1,7 @@
 #ifndef SCM_SCMSIGS_H
 #define SCM_SCMSIGS_H
 
-/* Copyright 1995-1998,2000,2002,2006-2008,2018,2023
+/* Copyright 1995-1998,2000,2002,2006-2008,2018,2023-2024
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -46,6 +46,7 @@ SCM_INTERNAL void scm_i_ensure_signal_delivery_thread (void);
 SCM_INTERNAL void scm_i_signals_pre_fork (void);
 SCM_INTERNAL void scm_i_signals_post_fork (void);
 
-SCM_INTERNAL SCM scm_i_signal_delivery_thread;
+struct scm_thread;
+SCM_INTERNAL int scm_i_is_signal_delivery_thread (struct scm_thread *t);
 
 #endif  /* SCM_SCMSIGS_H */

libguile/threads.c

@@ -1,4 +1,4 @@
-/* Copyright 1995-1998,2000-2014,2018-2019,2023
+/* Copyright 1995-1998,2000-2014,2018-2019,2023-2024
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -492,9 +492,8 @@ on_thread_exit (void *v)
   t->handle = SCM_PACK (0);
 
   /* If there's only one other thread, it could be the signal delivery
-     thread, so we need to notify it to shut down by closing its read pipe.
+     thread, in which case we should shut it down also by closing its
-     If it's not the signal delivery thread, then closing the read pipe isn't
+     read pipe.  */
-     going to hurt.  */
   if (thread_count <= 1)
     scm_i_close_signal_pipe ();
 
@@ -1692,9 +1691,7 @@ SCM_DEFINE (scm_all_threads, "all-threads", 0, 0, 0,
 
   for (t = all_threads; t && n > 0; t = t->next_thread)
     {
-      if (!t->exited
+      if (!t->exited && !scm_i_is_signal_delivery_thread (t))
-          && (scm_is_false (scm_i_signal_delivery_thread)
-              || (!scm_is_eq (t->handle, scm_i_signal_delivery_thread))))
 	{
 	  SCM_SETCAR (*l, t->handle);
 	  l = SCM_CDRLOC (*l);