mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00
Code Activity

scm_with_guile calls GC_call_with_gc_active

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2011-01-22 19:55:31 +01:00
parent 6d6b2d4fcd
commit cde24ce12b
3 changed files with 134 additions and 90 deletions
Download patch file Download diff file Expand all files Collapse all files

7
configure.ac
View file

@ -1235,8 +1235,11 @@ save_LIBS="$LIBS"
LIBS="$BDW_GC_LIBS $LIBS" LIBS="$BDW_GC_LIBS $LIBS"
CFLAGS="$BDW_GC_CFLAGS $CFLAGS" CFLAGS="$BDW_GC_CFLAGS $CFLAGS"
# `GC_do_blocking ()' is available in GC 7.1 but not declared. AC_CHECK_FUNCS([GC_do_blocking GC_call_with_gc_active])
AC_CHECK_FUNCS([GC_do_blocking])
# 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_CHECK_DECL([GC_do_blocking],
[AC_DEFINE([HAVE_DECL_GC_DO_BLOCKING], [1], [AC_DEFINE([HAVE_DECL_GC_DO_BLOCKING], [1],
[Define this if the `GC_do_blocking ()' function is declared])], [Define this if the `GC_do_blocking ()' function is declared])],

214
libguile/threads.c
View file

@ -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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -67,6 +67,58 @@
#include <full-read.h> #include <full-read.h>
/* 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 */
static void static void
to_timespec (SCM t, scm_t_timespec *waittime) 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 /* Perform any initializations necessary to make the current thread
into guile mode, initializing Guile itself, if necessary. known to Guile (via SCM_I_CURRENT_THREAD), initializing Guile itself,
if necessary.
BASE is the stack base to use with GC. BASE is the stack base to use with GC.
PARENT is the dynamic state to use as the parent, ot SCM_BOOL_F in PARENT is the dynamic state to use as the parent, ot SCM_BOOL_F in
which case the default dynamic state is used. 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 static int
scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM parent) scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM parent)
{ {
scm_i_thread *t;
#ifndef SCM_HAVE_THREAD_STORAGE_CLASS #ifndef SCM_HAVE_THREAD_STORAGE_CLASS
scm_i_pthread_once (&init_thread_key_once, init_thread_key); scm_i_pthread_once (&init_thread_key_once, init_thread_key);
#endif #endif
t = SCM_I_CURRENT_THREAD; if (SCM_I_CURRENT_THREAD)
if (t == NULL) {
/* 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 * 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)
{ {
void *res; 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); new_thread = scm_i_init_thread_for_guile (&base_item, parent);
if (really_entered) 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); scm_i_pthread_cleanup_push (scm_leave_guile_cleanup, NULL);
res = scm_c_with_continuation_barrier (func, data); res = scm_c_with_continuation_barrier (func, data);
scm_i_pthread_cleanup_pop (0); 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); {
struct with_guile_trampoline_args args;
args.func = func;
args.data = data;
/* 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.
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
t->guile_mode = 1;
res = with_gc_active (with_guile_trampoline, &args);
t->guile_mode = 0;
}
return res; return res;
} }
/*** 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;
SCM_I_CURRENT_THREAD->guile_mode = 0;
arg = (struct without_guile_arg *) closure;
arg->result = arg->function (arg->data);
SCM_I_CURRENT_THREAD->guile_mode = 1;
}
#endif /* HAVE_GC_DO_BLOCKING */
void * void *
scm_without_guile (void *(*func)(void *), void *data) scm_without_guile (void *(*func)(void *), void *data)
{ {
void *result; void *result;
scm_i_thread *t = SCM_I_CURRENT_THREAD;
#ifdef HAVE_GC_DO_BLOCKING if (t->guile_mode)
if (SCM_I_CURRENT_THREAD->guile_mode)
{ {
struct without_guile_arg arg; SCM_I_CURRENT_THREAD->guile_mode = 0;
result = with_gc_inactive (func, data);
arg.function = func; SCM_I_CURRENT_THREAD->guile_mode = 1;
arg.data = data;
GC_do_blocking ((GC_fn_type) without_guile_trampoline, &arg);
result = arg.result;
} }
else else
#endif /* Otherwise we're not in guile mode, so nothing to do. */
result = func (data); result = func (data);
return result; return result;

3
libguile/threads.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_THREADS_H #ifndef SCM_THREADS_H
#define 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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * 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. */ /* For keeping track of the stack and registers. */
SCM vm; SCM vm;
SCM_STACKITEM *base; SCM_STACKITEM *base;
SCM_STACKITEM *top;
scm_i_jmp_buf regs; scm_i_jmp_buf regs;
#ifdef __ia64__ #ifdef __ia64__
void *register_backing_store_base; void *register_backing_store_base;