scm_with_guile calls GC_call_with_gc_active

* configure.ac: Check for GC_call_with_gc_active.

* libguile/threads.h (scm_i_thread): Remove "top", as it's not used.

* libguile/threads.c (with_gc_inactive, with_gc_active): Define shims to
  GC_do_blocking and GC_call_with_gc_active.
  (scm_i_init_thread_for_guile): Don't do thread base adjustment here,
  do it in scm_i_with_guile_and_parent.  The previous logic would never
  be run.
  (scm_i_with_guile_and_parent): If we enter Guile mode, leave it too.
  Take care of adjusting the thread stack base here too.  Also, call
  with_gc_active.
  (scm_without_guile): Refactor.

diff --git a/configure.ac b/configure.ac
index 1aa6f05..5c70aa8 100644 (file)
--- a/configure.ac
+++ b/configure.ac
@@ -1235,8 +1235,11 @@ save_LIBS="$LIBS"
 LIBS="$BDW_GC_LIBS $LIBS"
 CFLAGS="$BDW_GC_CFLAGS $CFLAGS"
 
 LIBS="$BDW_GC_LIBS $LIBS"
 CFLAGS="$BDW_GC_CFLAGS $CFLAGS"
 

-# `GC_do_blocking ()' is available in GC 7.1 but not declared.
-AC_CHECK_FUNCS([GC_do_blocking])
+AC_CHECK_FUNCS([GC_do_blocking GC_call_with_gc_active])
+
+# Though the `GC_do_blocking ()' symbol is present in GC 7.1, it is not
+# declared, and has a different type (returning void instead of
+# void*).

 AC_CHECK_DECL([GC_do_blocking],
   [AC_DEFINE([HAVE_DECL_GC_DO_BLOCKING], [1],
     [Define this if the `GC_do_blocking ()' function is declared])],
 AC_CHECK_DECL([GC_do_blocking],
   [AC_DEFINE([HAVE_DECL_GC_DO_BLOCKING], [1],
     [Define this if the `GC_do_blocking ()' function is declared])],

diff --git a/libguile/threads.c b/libguile/threads.c
index 6bc53a8..e7347ad 100644 (file)
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 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
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License


@@ -67,6 +67,58 @@
 
 #include <full-read.h>
 
 
 #include <full-read.h>
 

+
+\f
+
+/* First some libgc shims. */
+
+/* Make sure GC_fn_type is defined; it is missing from the public
+   headers of GC 7.1 and earlier.  */
+#ifndef HAVE_GC_FN_TYPE
+typedef void * (* GC_fn_type) (void *);
+#endif
+
+
+/* Now define with_gc_active and with_gc_inactive.  */
+
+#if (defined(HAVE_GC_DO_BLOCKING) && defined (HAVE_DECL_GC_DO_BLOCKING) && defined (HAVE_GC_CALL_WITH_GC_ACTIVE))
+
+/* We have a sufficiently new libgc (7.2 or newer).  */
+
+static void*
+with_gc_inactive (GC_fn_type func, void *data)
+{
+  return GC_do_blocking (func, data);
+}
+
+static void*
+with_gc_active (GC_fn_type func, void *data)
+{
+  return GC_call_with_gc_active (func, data);
+}
+
+#else
+
+/* libgc not new enough, so never actually deactivate GC.
+
+   Note that though GC 7.1 does have a GC_do_blocking, it doesn't have
+   GC_call_with_gc_active.  */
+
+static void*
+with_gc_inactive (GC_fn_type func, void *data)
+{
+  return func (data);
+}
+
+static void*
+with_gc_active (GC_fn_type func, void *data)
+{
+  return func (data);
+}
+
+#endif /* HAVE_GC_DO_BLOCKING */
+
+

 \f
 static void
 to_timespec (SCM t, scm_t_timespec *waittime)
 \f
 static void
 to_timespec (SCM t, scm_t_timespec *waittime)


@@ -553,29 +605,37 @@ init_thread_key (void)
 
 #endif
 
 
 #endif
 

-/* Perform any initializations necessary to bring the current thread
-   into guile mode, initializing Guile itself, if necessary.
+/* Perform any initializations necessary to make the current thread
+   known to Guile (via SCM_I_CURRENT_THREAD), initializing Guile itself,
+   if necessary.

 
    BASE is the stack base to use with GC.
 
    PARENT is the dynamic state to use as the parent, ot SCM_BOOL_F in
    which case the default dynamic state is used.
 
 
    BASE is the stack base to use with GC.
 
    PARENT is the dynamic state to use as the parent, ot SCM_BOOL_F in
    which case the default dynamic state is used.
 

-   Return zero when the thread was in guile mode already; otherwise
+   Returns zero when the thread was known to guile already; otherwise

    return 1.
    return 1.

-*/
+
+   Note that it could be the case that the thread was known
+   to Guile, but not in guile mode (because we are within a
+   scm_without_guile call).   Check SCM_I_CURRENT_THREAD->guile_mode to
+   be sure.  New threads are put into guile mode implicitly.  */

 
 static int
 scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM parent)
 {
 
 static int
 scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM parent)
 {

-  scm_i_thread *t;
-

 #ifndef SCM_HAVE_THREAD_STORAGE_CLASS
   scm_i_pthread_once (&init_thread_key_once, init_thread_key);
 #endif
 
 #ifndef SCM_HAVE_THREAD_STORAGE_CLASS
   scm_i_pthread_once (&init_thread_key_once, init_thread_key);
 #endif
 

-  t = SCM_I_CURRENT_THREAD;
-  if (t == NULL)
+  if (SCM_I_CURRENT_THREAD)
+    {
+      /* Thread is already known to Guile.
+      */
+      return 0;
+    }
+  else

     {
       /* This thread has not been guilified yet.
        */
     {
       /* This thread has not been guilified yet.
        */


@@ -600,32 +660,6 @@ scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM parent)
        }
       return 1;
     }
        }
       return 1;
     }

-  else if (t->top)
-    {
-      /* This thread is already guilified but not in guile mode, just
-        resume it.
-
-         A user call to scm_with_guile() will lead us to here.  This could
-         happen from anywhere on the stack, and in particular lower on the
-         stack than when it was when this thread was first guilified.  Thus,
-         `base' must be updated.  */
-#if SCM_STACK_GROWS_UP
-      if (base < t->base)
-         t->base = base;
-#else
-      if (base > t->base)
-         t->base = base;
-#endif
-
-      t->top = NULL;
-      return 1;
-    }
-  else
-    {
-      /* Thread is already in guile mode.  Nothing to do.
-      */
-      return 0;
-    }

 }
 
 #if SCM_USE_PTHREAD_THREADS
 }
 
 #if SCM_USE_PTHREAD_THREADS


