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

Merge commit '2e77f7202b' into boehm-demers-weiser-gc

Browse source 
Conflicts:
	libguile/threads.c
This commit is contained in:
Ludovic Courtès 2008-09-10 22:51:46 +02:00
commit e0513d4d77
20 changed files with 1120 additions and 55 deletions
Download patch file Download diff file Expand all files Collapse all files

64
libguile/ChangeLog
View file

@ -1,3 +1,67 @@
2007-10-20 Julian Graham <joolean@gmail.com>
Add support for thread cancellation and user-defined thread
cleanup handlers. Small rework by Ludovic Courtès.
* null-threads.h (scm_i_pthread_cancel,
scm_i_pthread_cleanup_push, scm_i_pthread_cleanup_pop): New.
* pthread-threads.h (scm_i_pthread_cancel,
scm_i_pthread_cleanup_push, scm_i_pthread_cleanup_pop): New.
* scmsigs.c (scm_i_signal_delivery_thread,
signal_delivery_thread_mutex): New.
(signal_delivery_thread): Leave when `read_without_guile ()'
returns zero.
(start_signal_delivery_thread): Acquire SIGNAL_DELIVERY_THREAD
before spawning the thread. Initialize
SCM_I_SIGNAL_DELIVERY_THREAD.
(ensure_signal_delivery_thread): Renamed to...
(scm_i_ensure_signal_delivery_thread): this.
(scm_i_close_signal_pipe): New.
* scmsigs.h: Updated.
* threads.c (thread_mark): Mark `t->cleanup_handler'.
(guilify_self_1): Initialize `t->cleanup_handler' and
`t->canceled'.
(do_thread_exit): Invoke `t->cleanup_handler'.
(on_thread_exit): Call `scm_i_ensure_signal_delivery_thread ()'.
Call `scm_i_close_signal_pipe ()' when the next-to-last thread
vanishes.
(scm_leave_guile_cleanup): New.
(scm_i_with_guile_and_parent): Use `scm_i_pthread_cleanup_push ()'
and `scm_leave_guile_cleanup ()' to leave guile mode, rather
than call `scm_leave_guile ()' after FUNC.
(scm_cancel_thread, scm_set_thread_cleanup_x,
scm_threads_cleanup): New.
(scm_all_threads): Remove SCM_I_SIGNAL_DELIVERY_THREAD from the
returned list.
* threads.h (scm_i_thread)[cleanup_handler, canceled]: New
fields.
Add declarations of new functions.
2007-10-17 Ludovic Courtès <ludo@gnu.org>
* read.c (CHAR_IS_BLANK_): Add `\r' (ASCII 0x0d). This fixes a
regression compared to 1.8.2. Reported by Puneet
<schemer@gmail.com>.
2007-10-10 Ludovic Courtès <ludo@gnu.org>
* pthread-threads.h (SCM_I_PTHREAD_MUTEX_INITIALIZER): Check
`SCM_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER'.
* gen-scmconfig.h.in
(SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER): New.
* gen-scmconfig.c (main): Define
`SCM_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER'.
2007-10-04 Ludovic Courtès <ludo@gnu.org>
* i18n.c (scm_make_locale)[!USE_GNU_LOCALE_API]: Don't call
`leave_locale_section ()' on failure of
`enter_locale_section ()' since the mutex is not held and locale
settings are unchanged.
(scm_nl_langinfo)[!USE_GNU_LOCALE_API]: Use
`restore_locale_settings ()' instead of `leave_locale_section ()'
since the mutex is not held.
2007-10-02 Ludovic Courtès <ludo@gnu.org>
* threads.c (on_thread_exit): Don't call `scm_leave_guile ()'

5
libguile/gen-scmconfig.c
View file

@ -382,6 +382,11 @@ main (int argc, char *argv[])
pf ("#define SCM_NEED_BRACES_ON_PTHREAD_ONCE_INIT %d /* 0 or 1 */\n",
SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT);
pf ("/* Define to 1 if need braces around PTHREAD_MUTEX_INITIALIZER\n"
" (for IRIX with GCC) */\n");
pf ("#define SCM_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER %d /* 0 or 1 */\n",
SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER);
#if USE_DLL_IMPORT
pf ("\n");
pf ("/* Define some additional CPP macros on Win32 platforms. */\n");

