Re: Does Guile have a thread limit?

[Taylan Ulrich Bayırlı /Kammer]

Mark H Weaver <address@hidden> writes:

> "Diogo F. S. Ramos" <address@hidden> writes:
>
>> The following program is aborted:
>>
>> (define number-of-thread 1000)
>>
>> (do ((i number-of-thread (- i 1)))
>>     ((zero? i))
>>   (call-with-new-thread (lambda () (sleep 42))))
>
> I looked into this, and the issue is that for every thread that's ever
> put into Guile mode, Guile creates a pipe which is used to wake it up
> while it's sleeping or waiting in 'select', e.g. if an async is queued.
>
> Therefore, two file descriptors are allocated for each such thread.
>
> Unfortunately, if you run out of file descriptors while creating a
> thread, it simply aborts, which is obviously suboptimal.  The relevant
> code is in threads.c:563.
>
>     Mark

Here's a patch to fix this.  I'm a novice in C projects and the Guile
code-base so please criticize as much as possible!

I have an equivalent patch for stable-2.0, except that it doesn't add
the `int *err' argument to `scm_with_guile'.  (The void to int return
type changes in some other public functions is kept, because I imagine
it's unlikely that existing code *relies* on void returns.)

However, strangely, when I *did* also add the `int *err' argument to
`scm_with_guile' on stable-2.0, I would get occasional segfaults during
`make check', which I can't make sense of.  Example backtrace from a
core dump: http://sprunge.us/LhSR .  BTW this is OpenBSD 5.3.  Does
anyone have ideas?

I can't be sure whether this patch for master perhaps suffers from the
same issue (since it does add the extra argument), because I already get
`make check' failures as it stands, though my patch doesn't seem to
affect where I get them (using make -k).

I'm leaving the patch for stable-2.0 for later, since it's based on this
one and any suggested changes will be carried over:

>From dd5eb7e1d85d3e23e58f027f4b427752a32332fa Mon Sep 17 00:00:00 2001
From: Taylan Ulrich B <address@hidden>
Date: Tue, 8 Apr 2014 21:33:43 +0200
Subject: [PATCH] Handle thread creation failure

* libguile/init.h (scm_init_guile): Return int for errors.
* libguile/threads.h (scm_with_guile): Take `int *err' argument.
(scm_threads_prehistory): Return int for error.
(scm_init_threads): Return int for errors.

* libguile/threads.c (guilify_self_1): Return int for errors.
(guilify_self_2): Return int for errors.
(do_thread_exit_trampoline): Pass third arg to `scm_with_guile'.
(scm_i_init_thread_for_guile): Return -1 on failure.
(scm_init_guile): Return int for errors.
(with_guile_args): Add `int err' field.
(with_guile_and_parent): Handle thread init failure.
(scm_i_with_guile_and_parent): Handle `with_guile_and_parent' error.
(scm_with_guile): Take `int *err' argument.
(launch_data): Add `int err' field.
(launch_thread): Handle `scm_i_with_guile_and_parent' error.
(call-with-new-thread): Signal thread creation failure.
(spawn_data): Add `int err' field.
(spawn_thread): Handle `scm_i_with_guile_and_parent' error.
(scm_threads_prehistory): Return int for errors.
(scm_init_threads): Return int for errors.

* libguile/init.c:
* libguile/finalizers.c:
* test-suite/standalone/test-pthread-create-secondary.c:
* test-suite/standalone/test-pthread-create.c:
* test-suite/standalone/test-scm-c-read.c:
* test-suite/standalone/test-scm-spawn-thread.c:
* test-suite/standalone/test-scm-take-locale-symbol.c:
* test-suite/standalone/test-scm-take-u8vector.c:
* test-suite/standalone/test-scm-with-guile.c:
* test-suite/standalone/test-with-guile-module.c: Pass NULL to
  `scm_with_guile' for the int *err argument.
---
 libguile/finalizers.c                              |  2 +-
 libguile/init.c                                    |  4 +-
 libguile/init.h                                    |  2 +-
 libguile/threads.c                                 | 93 ++++++++++++++++------
 libguile/threads.h                                 |  6 +-
 .../standalone/test-pthread-create-secondary.c     |  2 +-
 test-suite/standalone/test-pthread-create.c        |  4 +-
 test-suite/standalone/test-scm-c-read.c            |  2 +-
 test-suite/standalone/test-scm-spawn-thread.c      |  2 +-
 .../standalone/test-scm-take-locale-symbol.c       |  2 +-
 test-suite/standalone/test-scm-take-u8vector.c     |  2 +-
 test-suite/standalone/test-scm-with-guile.c        |  4 +-
 test-suite/standalone/test-with-guile-module.c     |  4 +-
 13 files changed, 85 insertions(+), 44 deletions(-)