@@ -727,81 +761,89 @@ scm_leave_guile_cleanup (void *x)
   on_thread_exit (SCM_I_CURRENT_THREAD);
 }
 
   on_thread_exit (SCM_I_CURRENT_THREAD);
 }
 

+struct with_guile_trampoline_args
+{
+  GC_fn_type func;
+  void *data;
+};
+
+static void *
+with_guile_trampoline (void *data)
+{
+  struct with_guile_trampoline_args *args = data;
+
+  return scm_c_with_continuation_barrier (args->func, args->data);
+}
+  

 void *
 scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent)
 {
   void *res;
 void *
 scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent)
 {
   void *res;

-  int really_entered;
+  int new_thread;
+  scm_i_thread *t;

   SCM_STACKITEM base_item;
 
   SCM_STACKITEM base_item;
 

-  really_entered = scm_i_init_thread_for_guile (&base_item, parent);
-  if (really_entered)
+  new_thread = scm_i_init_thread_for_guile (&base_item, parent);
+  t = SCM_I_CURRENT_THREAD;
+  if (new_thread)

     {
     {

+      /* We are in Guile mode.  */
+      assert (t->guile_mode);
+

       scm_i_pthread_cleanup_push (scm_leave_guile_cleanup, NULL);
       res = scm_c_with_continuation_barrier (func, data);
       scm_i_pthread_cleanup_pop (0);
       scm_i_pthread_cleanup_push (scm_leave_guile_cleanup, NULL);
       res = scm_c_with_continuation_barrier (func, data);
       scm_i_pthread_cleanup_pop (0);

+
+      /* Leave Guile mode.  */
+      t->guile_mode = 0;
+    }
+  else if (t->guile_mode)
+    {
+      /* Already in Guile mode.  */
+      res = scm_c_with_continuation_barrier (func, data);

     }
   else
     }
   else

-    res = scm_c_with_continuation_barrier (func, data);
-
-  return res;
-}
-
-\f
-/*** Non-guile mode.  */
-
-#ifdef HAVE_GC_DO_BLOCKING
-
-# ifndef HAVE_GC_FN_TYPE
-/* This typedef is missing from the public headers of GC 7.1 and earlier.  */
-typedef void * (* GC_fn_type) (void *);
-# endif /* HAVE_GC_FN_TYPE */
-
-# ifndef HAVE_DECL_GC_DO_BLOCKING
-/* This declaration is missing from the public headers of GC 7.1.  */
-extern void GC_do_blocking (GC_fn_type, void *);
-# endif /* HAVE_DECL_GC_DO_BLOCKING  */
-
-struct without_guile_arg
-{
-  void * (*function) (void *);
-  void    *data;
-  void    *result;
-};
-
-static void
-without_guile_trampoline (void *closure)
-{
-  struct without_guile_arg *arg;
+    {
+      struct with_guile_trampoline_args args;
+      args.func = func;
+      args.data = data;

 
 

-  SCM_I_CURRENT_THREAD->guile_mode = 0;
+      /* We are not in Guile mode, either because we are not within a
+         scm_with_guile, or because we are within a scm_without_guile.

 
 

-  arg = (struct without_guile_arg *) closure;
-  arg->result = arg->function (arg->data);
+         This call to scm_with_guile() could happen from anywhere on the
+         stack, and in particular lower on the stack than when it was
+         when this thread was first guilified.  Thus, `base' must be
+         updated.  */
+#if SCM_STACK_GROWS_UP
+      if (SCM_STACK_PTR (&base_item) < t->base)
+        t->base = SCM_STACK_PTR (&base_item);
+#else
+      if (SCM_STACK_PTR (&base_item) > t->base)
+        t->base = SCM_STACK_PTR (&base_item);
+#endif

 
 

-  SCM_I_CURRENT_THREAD->guile_mode = 1;
+      t->guile_mode = 1;
+      res = with_gc_active (with_guile_trampoline, &args);
+      t->guile_mode = 0;
+    }
+  return res;

 }
 
 }
 