1
libguile/gen-scmconfig.h.in
View file

@ -29,6 +29,7 @@
#define SCM_I_GSC_USE_PTHREAD_THREADS @SCM_I_GSC_USE_PTHREAD_THREADS@
#define SCM_I_GSC_USE_NULL_THREADS @SCM_I_GSC_USE_NULL_THREADS@
#define SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT @SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT@
#define SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER @SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER@
/*
Local Variables:

8
libguile/i18n.c
View file

@ -685,12 +685,14 @@ SCM_DEFINE (scm_make_locale, "make-locale", 2, 1, 0,
scm_t_locale_settings prev_locale;
err = enter_locale_section (c_locale, &prev_locale);
leave_locale_section (&prev_locale);
if (err)
goto fail;
else
SCM_NEWSMOB (locale, scm_tc16_locale_smob_type, c_locale);
{
leave_locale_section (&prev_locale);
SCM_NEWSMOB (locale, scm_tc16_locale_smob_type, c_locale);
}
}
#endif
@ -1410,7 +1412,7 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
{
c_result = nl_langinfo (c_item);
leave_locale_section (&lsec_prev_locale);
restore_locale_settings (&lsec_prev_locale);
free_locale_settings (&lsec_prev_locale);
}
#endif

3
libguile/null-threads.h
View file

@ -41,6 +41,9 @@
#define scm_i_pthread_create(t,a,f,d) (*(t)=0, (void)(f), ENOSYS)
#define scm_i_pthread_detach(t) do { } while (0)
#define scm_i_pthread_exit(v) exit(0)
#define scm_i_pthread_cancel(t) 0
#define scm_i_pthread_cleanup_push(t,v) 0
#define scm_i_pthread_cleanup_pop(e) 0
#define scm_i_sched_yield() 0
/* Signals

9
libguile/pthread-threads.h
View file

@ -38,6 +38,9 @@
#define scm_i_pthread_create pthread_create
#define scm_i_pthread_detach pthread_detach
#define scm_i_pthread_exit pthread_exit
#define scm_i_pthread_cancel pthread_cancel
#define scm_i_pthread_cleanup_push pthread_cleanup_push
#define scm_i_pthread_cleanup_pop pthread_cleanup_pop
#define scm_i_sched_yield sched_yield
/* Signals
@ -46,7 +49,11 @@
/* Mutexes
*/
#define SCM_I_PTHREAD_MUTEX_INITIALIZER PTHREAD_MUTEX_INITIALIZER
#if SCM_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER
# define SCM_I_PTHREAD_MUTEX_INITIALIZER { PTHREAD_MUTEX_INITIALIZER }
#else
# define SCM_I_PTHREAD_MUTEX_INITIALIZER PTHREAD_MUTEX_INITIALIZER
#endif
#define scm_i_pthread_mutex_t pthread_mutex_t
#define scm_i_pthread_mutex_init pthread_mutex_init
#define scm_i_pthread_mutex_destroy pthread_mutex_destroy

7
libguile/read.c
View file

