Placate a number of `syntax-check' verifications.

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

diff --git a/libguile/threads.c b/libguile/threads.c
index 0c6b8b4..ad8720b 100644 (file)
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -1,4 +1,6 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004,
+ *   2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
+ *   Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -25,6 +27,7 @@
 #include "libguile/bdw-gc.h"
 #include "libguile/_scm.h"
 
+#include <stdlib.h>
 #if HAVE_UNISTD_H
 #include <unistd.h>
 #endif
@@ -38,6 +41,10 @@
 #include <sys/time.h>
 #endif
 
+#if HAVE_PTHREAD_NP_H
+# include <pthread_np.h>
+#endif
+
 #include <assert.h>
 #include <fcntl.h>
 #include <nproc.h>
@@ -141,6 +148,29 @@ get_thread_stack_base ()
   return pthread_get_stackaddr_np (pthread_self ());
 }
 
+#elif HAVE_PTHREAD_ATTR_GET_NP
+/* This one is for FreeBSD 9.  */
+static void *
+get_thread_stack_base ()
+{
+  pthread_attr_t attr;
+  void *start, *end;
+  size_t size;
+
+  pthread_attr_init (&attr);
+  pthread_attr_get_np (pthread_self (), &attr);
+  pthread_attr_getstack (&attr, &start, &size);
+  pthread_attr_destroy (&attr);
+
+  end = (char *)start + size;
+
+#if SCM_STACK_GROWS_UP
+  return start;
+#else
+  return end;
+#endif
+}
+
 #else 
 #error Threads enabled with old BDW-GC, but missing get_thread_stack_base impl.  Please upgrade to libgc >= 7.1.
 #endif
@@ -478,7 +508,7 @@ 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_reset_fluid (size_t n)
 {
   scm_i_thread *t;
 
@@ -489,7 +519,7 @@ scm_i_reset_fluid (size_t n, SCM val)
         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_SIMPLE_VECTOR_SET (v, n, SCM_UNDEFINED);
       }
   scm_i_pthread_mutex_unlock (&thread_admin_mutex);
 }
@@ -835,7 +865,7 @@ scm_init_guile ()
   else
     {
       fprintf (stderr, "Failed to get stack base for current thread.\n");
-      exit (1);
+      exit (EXIT_FAILURE);
     }
 }
 
@@ -1006,6 +1036,7 @@ SCM_DEFINE (scm_call_with_new_thread, "call-with-new-thread", 1, 1, 0,
   SCM_ASSERT (SCM_UNBNDP (handler) || scm_is_true (scm_procedure_p (handler)),
              handler, SCM_ARG2, FUNC_NAME);
 
+  GC_collect_a_little ();
   data.parent = scm_current_dynamic_state ();
   data.thunk = thunk;
   data.handler = handler;
@@ -1370,7 +1401,9 @@ fat_mutex_lock (SCM mutex, scm_t_timespec *timeout, SCM owner, int *ret)
            {
              scm_i_thread *t = SCM_I_THREAD_DATA (new_owner);
 
-             scm_i_pthread_mutex_unlock (&m->lock);
+             /* FIXME: The order in which `t->admin_mutex' and
+                `m->lock' are taken differs from that in
+                `on_thread_exit', potentially leading to deadlocks.  */
              scm_i_pthread_mutex_lock (&t->admin_mutex);
 
              /* Only keep a weak reference to MUTEX so that it's not
@@ -1381,7 +1414,6 @@ fat_mutex_lock (SCM mutex, scm_t_timespec *timeout, SCM owner, int *ret)
              t->mutexes = scm_weak_car_pair (mutex, t->mutexes);
 
              scm_i_pthread_mutex_unlock (&t->admin_mutex);
-             scm_i_pthread_mutex_lock (&m->lock);
            }
          *ret = 1;
          break;
@@ -1460,6 +1492,9 @@ SCM_DEFINE (scm_lock_mutex_timed, "lock-mutex", 1, 2, 0,
       waittime = &cwaittime;
     }
 
+  if (!SCM_UNBNDP (owner) && !scm_is_false (owner))
+    SCM_VALIDATE_THREAD (3, owner);
+
   exception = fat_mutex_lock (m, waittime, owner, &ret);
   if (!scm_is_false (exception))
     scm_ithrow (SCM_CAR (exception), scm_list_1 (SCM_CDR (exception)), 1);
@@ -2196,6 +2231,21 @@ scm_ia64_ar_bsp (const void *opaque)
   return (void *) ctx->uc_mcontext.sc_ar_bsp;
 }
 # endif /* linux */
+# ifdef __FreeBSD__
+#  include <ucontext.h>
+void *
+scm_ia64_register_backing_store_base (void)
+{
+  return (void *)0x8000000000000000;
+}
+void *
+scm_ia64_ar_bsp (const void *opaque)
+{
+  const ucontext_t *ctx = opaque;
+  return (void *)(ctx->uc_mcontext.mc_special.bspstore
+                  + ctx->uc_mcontext.mc_special.ndirty);
+}
+# endif /* __FreeBSD__ */
 #endif /* __ia64__ */