Merge remote-tracking branch 'local-2.0/stable-2.0'

[bpt/guile.git] / libguile / threads.c

diff --git a/libguile/threads.c b/libguile/threads.c
index 4de8193..9a93920 100644 (file)
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -39,6 +39,8 @@
 #endif
 
 #include <assert.h>
+#include <fcntl.h>
+#include <nproc.h>
 
 #include "libguile/validate.h"
 #include "libguile/root.h"
@@ -56,15 +58,6 @@
 #include "libguile/strings.h"
 #include "libguile/weaks.h"
 
-#ifdef __MINGW32__
-#ifndef ETIMEDOUT
-# define ETIMEDOUT       WSAETIMEDOUT
-#endif
-# include <fcntl.h>
-# include <process.h>
-# define pipe(fd) _pipe (fd, 256, O_BINARY)
-#endif /* __MINGW32__ */
-
 #include <full-read.h>
 
 
@@ -483,6 +476,24 @@ static int thread_count;
 
 static SCM scm_i_default_dynamic_state;
 
+/* Run when a fluid is collected.  */
+void
+scm_i_reset_fluid (size_t n, SCM val)
+{
+  scm_i_thread *t;
+
+  scm_i_pthread_mutex_lock (&thread_admin_mutex);
+  for (t = all_threads; t; t = t->next_thread)
+    if (SCM_I_DYNAMIC_STATE_P (t->dynamic_state))
+      {
+        SCM v = SCM_I_DYNAMIC_STATE_FLUIDS (t->dynamic_state);
+          
+        if (n < SCM_SIMPLE_VECTOR_LENGTH (v))
+          SCM_SIMPLE_VECTOR_SET (v, n, val);
+      }
+  scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+}
+
 /* Perform first stage of thread initialisation, in non-guile mode.
  */
 static void
@@ -519,7 +530,7 @@ guilify_self_1 (struct GC_stack_base *base)
   t.sleep_object = SCM_BOOL_F;
   t.sleep_fd = -1;
 
-  if (pipe (t.sleep_pipe) != 0)
+  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'.  */
@@ -606,6 +617,13 @@ typedef struct {
 #define SCM_MUTEXP(x)         SCM_SMOB_PREDICATE (scm_tc16_mutex, x)
 #define SCM_MUTEX_DATA(x)     ((fat_mutex *) SCM_SMOB_DATA (x))
 
+static SCM
+call_cleanup (void *data)
+{
+  SCM *proc_p = data;
+  return scm_call_0 (*proc_p);
+}
+  
 /* Perform thread tear-down, in guile mode.
  */
 static void *
@@ -623,7 +641,7 @@ do_thread_exit (void *v)
 
       t->cleanup_handler = SCM_BOOL_F;
       t->result = scm_internal_catch (SCM_BOOL_T,
-                                     (scm_t_catch_body) scm_call_0, ptr,
+                                     call_cleanup, &ptr,
                                      scm_handle_by_message_noexit, NULL);
     }
 
@@ -813,7 +831,7 @@ scm_init_guile ()
   else
     {
       fprintf (stderr, "Failed to get stack base for current thread.\n");
-      exit (1);
+      exit (EXIT_FAILURE);
     }
 }
 
@@ -1448,12 +1466,24 @@ SCM_DEFINE (scm_lock_mutex_timed, "lock-mutex", 1, 2, 0,
 }
 #undef FUNC_NAME
 
+static void
+lock_mutex_return_void (SCM mx)
+{
+  (void) scm_lock_mutex (mx);
+}
+
+static void
+unlock_mutex_return_void (SCM mx)
+{
+  (void) scm_unlock_mutex (mx);
+}
+
 void
 scm_dynwind_lock_mutex (SCM mutex)
 {
-  scm_dynwind_unwind_handler_with_scm ((void(*)(SCM))scm_unlock_mutex, mutex,
+  scm_dynwind_unwind_handler_with_scm (unlock_mutex_return_void, mutex,
                                       SCM_F_WIND_EXPLICITLY);
-  scm_dynwind_rewind_handler_with_scm ((void(*)(SCM))scm_lock_mutex, mutex,
+  scm_dynwind_rewind_handler_with_scm (lock_mutex_return_void, mutex,
                                       SCM_F_WIND_EXPLICITLY);
 }
 
@@ -1567,7 +1597,7 @@ fat_mutex_unlock (SCM mutex, SCM cond,
            }
 
          t->block_asyncs--;
-         scm_async_click ();
+         scm_async_tick ();
 
          scm_remember_upto_here_2 (cond, mutex);
 
@@ -2010,6 +2040,39 @@ scm_c_thread_exited_p (SCM thread)
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_total_processor_count, "total-processor-count", 0, 0, 0,
+           (void),
+           "Return the total number of processors of the machine, which\n"
+           "is guaranteed to be at least 1.  A ``processor'' here is a\n"
+           "thread execution unit, which can be either:\n\n"
+           "@itemize\n"
+           "@item an execution core in a (possibly multi-core) chip, in a\n"
+           "  (possibly multi- chip) module, in a single computer, or\n"
+           "@item a thread execution unit inside a core in the case of\n"
+           "  @dfn{hyper-threaded} CPUs.\n"
+           "@end itemize\n\n"
+           "Which of the two definitions is used, is unspecified.\n")
+#define FUNC_NAME s_scm_total_processor_count
+{
+  return scm_from_ulong (num_processors (NPROC_ALL));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_current_processor_count, "current-processor-count", 0, 0, 0,
+           (void),
+           "Like @code{total-processor-count}, but return the number of\n"
+           "processors available to the current process.  See\n"
+           "@code{setaffinity} and @code{getaffinity} for more\n"
+           "information.\n")
+#define FUNC_NAME s_scm_current_processor_count
+{
+  return scm_from_ulong (num_processors (NPROC_CURRENT));
+}
+#undef FUNC_NAME
+
+
+\f
+
 static scm_i_pthread_cond_t wake_up_cond;
 static int threads_initialized_p = 0;