@ -150,7 +150,7 @@ static SCM *scm_read_hash_procedures;
/* `isblank' is only in C99. */
#define CHAR_IS_BLANK_(_chr) \
(((_chr) == ' ') || ((_chr) == '\t') || ((_chr) == '\n') \
|| ((_chr) == '\f'))
|| ((_chr) == '\f') || ((_chr) == '\r'))
#ifdef MSDOS
# define CHAR_IS_BLANK(_chr) \
@ -182,9 +182,8 @@ static SCM *scm_read_hash_procedures;
/* Read an SCSH block comment. */
static inline SCM scm_read_scsh_block_comment (int chr, SCM port);
/* Helper function similar to `scm_read_token ()'. Read from PORT until a
whitespace is read. Return zero if the whole token could fit in BUF,
non-zero otherwise. */
/* Read from PORT until a delimiter (e.g., a whitespace) is read. Return
zero if the whole token fits in BUF, non-zero otherwise. */
static inline int
read_token (SCM port, char *buf, size_t buf_size, size_t *read)
{

50
libguile/scmsigs.c
View file

@ -33,6 +33,7 @@
#include "libguile/eval.h"
#include "libguile/root.h"
#include "libguile/vectors.h"
#include "libguile/threads.h"
#include "libguile/validate.h"
#include "libguile/scmsigs.h"
@ -99,6 +100,14 @@ static SCM *signal_handlers;
static SCM signal_handler_asyncs;
static SCM signal_handler_threads;
/* The signal delivery thread. */
scm_i_thread *scm_i_signal_delivery_thread = NULL;
/* The mutex held when launching the signal delivery thread. */
static scm_i_pthread_mutex_t signal_delivery_thread_mutex =
SCM_I_PTHREAD_MUTEX_INITIALIZER;
/* saves the original C handlers, when a new handler is installed.
set to SIG_ERR if the original handler is installed. */
#ifdef HAVE_SIGACTION
@ -185,24 +194,34 @@ signal_delivery_thread (void *data)
if (scm_is_true (h))
scm_system_async_mark_for_thread (h, t);
}
else if (n == 0)
break; /* the signal pipe was closed. */
else if (n < 0 && errno != EINTR)
perror ("error in signal delivery thread");
}
return SCM_UNSPECIFIED; /* not reached */
return SCM_UNSPECIFIED; /* not reached unless all other threads exited */
}
static void
start_signal_delivery_thread (void)
{
SCM signal_thread;
scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex);
if (pipe (signal_pipe) != 0)
scm_syserror (NULL);
scm_spawn_thread (signal_delivery_thread, NULL,
scm_handle_by_message, "signal delivery thread");
signal_thread = scm_spawn_thread (signal_delivery_thread, NULL,
scm_handle_by_message,
"signal delivery thread");
scm_i_signal_delivery_thread = SCM_I_THREAD_DATA (signal_thread);
scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex);
}
static void
ensure_signal_delivery_thread ()
void
scm_i_ensure_signal_delivery_thread ()
{
static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
scm_i_pthread_once (&once, start_signal_delivery_thread);
@ -228,8 +247,8 @@ take_signal (int signum)
#endif
}
static void
ensure_signal_delivery_thread ()
void
scm_i_ensure_signal_delivery_thread ()
{
return;
}
@ -332,7 +351,7 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
SCM_MISC_ERROR ("thread has already exited", SCM_EOL);
}
ensure_signal_delivery_thread ();
scm_i_ensure_signal_delivery_thread ();
SCM_CRITICAL_SECTION_START;
old_handler = SCM_SIMPLE_VECTOR_REF (*signal_handlers, csig);
@ -652,6 +671,21 @@ SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
void
scm_i_close_signal_pipe()
{
/* SIGNAL_DELIVERY_THREAD_MUTEX is only locked while the signal delivery
thread is being launched. The thread that calls this function is
already holding the thread admin mutex, so if the delivery thread hasn't
been launched at this point, it never will be before shutdown. */
scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex);
if (scm_i_signal_delivery_thread != NULL)
close (signal_pipe[1]);
scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex);
}
void
scm_init_scmsigs ()
{

8
libguile/scmsigs.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_SCMSIGS_H
#define SCM_SCMSIGS_H
/* Copyright (C) 1995,1996,1997,1998,2000, 2002, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,2000, 2002, 2006, 2007 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
@ -23,6 +23,7 @@
#include "libguile/__scm.h"
#include "libguile/threads.h"
@ -41,6 +42,11 @@ SCM_API SCM scm_usleep (SCM i);
SCM_API SCM scm_raise (SCM sig);
SCM_API void scm_init_scmsigs (void);
SCM_API void scm_i_close_signal_pipe (void);
SCM_API void scm_i_ensure_signal_delivery_thread (void);
SCM_API scm_i_thread *scm_i_signal_delivery_thread;
#endif /* SCM_SCMSIGS_H */
/*

133
libguile/threads.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007 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
@ -49,6 +49,7 @@
#include "libguile/continuations.h"
#include "libguile/gc.h"
#include "libguile/init.h"
#include "libguile/scmsigs.h"
#ifdef __MINGW32__
#ifndef ETIMEDOUT
@ -405,6 +406,7 @@ guilify_self_1 (SCM_STACKITEM *base)
t->pthread = scm_i_pthread_self ();
t->handle = SCM_BOOL_F;
t->result = SCM_BOOL_F;
t->cleanup_handler = SCM_BOOL_F;
t->join_queue = SCM_EOL;
t->dynamic_state = SCM_BOOL_F;
t->dynwinds = SCM_EOL;
@ -426,6 +428,7 @@ guilify_self_1 (SCM_STACKITEM *base)
t->gc_running_p = 0;
t->current_mark_stack_ptr = NULL;
t->current_mark_stack_limit = NULL;
t->canceled = 0;
t->exited = 0;
t->freelist = SCM_EOL;
@ -470,7 +473,17 @@ guilify_self_2 (SCM parent)
static void *
do_thread_exit (void *v)
{
scm_i_thread *t = (scm_i_thread *)v;
scm_i_thread *t = (scm_i_thread *) v;
if (!scm_is_false (t->cleanup_handler))
{
SCM ptr = t->cleanup_handler;
t->cleanup_handler = SCM_BOOL_F;
t->result = scm_internal_catch (SCM_BOOL_T,
(scm_t_catch_body) scm_call_0, ptr,
scm_handle_by_message_noexit, NULL);
}
scm_i_scm_pthread_mutex_lock (&thread_admin_mutex);
@ -481,6 +494,7 @@ do_thread_exit (void *v)
;
scm_i_pthread_mutex_unlock (&thread_admin_mutex);
return NULL;
}
@ -488,10 +502,14 @@ static void
on_thread_exit (void *v)
{
/* This handler is executed in non-guile mode. */
scm_i_thread *t = (scm_i_thread *)v, **tp;
scm_i_thread *t = (scm_i_thread *) v, **tp;
scm_i_pthread_setspecific (scm_i_thread_key, v);
/* Ensure the signal handling thread has been launched, because we might be
shutting it down. */
scm_i_ensure_signal_delivery_thread ();
/* Unblocking the joining threads needs to happen in guile mode
since the queue is a SCM data structure. */
scm_with_guile (do_thread_exit, v);
@ -507,6 +525,14 @@ on_thread_exit (void *v)
break;
}
thread_count--;
/* If there's only one other thread, it could be the signal delivery
thread, so we need to notify it to shut down by closing its read pipe.
If it's not the signal delivery thread, then closing the read pipe isn't
going to hurt. */
if (thread_count <= 1)
scm_i_close_signal_pipe ();
scm_i_pthread_mutex_unlock (&thread_admin_mutex);
scm_i_pthread_setspecific (scm_i_thread_key, NULL);
@ -676,17 +702,30 @@ scm_with_guile (void *(*func)(void *), void *data)
scm_i_default_dynamic_state);
}
static void
scm_leave_guile_cleanup (void *x)
{
scm_leave_guile ();
}
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;
int really_entered;
SCM_STACKITEM base_item;
really_entered = scm_i_init_thread_for_guile (&base_item, parent);
res = scm_c_with_continuation_barrier (func, data);
if (really_entered)
scm_leave_guile ();
{
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_leave_guile ();
}
else
res = scm_c_with_continuation_barrier (func, data);
return res;
}
@ -872,6 +911,74 @@ SCM_DEFINE (scm_yield, "yield", 0, 0, 0,
}
#undef FUNC_NAME
SCM_DEFINE (scm_cancel_thread, "cancel-thread", 1, 0, 0,
(SCM thread),
"Asynchronously force the target @var{thread} to terminate. @var{thread} "
"cannot be the current thread, and if @var{thread} has already terminated or "
"been signaled to terminate, this function is a no-op.")
#define FUNC_NAME s_scm_cancel_thread
{
scm_i_thread *t = NULL;
SCM_VALIDATE_THREAD (1, thread);
t = SCM_I_THREAD_DATA (thread);
scm_i_scm_pthread_mutex_lock (&thread_admin_mutex);
if (!t->canceled)
{
t->canceled = 1;
scm_i_pthread_mutex_unlock (&thread_admin_mutex);
scm_i_pthread_cancel (t->pthread);
}
else
scm_i_pthread_mutex_unlock (&thread_admin_mutex);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
SCM_DEFINE (scm_set_thread_cleanup_x, "set-thread-cleanup!", 2, 0, 0,
(SCM thread, SCM proc),
"Set the thunk @var{proc} as the cleanup handler for the thread @var{thread}. "
"This handler will be called when the thread exits.")
#define FUNC_NAME s_scm_set_thread_cleanup_x
{
scm_i_thread *t;
SCM_VALIDATE_THREAD (1, thread);
if (!scm_is_false (proc))
SCM_VALIDATE_THUNK (2, proc);
scm_i_pthread_mutex_lock (&thread_admin_mutex);
t = SCM_I_THREAD_DATA (thread);
if (!(t->exited || t->canceled))
t->cleanup_handler = proc;
scm_i_pthread_mutex_unlock (&thread_admin_mutex);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
SCM_DEFINE (scm_thread_cleanup, "thread-cleanup", 1, 0, 0,
(SCM thread),
"Return the cleanup handler installed for the thread @var{thread}.")
#define FUNC_NAME s_scm_thread_cleanup
{
scm_i_thread *t;
SCM ret;
SCM_VALIDATE_THREAD (1, thread);
scm_i_pthread_mutex_lock (&thread_admin_mutex);
t = SCM_I_THREAD_DATA (thread);
ret = (t->exited || t->canceled) ? SCM_BOOL_F : t->cleanup_handler;
scm_i_pthread_mutex_unlock (&thread_admin_mutex);
return ret;
}
#undef FUNC_NAME
SCM_DEFINE (scm_join_thread, "join-thread", 1, 0, 0,
(SCM thread),
"Suspend execution of the calling thread until the target @var{thread} "
@ -883,7 +990,7 @@ SCM_DEFINE (scm_join_thread, "join-thread", 1, 0, 0,
SCM_VALIDATE_THREAD (1, thread);
if (scm_is_eq (scm_current_thread (), thread))
SCM_MISC_ERROR ("can not join the current thread", SCM_EOL);
SCM_MISC_ERROR ("cannot join the current thread", SCM_EOL);
scm_i_scm_pthread_mutex_lock (&thread_admin_mutex);
@ -903,10 +1010,13 @@ SCM_DEFINE (scm_join_thread, "join-thread", 1, 0, 0,
res = t->result;
scm_i_pthread_mutex_unlock (&thread_admin_mutex);
return res;
}
#undef FUNC_NAME
/*** Fat mutexes */
/* We implement our own mutex type since we want them to be 'fair', we
@ -1492,8 +1602,11 @@ SCM_DEFINE (scm_all_threads, "all-threads", 0, 0, 0,
l = &list;
for (t = all_threads; t && n > 0; t = t->next_thread)
{
SCM_SETCAR (*l, t->handle);
l = SCM_CDRLOC (*l);
if (t != scm_i_signal_delivery_thread)
{
SCM_SETCAR (*l, t->handle);
l = SCM_CDRLOC (*l);
}
n--;
}
*l = SCM_EOL;

9
libguile/threads.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_THREADS_H
#define SCM_THREADS_H
/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2007 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
@ -49,9 +49,11 @@ typedef struct scm_i_thread {
SCM handle;
scm_i_pthread_t pthread;
SCM cleanup_handler;
SCM join_queue;
SCM result;
int canceled;
int exited;
SCM sleep_object;
@ -158,6 +160,9 @@ do { \
SCM_API SCM scm_call_with_new_thread (SCM thunk, SCM handler);
SCM_API SCM scm_yield (void);
SCM_API SCM scm_cancel_thread (SCM t);
SCM_API SCM scm_set_thread_cleanup_x (SCM thread, SCM proc);
SCM_API SCM scm_thread_cleanup (SCM thread);
SCM_API SCM scm_join_thread (SCM t);
SCM_API SCM scm_make_mutex (void);