diff --git a/libguile/finalizers.c b/libguile/finalizers.c
index eaea139..b8cf854 100644
--- a/libguile/finalizers.c
+++ b/libguile/finalizers.c
@@ -239,7 +239,7 @@ finalization_thread_proc (void *unused)
 static void*
 run_finalization_thread (void *arg)
 {
-  return scm_with_guile (finalization_thread_proc, arg);
+  return scm_with_guile (finalization_thread_proc, arg, NULL);
 }
 
 static void
diff --git a/libguile/init.c b/libguile/init.c
index 81cf997..313e1be 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -315,7 +315,7 @@ scm_boot_guile (int argc, char ** argv, void (*main_func) 
(), void *closure)
   c.argc = argc;
   c.argv = argv;
 
-  res = scm_with_guile (invoke_main_func, &c);
+  res = scm_with_guile (invoke_main_func, &c, NULL);
 
   /* If the caller doesn't want this, they should exit from main_func
      themselves.
@@ -371,7 +371,7 @@ cleanup_for_exit ()
   /* This function might be called in non-guile mode, so we need to
      enter it temporarily. 
   */
-  scm_with_guile (really_cleanup_for_exit, NULL);
+  scm_with_guile (really_cleanup_for_exit, NULL, NULL);
 }
 
 void
diff --git a/libguile/init.h b/libguile/init.h
index bc6cddf..f529c4f 100644
--- a/libguile/init.h
+++ b/libguile/init.h
@@ -30,7 +30,7 @@
 SCM_INTERNAL scm_i_pthread_mutex_t scm_i_init_mutex;
 SCM_API int scm_initialized_p;
 
-SCM_API void scm_init_guile (void);
+SCM_API int scm_init_guile (void);
 
 SCM_API void scm_boot_guile (int argc, char **argv,
                             void (*main_func) (void *closure,
diff --git a/libguile/threads.c b/libguile/threads.c
index dd04f6f..532270f 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -394,7 +394,7 @@ scm_i_reset_fluid (size_t n)
 
 /* Perform first stage of thread initialisation, in non-guile mode.
  */
-static void
+static int
 guilify_self_1 (struct GC_stack_base *base)
 {
   scm_i_thread t;
@@ -434,10 +434,7 @@ guilify_self_1 (struct GC_stack_base *base)
   t.vp = NULL;
 
   if (pipe2 (t.sleep_pipe, O_CLOEXEC) != 0)
-    /* FIXME: Error conditions during the initialization phase are handled
-       gracelessly since public functions such as `scm_init_guile ()'
-       currently have type `void'.  */
-    abort ();
+    return -1;
 
   scm_i_pthread_mutex_init (&t.admin_mutex, NULL);
   t.canceled = 0;
@@ -467,11 +464,13 @@ guilify_self_1 (struct GC_stack_base *base)
 
     GC_enable ();
   }
+
+  return 0;
 }
 
 /* Perform second stage of thread initialisation, in guile mode.
  */
-static void
+static int
 guilify_self_2 (SCM parent)
 {
   scm_i_thread *t = SCM_I_CURRENT_THREAD;
@@ -503,6 +502,8 @@ guilify_self_2 (SCM parent)
 
   /* See note in finalizers.c:queue_finalizer_async().  */
   GC_invoke_finalizers ();
+
+  return 0;
 }
 
 
@@ -597,7 +598,7 @@ do_thread_exit_trampoline (struct GC_stack_base *sb, void 
*v)
   GC_register_my_thread (sb);
 #endif
 
-  return scm_with_guile (do_thread_exit, v);
+  return scm_with_guile (do_thread_exit, v, NULL);
 }
 
 static void
@@ -683,7 +684,7 @@ init_thread_key (void)
    which case the default dynamic state is used.
 
    Returns zero when the thread was known to guile already; otherwise
-   return 1.
+   return 1 for success, -1 for failure.
 
    Note that it could be the case that the thread was known
    to Guile, but not in guile mode (because we are within a
@@ -733,21 +734,23 @@ scm_i_init_thread_for_guile (struct GC_stack_base *base, 
SCM parent)
           GC_register_my_thread (base);
 #endif
 
-         guilify_self_1 (base);
-         guilify_self_2 (parent);
+          if (guilify_self_1 (base) != 0)
+            return -1;
+          if (guilify_self_2 (parent) != 0)
+            return -1;
        }
       return 1;
     }
 }
 