-#endif /* HAVE_GC_DO_BLOCKING */
-
-

 void *
 scm_without_guile (void *(*func)(void *), void *data)
 {
   void *result;
 void *
 scm_without_guile (void *(*func)(void *), void *data)
 {
   void *result;

+  scm_i_thread *t = SCM_I_CURRENT_THREAD;

 
 

-#ifdef HAVE_GC_DO_BLOCKING
-  if (SCM_I_CURRENT_THREAD->guile_mode)
+  if (t->guile_mode)

     {
     {

-      struct without_guile_arg arg;
-
-      arg.function = func;
-      arg.data = data;
-      GC_do_blocking ((GC_fn_type) without_guile_trampoline, &arg);
-      result = arg.result;
+      SCM_I_CURRENT_THREAD->guile_mode = 0;
+      result = with_gc_inactive (func, data);
+      SCM_I_CURRENT_THREAD->guile_mode = 1;

     }
   else
     }
   else

-#endif
+    /* Otherwise we're not in guile mode, so nothing to do.  */

     result = func (data);
 
   return result;
     result = func (data);
 
   return result;

diff --git a/libguile/threads.h b/libguile/threads.h
index 4b06590..b5e3c21 100644 (file)
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -3,7 +3,7 @@
 #ifndef SCM_THREADS_H
 #define SCM_THREADS_H
 
 #ifndef SCM_THREADS_H
 #define SCM_THREADS_H
 

-/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009, 2011 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
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License


@@ -109,7 +109,6 @@ typedef struct scm_i_thread {
   /* For keeping track of the stack and registers. */
   SCM vm;
   SCM_STACKITEM *base;
   /* For keeping track of the stack and registers. */
   SCM vm;
   SCM_STACKITEM *base;

-  SCM_STACKITEM *top;

   scm_i_jmp_buf regs;
 #ifdef __ia64__
   void *register_backing_store_base;
   scm_i_jmp_buf regs;
 #ifdef __ia64__
   void *register_backing_store_base;