From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Julian Graham Newsgroups: gmane.lisp.guile.devel Subject: Re: hacking on 1.7 threads Date: Sat, 6 Nov 2004 23:30:42 -0500 Message-ID: <2bc5f821041106203019ca6229@mail.gmail.com> References: <2bc5f82104101906465a92d975@mail.gmail.com> <2bc5f821041023165523f40bc2@mail.gmail.com> <2bc5f821041030134527a81c92@mail.gmail.com> Reply-To: Julian Graham NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="----=_Part_518_970583.1099801842146" X-Trace: sea.gmane.org 1099801914 29208 80.91.229.6 (7 Nov 2004 04:31:54 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Sun, 7 Nov 2004 04:31:54 +0000 (UTC) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Sun Nov 07 05:31:44 2004 Return-path: Original-Received: from lists.gnu.org ([199.232.76.165]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1CQeiN-0002LW-00 for ; Sun, 07 Nov 2004 05:31:43 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.33) id 1CQeqe-00053O-Kl for guile-devel@m.gmane.org; Sat, 06 Nov 2004 23:40:16 -0500 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.33) id 1CQeqY-0004zZ-TV for guile-devel@gnu.org; Sat, 06 Nov 2004 23:40:11 -0500 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.33) id 1CQeqW-0004yP-Mx for guile-devel@gnu.org; Sat, 06 Nov 2004 23:40:10 -0500 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.33) id 1CQeqW-0004yF-HZ for guile-devel@gnu.org; Sat, 06 Nov 2004 23:40:08 -0500 Original-Received: from [64.233.184.193] (helo=wproxy.gmail.com) by monty-python.gnu.org with esmtp (Exim 4.34) id 1CQehn-0005HK-8p for guile-devel@gnu.org; Sat, 06 Nov 2004 23:31:07 -0500 Original-Received: by wproxy.gmail.com with SMTP id 67so97243wri for ; Sat, 06 Nov 2004 20:30:42 -0800 (PST) DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=beta; d=gmail.com; h=received:message-id:date:from:reply-to:to:subject:in-reply-to:mime-version:content-type:references; b=OJ9mQA2U/cvuZPODE8mAz2u6i1Bolg47EgYkIAQJshLYYrZVyl5neqS7HfupjpsNOkD4XSwyvYNn1CJ/FIe/U9os8tbeGg05nRfoLo6jRVOyDU94cadODpirHw2fq7q3dd9nQfMdqOPhOrhIZ2/izqh88dnyuzNJcYj0Wn9bIok= Original-Received: by 10.54.21.14 with SMTP id 14mr173800wru; Sat, 06 Nov 2004 20:30:42 -0800 (PST) Original-Received: by 10.54.53.23 with HTTP; Sat, 6 Nov 2004 20:30:42 -0800 (PST) Original-To: guile-devel@gnu.org In-Reply-To: <2bc5f821041030134527a81c92@mail.gmail.com> X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: main.gmane.org gmane.lisp.guile.devel:4357 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.devel:4357 ------=_Part_518_970583.1099801842146 Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: 7bit Content-Disposition: inline Hi everyone, I'm attaching a patch (against HEAD, created in guile/ via 'cvs diff -Nau') that represents the current state of my work on thread cancellation (except that I removed the cancellation-disabling stuff I'd added temporarily to gc.c; I wasn't super confident that it had any effect). I've also attached a little code that demonstrates the functionality I've added as well as the difficulty I've been having. Because this patch doesn't completely work, I haven't included any changes to the Changelog -- if it's not clear from my previous messages to this list or from my comments in the code exactly how I've implemented any of this or what it provides, just drop me a line. Cheers, Julian On Sat, 30 Oct 2004 16:45:14 -0400, Julian Graham wrote: > Alright, having combatted the corruption that seems to occur during > the cancellation handler for about a solid straight week and a half, > I'm getting pretty demoralized. Here's where I am at this point: > > - Realized that the GC must be aware of the list of thread cleanup > handler expressions and protected them as part of scm_thread_mark > - The scm_thread data structure removes *itself* from the all_threads > list once it's finished, so I don't think premature deallocation is a > problem > - Realized that the GC might be interrupted by a cancellation signal > in the middle of a collection, since I'm pretty sure it calls > functions that are cancellation points for deferred-cancellation POSIX > threads. I assume that a half-finished collection could have > disastrous effects for data consistency, so I've taken the stopgap > measure of disabling cancellation while scm_igc() is running. > - It occurs to me that after the cancellation signal is received and a > bunch of pthreads stuff is unwound to call the pthread cancellation > handler, the Scheme evaluation environment for that thread may be in > some unknown state... > > ...which might explain why I've been getting SIGABRTs and SIGSEGVs > when I call scm_i_eval in my pthread cancellation handler. Here's a > characteristic stack trace for a SIGABRT > > #42 0x40017c2c in ?? () > #43 0x40b68228 in ?? () > #44 0x40b681f0 in ?? () > #45 0x40007def in _dl_lookup_symbol () from /lib/ld-linux.so.2 > #46 0x4008e26c in scm_cons (x=0x806e270, y=0x204) at pairs.c:59 > #47 0x40058c57 in scm_i_eval (exp=0x806e270, env=0x4031dc40) at eval.c:5859 > #48 0x400b4f27 in handler_cancellation (thread=0x80932a8) at threads.c:302 > #49 0x4018303b in __pthread_unwind () from /lib/tls/libpthread.so.0 > #50 0x4017e4a8 in sigcancel_handler () from /lib/tls/libpthread.so.0 > > ...with many many more ?? stack frames and then a SIGABRT in some > internal libc function. I can't seem to reproduce the SIGSEGV at the > moment. I've tried preserving the current evaluation environment in > addition to the expression at the time of the 'push' from Scheme code, > and then evaluating the expression in that saved environment when the > pthread cancellation handler runs, but that doesn't seem to do much > good (though it does raise the question: In what environment should > the cancellation handler expressions be evaluated? The env. at the > time they were pushed onto the list? Or the environment at the time > the thread received the cancellation signal? And what should the > correct error-handling behavior be during evaluation of cleanup > handler expressions?). > So having tried all this and more with no success, I'm kind of at my > wits' end; if anyone would like to volunteer to take this code over > from me (it's like 50-60 lines of new code in threads.c, > threads-plugin.c, pthreads-threads.c, and a teensy little bit in > gc.c), I'd be more than happy to comment it up and post the files or a > patch to HEAD. Or you can rewrite the whole thing from scratch, since > my design may be just plain stupid. > > Cheers, > > > Julian > > On Sun, 24 Oct 2004 11:29:06 +0200, Mikael Djurfeldt > wrote: > > Note, though, that this is the easy part. I do expect that there also > > could arise nasty complications having to do with the order in which > > things are done at cancellation. It's for example important that the > > scm_thread data structure isn't deallocated before the handlers are > > invoked. It's also important that the GC is still aware of the thread > > at that point in time. It's important that the thread *is* properly > > deallocated *after* the handlers have run---that kind of stuff. But > > maybe there's no problem at all. > ------=_Part_518_970583.1099801842146 Content-Type: text/x-patch; name="thread-cancellation-HEAD.patch" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="thread-cancellation-HEAD.patch" Index: guile-core/libguile/Makefile.am =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D RCS file: /cvsroot/guile/guile/guile-core/libguile/Makefile.am,v retrieving revision 1.195 diff -a -u -r1.195 Makefile.am --- guile-core/libguile/Makefile.am=0924 Sep 2004 02:12:09 -0000=091.195 +++ guile-core/libguile/Makefile.am=097 Nov 2004 02:43:34 -0000 @@ -104,10 +104,11 @@ lang.c list.c=09=09=09=09=09=09=09 \ load.c macros.c mallocs.c modules.c numbers.c objects.c objprop.c=09 = \ options.c pairs.c ports.c print.c procprop.c procs.c properties.c=09 = \ - random.c rdelim.c read.c root.c rw.c scmsigs.c script.c simpos.c smob.= c \ - sort.c srcprop.c stackchk.c stacks.c stime.c strings.c srfi-13.c srfi-= 14.c \ - strorder.c strports.c struct.c symbols.c threads.c throw.c values.c=09= \ - variable.c vectors.c version.c vports.c weaks.c + pthread-threads.c random.c rdelim.c read.c root.c rw.c scmsigs.c = \ + script.c simpos.c smob.c sort.c srcprop.c stackchk.c stacks.c stime.c = \ + strings.c srfi-13.c srfi-14.c strorder.c strports.c struct.c symbols.c= \ + threads.c threads-plugin.c throw.c values.c variable.c vectors.c = \ + version.c vports.c weaks.c =20 DOT_X_FILES =3D alist.x arbiters.x async.x backtrace.x boolean.x chars.x= =09 \ continuations.x debug.x deprecation.x deprecated.x discouraged.x=09 \ @@ -208,12 +209,10 @@ # and people feel like maintaining them. For now, this is not the case. noinst_SCRIPTS =3D guile-doc-snarf guile-snarf-docs guile-func-name-check =20 -EXTRA_DIST =3D ChangeLog-gh ChangeLog-scm ChangeLog-threads=09=09\ - ChangeLog-1996-1999 ChangeLog-2000 cpp_signal.c=09=09=09\ - cpp_errno.c cpp_err_symbols.in cpp_err_symbols.c=09=09\ - cpp_sig_symbols.c cpp_sig_symbols.in cpp_cnvt.awk=09\ - c-tokenize.lex threads-plugin.c version.h.in pthread-threads.c \ - scmconfig.h.top gettext.h +EXTRA_DIST =3D ChangeLog-gh ChangeLog-scm ChangeLog-threads ChangeLog-1996= -1999 \ + ChangeLog-2000 cpp_signal.c=09cpp_errno.c cpp_err_symbols.in = \ + cpp_err_symbols.c cpp_sig_symbols.c cpp_sig_symbols.in cpp_cnvt.awk=09= \ + c-tokenize.lex version.h.in scmconfig.h.top gettext.h # $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES) \ # guile-procedures.txt guile.texi =20 Index: guile-core/libguile/pthread-threads.c =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D RCS file: /cvsroot/guile/guile/guile-core/libguile/pthread-threads.c,v retrieving revision 1.9 diff -a -u -r1.9 pthread-threads.c --- guile-core/libguile/pthread-threads.c=095 Apr 2003 19:10:22 -0000=091.9 +++ guile-core/libguile/pthread-threads.c=097 Nov 2004 02:43:39 -0000 @@ -22,7 +22,9 @@ # include #endif =20 -#include "libguile/scmconfig.h" +#include "pthread-threads.h" +#include "scmconfig.h" +#include "threads-plugin.h" =20 /* Should go to threads-plugin */ scm_t_mutexattr scm_i_plugin_mutex; Index: guile-core/libguile/pthread-threads.h =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D RCS file: /cvsroot/guile/guile/guile-core/libguile/pthread-threads.h,v retrieving revision 1.9 diff -a -u -r1.9 pthread-threads.h --- guile-core/libguile/pthread-threads.h=095 Apr 2003 19:10:22 -0000=091.9 +++ guile-core/libguile/pthread-threads.h=097 Nov 2004 02:43:40 -0000 @@ -46,6 +46,15 @@ #define scm_i_plugin_thread_detach=09pthread_detach=20 #define scm_i_plugin_thread_self=09pthread_self #define scm_i_plugin_thread_yield=09sched_yield +#define scm_i_plugin_thread_equal pthread_equal + +/* N.B.: pthread_cleanup_push and _pop are macros! */ +#define scm_i_plugin_thread_cancel pthread_cancel +#define scm_i_plugin_thread_cleanup_push pthread_cleanup_push +#define scm_i_plugin_thread_cleanup_pop pthread_cleanup_pop +#define scm_i_plugin_thread_setcancelstate=09pthread_setcancelstate +#define SCM_THREAD_CANCEL_ENABLE=09PTHREAD_CANCEL_ENABLE +#define SCM_THREAD_CANCEL_DISABLE=09PTHREAD_CANCEL_DISABLE =20 extern scm_t_mutexattr scm_i_plugin_mutex; /* The "fast" mutex. */ =20 Index: guile-core/libguile/threads-plugin.c =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D RCS file: /cvsroot/guile/guile/guile-core/libguile/threads-plugin.c,v retrieving revision 1.4 diff -a -u -r1.4 threads-plugin.c --- guile-core/libguile/threads-plugin.c=095 Apr 2003 19:10:22 -0000=091.4 +++ guile-core/libguile/threads-plugin.c=097 Nov 2004 02:43:40 -0000 @@ -22,6 +22,12 @@ # include #endif =20 +#include +#include + +#include "pthread-threads.h" +#include "threads.h" + int scm_i_plugin_mutex_size =3D 0; int (*scm_i_plugin_mutex_init) (scm_t_mutex *, const scm_t_mutexattr *); int (*scm_i_plugin_mutex_lock) (scm_t_mutex *); Index: guile-core/libguile/threads-plugin.h =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D RCS file: /cvsroot/guile/guile/guile-core/libguile/threads-plugin.h,v retrieving revision 1.5 diff -a -u -r1.5 threads-plugin.h --- guile-core/libguile/threads-plugin.h=0927 Apr 2004 22:59:04 -0000=091.5 +++ guile-core/libguile/threads-plugin.h=097 Nov 2004 02:43:40 -0000 @@ -21,7 +21,8 @@ */ =20 =0C -#include /* This file should *not* need to include pthread.h *= / + +#include "scmconfig.h" =20 /* Size is checked in scm_init_threads_plugin. For reference, sizes encountered include, @@ -59,6 +60,7 @@ extern scm_t_rec_mutex_trylock scm_i_plugin_rec_mutex_trylock; extern scm_t_rec_mutex_unlock scm_i_plugin_rec_mutex_unlock; =20 + /*fixme*/ #define scm_t_cond=09=09=09pthread_cond_t =20 Index: guile-core/libguile/threads.c =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D RCS file: /cvsroot/guile/guile/guile-core/libguile/threads.c,v retrieving revision 1.68 diff -a -u -r1.68 threads.c --- guile-core/libguile/threads.c=0922 Sep 2004 17:41:37 -0000=091.68 +++ guile-core/libguile/threads.c=097 Nov 2004 02:43:43 -0000 @@ -33,6 +33,8 @@ #include #endif =20 +#include + #include "libguile/validate.h" #include "libguile/root.h" #include "libguile/eval.h" @@ -114,6 +116,7 @@ scm_root_state *root; SCM handle; scm_t_thread thread; + SCM cleanup_handlers; SCM result; int exited; =20 @@ -133,6 +136,7 @@ t =3D SCM_THREAD_DATA (z); t->handle =3D z; t->result =3D creation_protects; + t->cleanup_handlers =3D SCM_EOL; t->base =3D NULL; scm_i_plugin_cond_init (&t->sleep_cond, 0); scm_i_plugin_mutex_init (&t->heap_mutex, &scm_i_plugin_mutex); @@ -156,6 +160,7 @@ { scm_thread *t =3D SCM_THREAD_DATA (obj); scm_gc_mark (t->result); + scm_gc_mark (t->cleanup_handlers); return t->root->handle; /* mark root-state of this thread */ } =20 @@ -285,6 +290,26 @@ void *handler_data; } launch_data; =20 +static void +handler_cancellation (scm_thread* thread) +{ + while (!scm_is_eq(scm_length(thread->cleanup_handlers), SCM_INUM0)) { + thread->result =3D scm_i_eval + (SCM_CAR(thread->cleanup_handlers), scm_current_module()); + thread->cleanup_handlers =3D SCM_CDR(thread->cleanup_handlers); + } + + scm_i_plugin_mutex_lock (&thread_admin_mutex); + scm_i_leave_guile(); + + all_threads =3D scm_delq_x (thread->handle, all_threads); + thread->exited =3D 1; + thread_count--; + scm_thread_detach (thread->thread); + scm_i_plugin_mutex_unlock (&thread_admin_mutex); + return; +} + static SCM body_bootstrip (launch_data* data) { @@ -315,11 +340,16 @@ init_thread_creatant (thread, base); /* must own the heap */ =20 data->rootcont =3D SCM_BOOL_F; + + scm_i_plugin_thread_cleanup_push + ((void (*) (void *)) handler_cancellation, (void *) t); t->result =3D scm_internal_cwdr ((scm_t_catch_body) body_bootstrip, =09=09 data, =09=09 (scm_t_catch_handler) handler_bootstrip, =09=09 data, base); + scm_i_plugin_thread_cleanup_pop(0); + scm_i_leave_guile (); /* release the heap */ free (data); =20 @@ -370,7 +400,9 @@ data->body_data =3D body_data; data->handler =3D handler; data->handler_data =3D handler_data; + t =3D SCM_THREAD_DATA (thread); + /* must initialize root state pointer before the thread is linked into all_threads */ t->root =3D SCM_ROOT_STATE (root); @@ -471,11 +503,77 @@ scm_i_enter_guile (c); } res =3D t->result; - t->result =3D SCM_BOOL_F; + /* t->result =3D SCM_BOOL_F; */ return res; } #undef FUNC_NAME =20 +SCM_DEFINE (scm_cancel_thread, "cancel-thread", 1, 0, 0, +=09 (SCM thread), +"Force the target @var{thread} to terminate, causing all of its " +"currently registered cleanup handlers to be called.") +#define FUNC_NAME s_scm_cancel_thread=20 +{ + scm_thread *t =3D SCM_THREAD_DATA (thread); + if (scm_is_eq(scm_member(t->handle, all_threads), SCM_BOOL_F)) { + return SCM_BOOL_F; + } + + if (!t->exited) + { + scm_thread *c =3D scm_i_leave_guile (); + while (!THREAD_INITIALIZED_P (t)) { +=09scm_i_plugin_thread_yield (); + } + scm_i_enter_guile (c); + scm_thread_cancel (t->thread); + } + return SCM_BOOL_T; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_push_thread_cleanup, "push-thread-cleanup", 1, 0, 0, +=09 (SCM expr), +"Add an expression @var{expr} to the front of the list of cleanup " +"handlers for the current thread. These handlers will be evaluated " +"in a LIFO manner if the current thread is cancelled by another " +"Scheme thread or by C code, via scm_c_thread_cancel().") +#define FUNC_NAME s_scm_push_thread_cleanup +{ + scm_thread *t =3D SCM_CURRENT_THREAD; + if (scm_is_eq(scm_member(t->handle, all_threads), SCM_BOOL_F)) { + return SCM_BOOL_F; + } + t->cleanup_handlers =3D scm_cons(expr, t->cleanup_handlers); + return SCM_BOOL_T; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_pop_thread_cleanup, "pop-thread-cleanup", 0, 1, 0, +=09 (SCM exec), +"Remove the most recently added cleanup handler expression from the " +"current thread's queue of cleanup handlers. If a boolean expression " +"@var{exec} is provided and is true, the cleanup handler will be " +"evaluated as it is removed.") +#define FUNC_NAME s_scm_pop_thread_cleanup +{ + scm_thread *t =3D SCM_CURRENT_THREAD; + if (scm_is_eq(scm_member(t->handle, all_threads), SCM_BOOL_F)) { + return SCM_BOOL_F; + } + + SCM result =3D SCM_EOL; + if (t->cleanup_handlers !=3D SCM_EOL) { + SCM expr =3D SCM_CAR(t->cleanup_handlers); + t->cleanup_handlers =3D SCM_CDR(t->cleanup_handlers); + if (scm_is_true(exec)) { + result =3D scm_i_eval(expr, scm_current_module()); + } + } + return result; =20 +} +#undef FUNC_NAME + /*** Fair mutexes */ =20 /* We implement our own mutex type since we want them to be 'fair', we @@ -1098,6 +1196,48 @@ return tv.tv_sec; } =20 +/* Thread cleanup handler pushing and popping functions. These are + the same for all threading libraries, because they operate on + Guile's internal representation of the thread, not the threading + library's. */ + +static scm_thread* +scm_t_thread_to_scm_thread(scm_t_thread* needle) { + scm_thread* ret =3D NULL; + SCM all_threads =3D scm_all_threads(); + while(!scm_is_eq(all_threads, SCM_EOL)) { + SCM single_thread =3D scm_car(all_threads); + if (scm_i_plugin_thread_equal(scm_c_scm2thread(single_thread), *needle= )) { + ret =3D SCM_THREAD_DATA(single_thread); + break; + } + all_threads =3D scm_cdr(all_threads);=09 + } + return ret; +} + +SCM=20 +scm_internal_thread_cleanup_push(scm_t_thread* thread, SCM expr)=20 +{ + scm_thread* t =3D scm_t_thread_to_scm_thread(thread); + if (t !=3D NULL) + t->cleanup_handlers =3D scm_cons(expr, t->cleanup_handlers); + return SCM_EOL; +} + +SCM=20 +scm_internal_thread_cleanup_pop(scm_t_thread* thread, int exec) +{ + SCM ret =3D SCM_EOL; + scm_thread* t =3D scm_t_thread_to_scm_thread(thread); + if ((t !=3D NULL) && (!scm_is_eq(t->cleanup_handlers, SCM_EOL))) { + SCM expr =3D scm_car(t->cleanup_handlers); + t->cleanup_handlers =3D scm_cdr(t->cleanup_handlers); + if (exec) ret =3D scm_eval(expr, t->root->handle); + } + return ret; +} + /*** Misc */ =20 SCM_DEFINE (scm_current_thread, "current-thread", 0, 0, 0, @@ -1217,9 +1357,9 @@ scm_t_rec_mutex scm_i_defer_mutex; =20 #if SCM_USE_PTHREAD_THREADS -# include "libguile/pthread-threads.c" +#include "libguile/pthread-threads.h" #endif -#include "libguile/threads-plugin.c" +#include "libguile/threads-plugin.h" =20 /*** Initialization */ =20 Index: guile-core/libguile/threads.h =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D RCS file: /cvsroot/guile/guile/guile-core/libguile/threads.h,v retrieving revision 1.38 diff -a -u -r1.38 threads.h --- guile-core/libguile/threads.h=0923 Jul 2004 23:51:58 -0000=091.38 +++ guile-core/libguile/threads.h=097 Nov 2004 02:43:44 -0000 @@ -64,9 +64,9 @@ SCM_API void scm_init_thread_procs (void); =20 #if SCM_USE_PTHREAD_THREADS -# include "libguile/pthread-threads.h" +#include "libguile/pthread-threads.h" #else -# include "libguile/null-threads.h" +#include "libguile/null-threads.h" #endif =20 /*----------------------------------------------------------------------*/ @@ -97,6 +97,14 @@ #define scm_thread_detach=09scm_i_plugin_thread_detach #define scm_thread_self=09=09scm_i_plugin_thread_self #define scm_thread_yield=09scm_i_plugin_thread_yield +#define scm_thread_cancel scm_i_plugin_thread_cancel +#define scm_thread_setcancelstate=09scm_i_plugin_thread_setcancelstate +/* N.B.: scm_i_plugin_thread_cleanup_push and _pop are defined, + but we don't use them here because of the way certain thread libraries + implement them; the ones here use a mechanism built into thread creatio= n + from thread.c... */ +#define scm_thread_cleanup_push scm_internal_thread_cleanup_push +#define scm_thread_cleanup_pop scm_internal_thread_cleanup_pop =20 #define scm_mutex_init=09=09scm_i_plugin_mutex_init=20 #define scm_mutex_destroy=09scm_i_plugin_mutex_destroy @@ -165,6 +173,9 @@ SCM_API unsigned long scm_thread_sleep (unsigned long); SCM_API unsigned long scm_thread_usleep (unsigned long); =20 +SCM_API SCM scm_internal_thread_cleanup_push(scm_t_thread*, SCM); +SCM_API SCM scm_internal_thread_cleanup_pop(scm_t_thread*, int); + /* End of low-level C API */ /*----------------------------------------------------------------------*/ =20 @@ -210,6 +221,9 @@ SCM_API SCM scm_call_with_new_thread (SCM thunk, SCM handler); SCM_API SCM scm_yield (void); SCM_API SCM scm_join_thread (SCM t); +SCM_API SCM scm_cancel_thread (SCM t); +SCM_API SCM scm_push_thread_cleanup (SCM expr); +SCM_API SCM scm_pop_thread_cleanup (SCM exec); SCM_API SCM scm_make_mutex (void); SCM_API SCM scm_make_fair_mutex (void); SCM_API SCM scm_lock_mutex (SCM m); ------=_Part_518_970583.1099801842146 Content-Type: text/x-scheme; name="thread-cancellation-test.scm" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="thread-cancellation-test.scm" ;; Simple test of thread cancellation. One thread does something, a second ;; joins on it, and a third cancels the first after you hit enter. If anyo= ne ;; can figure out why evaluating 'a as part of the cleanup of the sleep-pro= c ;; thread makes Guile crash, by all means let me know (use-modules (ice-9 threads)) (define loop-proc=20 (lambda (i)=20 (begin ((display "Entering thread...") (newline) (newline) (push-thread-cleanup i) (display "counting thread: the counter is ") (display i) (newline) (yield) (sleep 2) (loop-proc (+ i 1)))))) (define sleep-proc (lambda () (begin ((display "Entering thread...") (push-thread-cleanup 'a) (sleep 3000))))) (define joiner (lambda (thread-to-join) (let ((result (join-thread thread-to-join))) (begin=20 =09(display "joining thread: the counter was ") =09(display result) =09(newline))))) ;; Redefine cancelled thread as (make-thread loop-proc 1) to see some diffe= rent ;; behavior (let ((cancelled-thread (make-thread sleep-proc))) (begin (make-thread joiner cancelled-thread) (read-char (current-input-port)) (display "cancelling thread...") (newline) (cancel-thread cancelled-thread) (newline))) ------=_Part_518_970583.1099801842146 Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Guile-devel mailing list Guile-devel@gnu.org http://lists.gnu.org/mailman/listinfo/guile-devel ------=_Part_518_970583.1099801842146--