-void
+int
 scm_init_guile ()
 {
   struct GC_stack_base stack_base;
   
   if (GC_get_stack_base (&stack_base) == GC_SUCCESS)
-    scm_i_init_thread_for_guile (&stack_base,
-                                 scm_i_default_dynamic_state);
+    return scm_i_init_thread_for_guile (&stack_base,
+                                        scm_i_default_dynamic_state);
   else
     {
       fprintf (stderr, "Failed to get stack base for current thread.\n");
@@ -760,6 +763,7 @@ struct with_guile_args
   GC_fn_type func;
   void *data;
   SCM parent;
+  int err;
 };
 
 static void *
@@ -779,6 +783,11 @@ with_guile_and_parent (struct GC_stack_base *base, void 
*data)
   struct with_guile_args *args = data;
 
   new_thread = scm_i_init_thread_for_guile (base, args->parent);
+  if (new_thread < 0)
+    {
+      args->err = new_thread;
+      return NULL;
+    }
   t = SCM_I_CURRENT_THREAD;
   if (new_thread)
     {
@@ -820,22 +829,29 @@ with_guile_and_parent (struct GC_stack_base *base, void 
*data)
 }
 
 static void *
-scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent)
+scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent,
+                             int *err)
 {
   struct with_guile_args args;
+  void *ret;
 
   args.func = func;
   args.data = data;
   args.parent = parent;
-  
-  return GC_call_with_stack_base (with_guile_and_parent, &args);
+  args.err = 0;
+
+  ret = GC_call_with_stack_base (with_guile_and_parent, &args);
+  if (err)
+    *err = args.err;
+  return ret;
 }
 
 void *
-scm_with_guile (void *(*func)(void *), void *data)
+scm_with_guile (void *(*func)(void *), void *data, int *err)
 {
   return scm_i_with_guile_and_parent (func, data,
-                                     scm_i_default_dynamic_state);
+                                     scm_i_default_dynamic_state,
+                                      err);
 }
 
 void *
@@ -867,6 +883,7 @@ typedef struct {
   SCM thread;
   scm_i_pthread_mutex_t mutex;
   scm_i_pthread_cond_t cond;
+  int err;
 } launch_data;
 
 static void *
@@ -896,7 +913,13 @@ launch_thread (void *d)
 {
   launch_data *data = (launch_data *)d;
   scm_i_pthread_detach (scm_i_pthread_self ());
-  scm_i_with_guile_and_parent (really_launch, d, data->parent);
+  scm_i_with_guile_and_parent (really_launch, d, data->parent, &data->err);
+  if (data->err)
+    {
+      scm_i_scm_pthread_mutex_lock (&data->mutex);
+      scm_i_pthread_cond_signal (&data->cond);
+      scm_i_pthread_mutex_unlock (&data->mutex);
+    }
   return NULL;
 }
 
@@ -929,6 +952,7 @@ SCM_DEFINE (scm_call_with_new_thread, 
"call-with-new-thread", 1, 1, 0,
   data.thread = SCM_BOOL_F;
   scm_i_pthread_mutex_init (&data.mutex, NULL);
   scm_i_pthread_cond_init (&data.cond, NULL);
+  data.err = 0;
 
   scm_i_scm_pthread_mutex_lock (&data.mutex);
   err = scm_i_pthread_create (&id, NULL, launch_thread, &data);
@@ -939,11 +963,14 @@ SCM_DEFINE (scm_call_with_new_thread, 
"call-with-new-thread", 1, 1, 0,
       scm_syserror (NULL);
     }
 
-  while (scm_is_false (data.thread))
+  while (scm_is_false (data.thread) && data.err == 0)
     scm_i_scm_pthread_cond_wait (&data.cond, &data.mutex);
 
   scm_i_pthread_mutex_unlock (&data.mutex);
 
+  if (data.err)
+    SCM_MISC_ERROR ("could not launch thread", SCM_EOL);
+
   return data.thread;
 }
 #undef FUNC_NAME
@@ -957,6 +984,7 @@ typedef struct {
   SCM thread;
   scm_i_pthread_mutex_t mutex;
   scm_i_pthread_cond_t cond;
+  int err;
 } spawn_data;
 
 static void *
@@ -989,7 +1017,13 @@ spawn_thread (void *d)
 {
   spawn_data *data = (spawn_data *)d;
   scm_i_pthread_detach (scm_i_pthread_self ());
-  scm_i_with_guile_and_parent (really_spawn, d, data->parent);
+  scm_i_with_guile_and_parent (really_spawn, d, data->parent, &data->err);
+  if (data->err)
+    {
+      scm_i_scm_pthread_mutex_lock (&data->mutex);
+      scm_i_pthread_cond_signal (&data->cond);
+      scm_i_pthread_mutex_unlock (&data->mutex);
+    }
   return NULL;
 }
 
@@ -1009,6 +1043,7 @@ scm_spawn_thread (scm_t_catch_body body, void *body_data,
   data.thread = SCM_BOOL_F;
   scm_i_pthread_mutex_init (&data.mutex, NULL);
   scm_i_pthread_cond_init (&data.cond, NULL);
+  data.err = 0;
 
   scm_i_scm_pthread_mutex_lock (&data.mutex);
   err = scm_i_pthread_create (&id, NULL, spawn_thread, &data);
@@ -1019,11 +1054,14 @@ scm_spawn_thread (scm_t_catch_body body, void 
*body_data,
       scm_syserror (NULL);
     }
 
-  while (scm_is_false (data.thread))
+  while (scm_is_false (data.thread) && data.err == 0)
     scm_i_scm_pthread_cond_wait (&data.cond, &data.mutex);
 
   scm_i_pthread_mutex_unlock (&data.mutex);
 
+  if (data.err)
+    scm_misc_error (NULL, "could not spawn thread", SCM_EOL);
+
   assert (SCM_I_IS_THREAD (data.thread));
 
   return data.thread;
@@ -2070,7 +2108,7 @@ scm_i_pthread_mutex_t scm_i_misc_mutex;
 pthread_mutexattr_t scm_i_pthread_mutexattr_recursive[1];
 #endif
 
-void
+int
 scm_threads_prehistory (void *base)
 {
 #if SCM_USE_PTHREAD_THREADS
@@ -2089,14 +2127,14 @@ scm_threads_prehistory (void *base)
                 GC_MAKE_PROC (GC_new_proc (thread_mark), 0),
                 0, 1);
 
-  guilify_self_1 ((struct GC_stack_base *) base);
+  return guilify_self_1 ((struct GC_stack_base *) base);
 }
 
 scm_t_bits scm_tc16_thread;
 scm_t_bits scm_tc16_mutex;
 scm_t_bits scm_tc16_condvar;
 
-void
+int
 scm_init_threads ()
 {
   scm_tc16_thread = scm_make_smob_type ("thread", sizeof (scm_i_thread));
@@ -2110,10 +2148,13 @@ scm_init_threads ()
   scm_set_smob_print (scm_tc16_condvar, fat_cond_print);
 
   scm_i_default_dynamic_state = SCM_BOOL_F;
-  guilify_self_2 (SCM_BOOL_F);
+  if (guilify_self_2 (SCM_BOOL_F) != 0)
+    return -1;
   threads_initialized_p = 1;
 
   dynwind_critical_section_mutex = scm_make_recursive_mutex ();
+
+  return 0;
 }
 
 void
diff --git a/libguile/threads.h b/libguile/threads.h
index 6b85baf..62db18a 100644
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -136,11 +136,11 @@ SCM_API SCM scm_spawn_thread (scm_t_catch_body body, void 
*body_data,
                              scm_t_catch_handler handler, void *handler_data);
 
 SCM_API void *scm_without_guile (void *(*func)(void *), void *data);
-SCM_API void *scm_with_guile (void *(*func)(void *), void *data);
+SCM_API void *scm_with_guile (void *(*func)(void *), void *data, int *err);
 
 SCM_INTERNAL void scm_i_reset_fluid (size_t);
-SCM_INTERNAL void scm_threads_prehistory (void *);
-SCM_INTERNAL void scm_init_threads (void);
+SCM_INTERNAL int scm_threads_prehistory (void *);
+SCM_INTERNAL int scm_init_threads (void);
 SCM_INTERNAL void scm_init_thread_procs (void);
 SCM_INTERNAL void scm_init_threads_default_dynamic_state (void);
 
diff --git a/test-suite/standalone/test-pthread-create-secondary.c 
b/test-suite/standalone/test-pthread-create-secondary.c
index 14ea240..71f8f82 100644
--- a/test-suite/standalone/test-pthread-create-secondary.c
+++ b/test-suite/standalone/test-pthread-create-secondary.c
@@ -56,7 +56,7 @@ do_something (void *arg)
 static void *
 thread (void *arg)
 {
-  scm_with_guile (do_something, NULL);
+  scm_with_guile (do_something, NULL, NULL);
   return NULL;
 }
 
diff --git a/test-suite/standalone/test-pthread-create.c 
b/test-suite/standalone/test-pthread-create.c
index cf3771f..ef3e80b 100644
--- a/test-suite/standalone/test-pthread-create.c
+++ b/test-suite/standalone/test-pthread-create.c
@@ -38,7 +38,7 @@ do_something (void *arg)
 static void *
 thread (void *arg)
 {
-  scm_with_guile (do_something, NULL);
+  scm_with_guile (do_something, NULL, NULL);
   return NULL;
 }
 
@@ -63,7 +63,7 @@ inner_main (void *data)
 int
 main (int argc, char *argv[])
 {
-  scm_with_guile (inner_main, NULL);
+  scm_with_guile (inner_main, NULL, NULL);
 
   return EXIT_SUCCESS;
 }
diff --git a/test-suite/standalone/test-scm-c-read.c 
b/test-suite/standalone/test-scm-c-read.c
index 4111cd0..745ed86 100644
--- a/test-suite/standalone/test-scm-c-read.c
+++ b/test-suite/standalone/test-scm-c-read.c
@@ -125,7 +125,7 @@ do_start (void *arg)
 int
 main (int argc, char *argv[])
 {
-  scm_with_guile (do_start, NULL);
+  scm_with_guile (do_start, NULL, NULL);
 
   return 0;
 }
diff --git a/test-suite/standalone/test-scm-spawn-thread.c 
b/test-suite/standalone/test-scm-spawn-thread.c
index f6d561a..51ea164 100644
--- a/test-suite/standalone/test-scm-spawn-thread.c
+++ b/test-suite/standalone/test-scm-spawn-thread.c
@@ -57,6 +57,6 @@ main (int argc, char **argv)
 {
   SCM result;
 
-  result = PTR2SCM (scm_with_guile (inner_main, 0));
+  result = PTR2SCM (scm_with_guile (inner_main, 0, NULL));
   return scm_is_true (result) ? EXIT_SUCCESS : EXIT_FAILURE;
 }
diff --git a/test-suite/standalone/test-scm-take-locale-symbol.c 
b/test-suite/standalone/test-scm-take-locale-symbol.c
index 808068f..379e180 100644
--- a/test-suite/standalone/test-scm-take-locale-symbol.c
+++ b/test-suite/standalone/test-scm-take-locale-symbol.c
@@ -58,7 +58,7 @@ main (int argc, char *argv[])
 {
   int result;
 
-  scm_with_guile (do_test, &result);
+  scm_with_guile (do_test, &result, NULL);
 
   return result;
 }
diff --git a/test-suite/standalone/test-scm-take-u8vector.c 
b/test-suite/standalone/test-scm-take-u8vector.c
index fff3af4..1b2211e 100644
--- a/test-suite/standalone/test-scm-take-u8vector.c
+++ b/test-suite/standalone/test-scm-take-u8vector.c
@@ -59,7 +59,7 @@ main (int argc, char *argv[])
 {
   int result;
 
-  scm_with_guile (do_test, &result);
+  scm_with_guile (do_test, &result, NULL);
 
   return result;
 }
diff --git a/test-suite/standalone/test-scm-with-guile.c 
b/test-suite/standalone/test-scm-with-guile.c
index a78458e..7612a2f 100644
--- a/test-suite/standalone/test-scm-with-guile.c
+++ b/test-suite/standalone/test-scm-with-guile.c
@@ -49,7 +49,7 @@ go_deeper_into_the_stack (unsigned level)
   if (level > 0)
     go_deeper_into_the_stack (level - 1);
   else
-    scm_with_guile (entry_point, NULL);
+    scm_with_guile (entry_point, NULL, NULL);
 }
 
 
@@ -61,7 +61,7 @@ main (int argc, char *argv[])
 
   /* Invoke it from much higher into the stack.  This time, Guile is expected
      to update the `base' field of the current thread.  */
-  scm_with_guile (entry_point, NULL);
+  scm_with_guile (entry_point, NULL, NULL);
 
   return 0;
 }
diff --git a/test-suite/standalone/test-with-guile-module.c 
b/test-suite/standalone/test-with-guile-module.c
index 4e22ff5..9110827 100644
--- a/test-suite/standalone/test-with-guile-module.c
+++ b/test-suite/standalone/test-with-guile-module.c
@@ -47,7 +47,7 @@ thread_inner_main (void *unused)
 void *
 thread_main (void *unused)
 {
-  scm_with_guile (&thread_inner_main, NULL);
+  scm_with_guile (&thread_inner_main, NULL, NULL);
 
   return NULL;                 /* dummy */
 }
@@ -76,7 +76,7 @@ inner_main (void *unused)
 int
 main (int argc, char **argv)
 {
-  scm_with_guile (&inner_main, NULL);
+  scm_with_guile (&inner_main, NULL, NULL);
 
   return 0;
 }
-- 
1.8.1.2