diff options
| author | Jim Blandy <jimb@red-bean.com> | 1997-04-15 01:34:36 +0000 |
|---|---|---|
| committer | Jim Blandy <jimb@red-bean.com> | 1997-04-15 01:34:36 +0000 |
| commit | 7bfd3b9e94a3317ad49d5dfab0bf1fcf5d33d82b (patch) | |
| tree | 29e1e7daa526d13b63071dd89974e5f8b4899ce5 | |
| parent | c520b64ca6b111c598cff2237bfc41dc68a9e59a (diff) | |
Merge threads directory into libguile.
* coop-defs.h, coop-threads.c, coop-threads.h, coop.c, threads.c,
threads.h: New source files.
* Makefile.am (EXTRA_libguile_la_SOURCES): Add threads.c.
(noinst_HEADERS): Add coop-threads.c, coop-threads.h, coop.c
here; see comment.
(modinclude_HEADERS): Add threads.h, coop-defs.h.
(EXTRA_DIST): Add fsu-pthreads.h, mit-pthreads.c, mit-pthreads.h,
coop-threads.c.cygnus, coop-threads.h.cygnus.
* configure.in: If we're using threads, include threads.o in
LIBOBJS.
* _scm.h, libguile.h: threads.h lives in this directory now.
* fsu-pthreads.h, mit-pthreads.c, mit-pthreads.h,
coop-threads.c.cygnus, coop-threads.h.cygnus: New files, not
currently used, but brought along for information's sake.
* ChangeLog-threads: log from old 'threads' directory.
* Makefile.in, configure: Rebuilt.
| -rw-r--r-- | libguile/ChangeLog-threads | 251 | ||||
| -rw-r--r-- | libguile/Makefile.am | 16 | ||||
| -rw-r--r-- | libguile/Makefile.in | 18 | ||||
| -rw-r--r-- | libguile/_scm.h | 4 | ||||
| -rw-r--r-- | libguile/configure.in | 1 | ||||
| -rw-r--r-- | libguile/coop-defs.h | 149 | ||||
| -rw-r--r-- | libguile/coop-threads.c | 439 | ||||
| -rw-r--r-- | libguile/coop-threads.c.cygnus | 469 | ||||
| -rw-r--r-- | libguile/coop-threads.h | 140 | ||||
| -rw-r--r-- | libguile/coop-threads.h.cygnus | 223 | ||||
| -rw-r--r-- | libguile/coop.c | 588 | ||||
| -rw-r--r-- | libguile/fsu-pthreads.h | 166 | ||||
| -rw-r--r-- | libguile/libguile.h | 2 | ||||
| -rw-r--r-- | libguile/mit-pthreads.c | 495 | ||||
| -rw-r--r-- | libguile/mit-pthreads.h | 187 | ||||
| -rw-r--r-- | libguile/threads.c | 161 | ||||
| -rw-r--r-- | libguile/threads.h | 91 |
17 files changed, 3388 insertions, 12 deletions
diff --git a/libguile/ChangeLog-threads b/libguile/ChangeLog-threads new file mode 100644 index 000000000..1acd8360c --- /dev/null +++ b/libguile/ChangeLog-threads @@ -0,0 +1,251 @@ +Some of the thread support code (threads.c, coop.c, etc.) used to live +in a separate directory called threads. In April 1997, that dir was +merged with libguile; this is the ChangeLog from the old directory. + +Please put new entries in the ordinary ChangeLog. + +Mon Feb 24 21:48:12 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> + + * configure.in: Added AM_MAINTAINER_MODE + +Fri Feb 21 23:52:16 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> + + * Makefile.am (modincludedir, modinclude_HEADERS): Added until + libthreads is integrated into libguile, otherwise people who try + to use Guile from an independent application will have trouble + finding libguile/../threads/threads.h. + +Sat Jan 11 18:35:39 1997 Marius Vollmer <mvo@zagadka.ping.de> + + * Makefile.am (noinst_HEADERS): Added coop-defs.h so that it gets + distributed. + +Tue Jan 7 14:05:35 1997 Mikael Djurfeldt <mdj@kenneth> + + * coop-defs.h: Added includes which define `time_t'. + +Sun Jan 5 15:07:07 1997 Jim Blandy <jimb@floss.cyclic.com> + + * Makefile.am (EXTRA_DIST): Add .cvsignore. + + * Makefile.am (libthreads_a_SOURCES): Add threads.h. I think this + is right... + (noinst_HEADERS): Remove it from here. + * Makefile.in: Rebuilt. + +Thu Jan 2 15:15:16 1997 Mikael Djurfeldt <mdj@kenneth> + + These changes separates threads declarations which everybody wants + to see (coop-defs.h) from declarations internal to the threads + module (coop-threads.h), thereby solving the "-I ../qt" problem. + (This is not the final solution. All files in the threads + directory should be moved into libguile since 1. it is too tightly + interconnected with libguile internals to be a separate module and + 2. it is actually quite small. When doing this, things can be + organized in a more natural way.) + + * coop-defs.h: New file. + + * coop-threads.c: Added #include "coop-threads.h" + + * coop-threads.h: Moved coop_t struct and threads macros to + coop-defs.h. Added #include "coop-defs.h". + + * threads.h: Changed #include "coop-threads.h" --> #include + "coop-defs.h". + +Mon Dec 9 17:20:39 1996 Tom Tromey <tromey@cygnus.com> + + * Makefile.am (.c.x): Use guile-snarf. + (INCLUDES): Search for headers in libguile source and build + directories. + +Mon Dec 2 20:37:07 1996 Tom Tromey <tromey@cygnus.com> + + * PLUGIN/greet: Removed. + * Makefile.am, aclocal.m4: New files. + * configure.in: Updated for Automake. + +Sun Nov 10 18:21:00 1996 Jim Blandy <jimb@totoro.cyclic.com> + + * Makefile.in (uninstall_threads): rmdir -f isn't portable; + use rm -rf instead. + +Sun Nov 10 17:41:21 1996 Jim Blandy <jimb@floss.cyclic.com> + + * Makefile.in, configure.in: When threads are disabled, + short-circuit the `install' and `uninstall' Makefile targets too. + +Sat Nov 2 21:29:33 1996 Mikael Djurfeldt <mdj@mdj.nada.kth.se> + + * threads.c: Added #include "dynwind.h". + Added scheme level procedure `single-active-thread?'. + + * mit-pthreads.c, mit-pthreads.h: Port completed but untested. + + * coop-threads.h: Increased SCM_THREAD_SWITCH_COUNT from 10 to 50 + to decrease overhead at the cost of granularity. + + * coop.c, coop-threads.h: Made coop_global_runq and + coop_global_sleepq visible globally. + + * coop-threads.c (scm_single_thread_p): New function. + +Thu Oct 24 22:37:03 1996 Mikael Djurfeldt <mdj@mdj.nada.kth.se> + + * threads.c: #include "dynwind.h" + + * coop-threads.c (scm_threads_mark_stacks): Removed unused + variable. + + * coop.c (coop_qput, coop_all_qput, coop_all_qremove): Removed + unused variable. + +Wed Oct 9 19:46:00 1996 Jim Blandy <jimb@floss.cyclic.com> + + * Makefile.in: Doc fixes. + + * Makefile.in (ancillary): Corrected spelling from `ancillery'. + + * Makefile.in (source, h_files, ancillary): Updated to describe + the actual contents of the tree. + (PLUGIN_distfiles): New variable. + (dist-dir): New target, to create a sub-tree of a distribution. + + * Makefile.in (all): Depend on @target_all@ instead of + libthreads.a, so the configure script can make this makefile do + nothing when threads aren't in use. + * configure.in: If we using cooperative threads, then let + @target_all@ expand to libthreads.a; otherwise, let it expand to + the empty string. + +Sat Oct 5 18:40:09 1996 Mikael Djurfeldt <mdj@kenneth> + + * threads.c, threads.h (scm_init_threads, scm_threads_init): Added + stack base pointer argument so that main thread can be initialized + properly. + + * configure.in: Added lines to set default -g flag in CFLAGS and + LDFLAGS. + + * coop-threads.c: Added argument checking to scheme level + procedures. Change the way threads are launched. + + * threads.h: Added #include "procs.h" + Added macros SCM_THREADP, SCM_MUTEXP and SCM_CONDVARP. + +Wed Oct 2 14:36:44 1996 Mikael Djurfeldt <mdj@woody.nada.kth.se> + + * coop-threads.c (scm_threads_free_thread, scm_threads_free_mutex, + scm_threads_free_condvar): free --> scm_must_free + + * coop-threads.h: Added macros SCM_THREAD_LOCAL_DATA and + SCM_SET_THREAD_LOCAL_DATA. + +Tue Oct 1 00:05:54 1996 Mikael Djurfeldt <mdj@woody.nada.kth.se> + + * coop-threads.c (scm_threads_mark_stacks): scm_save_regs_gc_mark + is already in root state (should it really?). Don't allocate it + locally; Remove extra argument to scm_mark_locations. + + * coop-threads.h: Changed #include <qt.h> --> #include "../qt/qt.h" + (SCM_THREAD_INITIALIZE_STORAGE, SCM_DEFER_INTS, SCM_ALLOW_INTS, + SCM_REDEFER_INTS, SCM_REALLOW_INTS, scm_coop_create_info_type): + Removed; Declaration of scm_coop_create_info removed. Added + definition of SCM_THREADS_SWITCHING_CODE. + + * coop-threads.c: Removed gscm_type objects. Renamed all + gscm_threads_<type>_die --> scm_threads_free_<type> and let them + return freed size as smob freeing code normally does. Removed + thread creation mutex and thread creation info structure. + (gscm_threads_thread_equal, gscm_pthread_delete_info, + scm_threads_init): Removed. + (scm_threads_init_coop_threads): Removed allocation of thread + local data. Removed initialization of thread creation mutex. + Renamed scm_threads_init_coop_threads --> scm_threads_init. + (scm_threads_mark_stacks): Mark root object instead of local + protects. + (launch_thread): thunk and handler is passed as a scheme list. + Call scm_with_new_root instead of scm_with_dynamic_root. Let + scm_with_new_root care about thread local variables. Removed + unlocking of creation mutex. + (scm_call_with_new_thread): Remove initialization of create info + structure and locking of creation mutex. Do smob allocation. + (scm_join_thread): Extract thread data in a new way. + (scm_make_mutex): Do smob allocation. + (scm_lock_mutex, scm_unlock_mutex): Extract thread data in a new + way. + (scm_make_condition_variable): Do smob allocation. + (scm_wait_condition_variable, scm_signal_condition_variable): + Extract thread data in a new way. + + * threads.c: Don't use files "no-threads.[hc]". Removed old code + for creation of thread, mutex and condition-variable objects. + Added smobs instead. Use scm_threads_free_<type> for freeing. + (scm_init_threads): Moved scm_add_feature ("threads") to + feature.c. + + * threads.h: Added declaration of scm_init_threads. Added macro + selectors SCM_THREAD_DATA, SCM_MUTEX_DATA and SCM_CONDVAR_DATA. + + * coop-threads.c, coop-threads.h, coop.c, fsu-pthreads.h, + mit-pthreads.c, mit-pthreads.h, threads.c, threads.h: Replaced + "gscm" --> "scm" everywhere. Lots of name changes to concord with + new Guile. + +Thu Apr 4 10:19:56 1996 Tom Tromey <tromey@creche.cygnus.com> + + Fixed CFLAGS usage: + * Makefile.in (XCFLAGS): New macro. + (.c.x): Use it. + (.c.o): Ditto. + * configure.in: Use DEFS, not X_CFLAGS. + +Fri Mar 29 17:08:14 1996 Anthony Green <green@snuffle.cygnus.com> + + * no-threads.c (gscm_threads_init_all): This function is now + found in libguile. + +Fri Mar 29 16:52:27 1996 Tom Tromey <tromey@creche.cygnus.com> + + * configure.in (CFLAGS): Use "test !=", not "! test". + +Fri Mar 29 11:51:18 1996 Anthony Green <green@snuffle.cygnus.com> + + * Makefile.in (install): make install now works properly. + +Thu Mar 28 07:52:11 1996 Anthony Green <green@csk3.cygnus.com> + + * mit-pthreads.c: dynwinds set to BOOL_T for new threads. + Added dummy yield function. + +Tue Mar 26 15:17:42 1996 Anthony Green (green@gerbil.cygnus.com) + + * coop.c: Added new sleep() function. Behaves properly + among multiple cooperative threads. Replaces system call. + +Mon Mar 25 11:05:41 1996 Anthony Green (green@gerbil.cygnus.com) + + * coop.c (COOP_STKSIZE): Boosted default stack size. + + * coop-threads.c: Moved declaration of scm_coop_create_info + to avoid multiple definitions at link time. + +Sun Mar 24 23:04:29 1996 Anthony Green (green@gerbil.cygnus.com) + + * configure: Rebuilt + * configure.in: Upgraded thread library/include support. + +Tue Mar 19 12:44:26 1996 Anthony Green (green@gerbil.cygnus.com) + + * coop.c, coop-threads.h coop-threads.c: Major cleanup of + cooperative threading code. + +Tue Feb 13 15:45:39 1996 Anthony Green <green@hoser.cygnus.com> + + * mit-pthreads.h: Defined pthread aware SCM_DEFER_INTS and friends. + +Mon Feb 12 19:59:55 1996 Anthony Green <green@hoser.cygnus.com> + + * threads.c, no-threads.c, mit-pthreads.c, threads.scm: Creation. + diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 6c92b0137..802c5d6ea 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -22,7 +22,15 @@ libguile_la_SOURCES = \ variable.c vectors.c version.c vports.c weaks.c EXTRA_libguile_la_SOURCES = _scm.h \ backtrace.c stacks.c debug.c srcprop.c \ - strerror.c inet_aton.c putenv.c + strerror.c inet_aton.c putenv.c \ + threads.c + +## This is kind of nasty... there are ".c" files that we don't want to +## compile, since they are #included in threads.c. So instead we list +## them here. Perhaps we can deal with them normally once the merge +## seems to be working. +noinst_HEADERS = coop-threads.c coop-threads.h coop.c + libguile_la_DEPENDENCIES = @LIBLOBJS@ libguile_la_LIBADD = @LIBLOBJS@ libguile_la_LDFLAGS = -version-info 0:0 -rpath $(libdir) @@ -44,7 +52,7 @@ modinclude_HEADERS = __scm.h alist.h append.h arbiters.h async.h \ sequences.h simpos.h smob.h socket.h srcprop.h stackchk.h stacks.h \ stime.h strings.h strop.h strorder.h strports.h struct.h symbols.h \ tag.h tags.h throw.h unif.h variable.h vectors.h version.h vports.h \ - weaks.h snarf.h + weaks.h snarf.h threads.h coop-defs.h ## This file is generated at configure time. That is why it is DATA ## and not a header -- headers are included in the distribution. @@ -63,7 +71,9 @@ gh_test_repl_LDADD = ${check_ldadd} EXTRA_DIST = gscm.c gscm.h ChangeLog-scm dynl-dl.c dynl-dld.c dynl-shl.c \ dynl-vms.c DYNAMIC-LINKING PLUGIN/REQ PLUGIN/guile.config \ PLUGIN/guile.libs.in cpp_signal.c cpp_errno.c cpp_err_symbols.in \ - cpp_sig_symbols.in cpp_cnvt.awk + cpp_sig_symbols.in cpp_cnvt.awk \ + coop-threads.h.cygnus coop-threads.c.cygnus mit-pthreads.h mit-pthreads.c \ + fsu-pthreads.h ## FIXME: shouldn't directly generate file; instead generate temp file ## and "mv". Consider using timestamp file as well, to avoid diff --git a/libguile/Makefile.in b/libguile/Makefile.in index 35d015357..cde3c58fe 100644 --- a/libguile/Makefile.in +++ b/libguile/Makefile.in @@ -81,7 +81,11 @@ libguile_la_SOURCES = \ variable.c vectors.c version.c vports.c weaks.c EXTRA_libguile_la_SOURCES = _scm.h \ backtrace.c stacks.c debug.c srcprop.c \ - strerror.c inet_aton.c putenv.c + strerror.c inet_aton.c putenv.c \ + threads.c + +noinst_HEADERS = coop-threads.c coop-threads.h coop.c + libguile_la_DEPENDENCIES = @LIBLOBJS@ libguile_la_LIBADD = @LIBLOBJS@ libguile_la_LDFLAGS = -version-info 0:0 -rpath $(libdir) @@ -103,7 +107,7 @@ modinclude_HEADERS = __scm.h alist.h append.h arbiters.h async.h \ sequences.h simpos.h smob.h socket.h srcprop.h stackchk.h stacks.h \ stime.h strings.h strop.h strorder.h strports.h struct.h symbols.h \ tag.h tags.h throw.h unif.h variable.h vectors.h version.h vports.h \ - weaks.h snarf.h + weaks.h snarf.h threads.h coop-defs.h modinclude_DATA = scmconfig.h @@ -120,7 +124,9 @@ gh_test_repl_LDADD = ${check_ldadd} EXTRA_DIST = gscm.c gscm.h ChangeLog-scm dynl-dl.c dynl-dld.c dynl-shl.c \ dynl-vms.c DYNAMIC-LINKING PLUGIN/REQ PLUGIN/guile.config \ PLUGIN/guile.libs.in cpp_signal.c cpp_errno.c cpp_err_symbols.in \ - cpp_sig_symbols.in cpp_cnvt.awk + cpp_sig_symbols.in cpp_cnvt.awk \ + coop-threads.h.cygnus coop-threads.c.cygnus mit-pthreads.h mit-pthreads.c \ + fsu-pthreads.h SUFFIXES = .x @@ -167,7 +173,7 @@ LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CF LINK = $(LIBTOOL) --mode=link $(CC) $(LDFLAGS) -o $@ DATA = $(modinclude_DATA) -HEADERS = $(include_HEADERS) $(modinclude_HEADERS) \ +HEADERS = $(include_HEADERS) $(modinclude_HEADERS) $(noinst_HEADERS) \ $(pkginclude_HEADERS) DIST_COMMON = COPYING ChangeLog Makefile.am Makefile.in acconfig.h \ @@ -197,8 +203,8 @@ DEP_FILES = .deps/alist.P .deps/append.P .deps/appinit.P \ .deps/socket.P .deps/srcprop.P .deps/stackchk.P .deps/stacks.P \ .deps/stime.P .deps/strerror.P .deps/strings.P .deps/strop.P \ .deps/strorder.P .deps/strports.P .deps/struct.P .deps/symbols.P \ -.deps/tag.P .deps/throw.P .deps/unif.P .deps/variable.P .deps/vectors.P \ -.deps/version.P .deps/vports.P .deps/weaks.P +.deps/tag.P .deps/threads.P .deps/throw.P .deps/unif.P .deps/variable.P \ +.deps/vectors.P .deps/version.P .deps/vports.P .deps/weaks.P SOURCES = $(libguile_la_SOURCES) $(EXTRA_libguile_la_SOURCES) $(gh_test_c_SOURCES) $(gh_test_repl_SOURCES) OBJECTS = $(libguile_la_OBJECTS) $(gh_test_c_OBJECTS) $(gh_test_repl_OBJECTS) diff --git a/libguile/_scm.h b/libguile/_scm.h index 88d771a0a..5d5b429dd 100644 --- a/libguile/_scm.h +++ b/libguile/_scm.h @@ -66,8 +66,8 @@ #include "ports.h" /* Everyone does I/O. */ #include "async.h" /* Everyone allows/disallows ints. */ #ifdef USE_THREADS -#include "../threads/threads.h" /* Some thread packages does switching - at async ticks. */ +#include "threads.h" /* The cooperative thread package does + switching at async ticks. */ #endif #include "snarf.h" /* Everyone snarfs. */ diff --git a/libguile/configure.in b/libguile/configure.in index 1e84d5ae7..c5ed06a3e 100644 --- a/libguile/configure.in +++ b/libguile/configure.in @@ -224,6 +224,7 @@ fi if test "$cy_cv_threads_package" != ""; then AC_DEFINE(USE_THREADS) + LIBOBJS="$LIBOBJS threads.o" fi ## If we're using GCC, ask for aggressive warnings. diff --git a/libguile/coop-defs.h b/libguile/coop-defs.h new file mode 100644 index 000000000..d9a6b9eec --- /dev/null +++ b/libguile/coop-defs.h @@ -0,0 +1,149 @@ +/* classes: h_files */ + +#ifndef COOP_DEFSH +#define COOP_DEFSH + +/* Copyright (C) 1996 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + + +# ifdef TIME_WITH_SYS_TIME +# include <sys/time.h> +# include <time.h> +# else +# ifdef HAVE_SYS_TIME_H +# include <sys/time.h> +# else +# ifdef HAVE_TIME_H +# include <time.h> +# endif +# endif +# endif + +/* This file is included by threads.h, which, in turn, is included by + libguile.h while coop-threads.h only is included by + coop-threads.c. */ + +/* The coop_t struct must be declared here, since macros in this file + refer to the data member. */ + +/* The notion of a thread is merged with the notion of a queue. + Thread stuff: thread status (sp) and stuff to use during + (re)initialization. Queue stuff: next thread in the queue + (next). */ + +struct qt_t; + +typedef struct coop_t { + struct qt_t *sp; /* QuickThreads handle. */ + void *sto; /* `malloc'-allocated stack. */ + + struct coop_t *next; /* Next thread in the queue. */ + + struct coop_t *all_next; + struct coop_t *all_prev; + + void *data; /* Thread local data */ + + void *base; /* Base of stack */ + void *top; /* Top of stack */ + + void *joining; /* A queue of threads waiting to join this + thread */ + + time_t wakeup_time; /* Time to stop sleeping */ + +} coop_t; + +extern coop_t *coop_global_curr; /* Currently-executing thread. */ + +extern void coop_yield (void); + +extern size_t scm_switch_counter; +extern size_t scm_thread_count; + + + +/* Cooperative threads don't need to have these defined */ + +#define SCM_THREAD_CRITICAL_SECTION_START +#define SCM_THREAD_CRITICAL_SECTION_END + + + +#define SCM_NO_CRITICAL_SECTION_OWNER 0 +#define SCM_THREAD_SWITCH_COUNT 50 /* was 10 /mdj */ + + + +#define SCM_THREAD_DEFER +#define SCM_THREAD_ALLOW +#define SCM_THREAD_REDEFER +#define SCM_THREAD_REALLOW_1 +#define SCM_THREAD_REALLOW_2 + +#if 0 +#define SCM_THREAD_SWITCHING_CODE \ +{ \ + if (scm_thread_count > 1) \ + coop_yield(); \ +} \ + +#else +#define SCM_THREAD_SWITCHING_CODE \ +{ \ + if (scm_thread_count > 1) \ + { \ + scm_switch_counter--; \ + if (scm_switch_counter == 0) \ + { \ + scm_switch_counter = SCM_THREAD_SWITCH_COUNT; \ + coop_yield(); \ + } \ + } \ +} \ + +#endif + +#define SCM_THREAD_LOCAL_DATA (coop_global_curr->data) +#define SCM_SET_THREAD_LOCAL_DATA(ptr) (coop_global_curr->data = (ptr)) + +#endif /* COOP_DEFSH */ diff --git a/libguile/coop-threads.c b/libguile/coop-threads.c new file mode 100644 index 000000000..a8860fc62 --- /dev/null +++ b/libguile/coop-threads.c @@ -0,0 +1,439 @@ +/* Copyright (C) 1995, 1996 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + + +#include "coop-threads.h" + +/* A counter of the current number of threads */ +size_t scm_thread_count = 0; + +/* This is included rather than compiled separately in order + to simplify the configuration mechanism. */ +#include "coop.c" + +/* A count-down counter used to determine when to switch + contexts */ +size_t scm_switch_counter = SCM_THREAD_SWITCH_COUNT; + +coop_m scm_critical_section_mutex; + +#ifdef __STDC__ +size_t +scm_threads_free_thread (SCM t) +#else +size_t +scm_threads_free_thread (t) + SCM t; +#endif +{ + scm_must_free (SCM_THREAD_DATA (t)); + return sizeof (coop_t); +} + +#ifdef __STDC__ +size_t +scm_threads_free_mutex (SCM m) +#else +size_t +scm_threads_free_mutex (m) + SCM m; +#endif +{ + scm_must_free (SCM_MUTEX_DATA (m)); + return sizeof (coop_m); +} + +#ifdef __STDC__ +size_t +scm_threads_free_condvar (SCM c) +#else +size_t +scm_threads_free_condvar (c) + SCM c; +#endif +{ + scm_must_free (SCM_CONDVAR_DATA (c)); + return sizeof (coop_c); +} + +#ifdef __STDC__ +void +scm_threads_init (SCM_STACKITEM *i) +#else +void +scm_threads_init (i) + SCM_STACKITEM *i; +#endif +{ + coop_init(); + + scm_thread_count = 1; + + coop_global_main.sto = i; + coop_global_main.base = i; + coop_global_curr = &coop_global_main; + coop_all_qput (&coop_global_allq, coop_global_curr); + + coop_mutex_init (&scm_critical_section_mutex); + + coop_global_main.data = 0; /* Initialized in init.c */ +} + +#ifdef __STDC__ +void +scm_threads_mark_stacks () +#else +void +scm_threads_mark_stacks () +#endif +{ + coop_t *thread; + + for (thread = coop_global_allq.t.all_next; + thread != NULL; thread = thread->all_next) + { + if (thread == coop_global_curr) + { + /* Active thread */ + /* stack_len is long rather than sizet in order to guarantee + that &stack_len is long aligned */ +#ifdef STACK_GROWS_UP + long stack_len = ((SCM_STACKITEM *) (&thread) - + (SCM_STACKITEM *) thread->base); + + /* Protect from the C stack. This must be the first marking + * done because it provides information about what objects + * are "in-use" by the C code. "in-use" objects are those + * for which the values from SCM_LENGTH and SCM_CHARS must remain + * usable. This requirement is stricter than a liveness + * requirement -- in particular, it constrains the implementation + * of scm_resizuve. + */ + SCM_FLUSH_REGISTER_WINDOWS; + /* This assumes that all registers are saved into the jmp_buf */ + setjmp (scm_save_regs_gc_mark); + scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark, + ((scm_sizet) sizeof scm_save_regs_gc_mark + / sizeof (SCM_STACKITEM))); + + scm_mark_locations (((size_t) thread->base, + (sizet) stack_len)); +#else + long stack_len = ((SCM_STACKITEM *) thread->base - + (SCM_STACKITEM *) (&thread)); + + /* Protect from the C stack. This must be the first marking + * done because it provides information about what objects + * are "in-use" by the C code. "in-use" objects are those + * for which the values from SCM_LENGTH and SCM_CHARS must remain + * usable. This requirement is stricter than a liveness + * requirement -- in particular, it constrains the implementation + * of scm_resizuve. + */ + SCM_FLUSH_REGISTER_WINDOWS; + /* This assumes that all registers are saved into the jmp_buf */ + setjmp (scm_save_regs_gc_mark); + scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark, + ((scm_sizet) sizeof scm_save_regs_gc_mark + / sizeof (SCM_STACKITEM))); + + scm_mark_locations ((SCM_STACKITEM *) &thread, + stack_len); +#endif + } + else + { + /* Suspended thread */ +#ifdef STACK_GROWS_UP + long stack_len = ((SCM_STACKITEM *) (thread->sp) - + (SCM_STACKITEM *) thread->base); + + scm_mark_locations ((size_t)thread->base, + (sizet) stack_len); +#else + long stack_len = ((SCM_STACKITEM *) thread->base - + (SCM_STACKITEM *) (thread->sp)); + + /* Registers are already on the stack. No need to mark. */ + + scm_mark_locations ((SCM_STACKITEM *) (size_t)thread->sp, + stack_len); +#endif + } + + /* Mark this thread's root */ + scm_gc_mark (((scm_root_state *) thread->data) -> handle); + } +} + +#ifdef __STDC__ +void +launch_thread (void *p) +#else +void +launch_thread (p) + void *p; +#endif +{ + /* The thread object will be GC protected by being a member of the + list given as argument to launch_thread. It will be marked + during the conservative sweep of the stack. */ + SCM args = (SCM) p; + scm_call_with_dynamic_root (SCM_CADR (args), SCM_CADDR (args)); + scm_thread_count--; +} + +#ifdef __STDC__ +SCM +scm_call_with_new_thread (SCM argl) +#else +SCM +scm_call_with_new_thread (argl) + SCM argl; +#endif +{ + SCM thread; + + /* Check arguments. */ + { + register SCM args = argl; + SCM thunk, handler; + SCM_ASSERT (SCM_NIMP (args), argl, SCM_WNA, s_call_with_new_thread); + thunk = SCM_CAR (args); + SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)), + thunk, + SCM_ARG1, + s_call_with_new_thread); + args = SCM_CDR (args); + SCM_ASSERT (SCM_NIMP (args), argl, SCM_WNA, s_call_with_new_thread); + handler = SCM_CAR (args); + SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (handler)), + handler, + SCM_ARG2, + s_call_with_new_thread); + SCM_ASSERT (SCM_NULLP (SCM_CDR (args)), argl, SCM_WNA, s_call_with_new_thread); + } + + /* Make new thread. */ + { + coop_t *t; + SCM root, old_winds; + + /* Unwind wind chain. */ + old_winds = scm_dynwinds; + scm_dowinds (SCM_EOL, scm_ilength (scm_root->dynwinds)); + + /* Allocate thread locals. */ + root = scm_make_root (scm_root->handle); + /* Make thread. */ + SCM_NEWCELL (thread); + SCM_DEFER_INTS; + SCM_SETCAR (thread, scm_tc16_thread); + argl = scm_cons (thread, argl); + t = coop_create (launch_thread, (void *) argl); + t->data = SCM_ROOT_STATE (root); + SCM_SETCDR (thread, t); + scm_thread_count++; + /* Note that the following statement also could cause coop_yield.*/ + SCM_ALLOW_INTS; + + /* We're now ready for the thread to begin. */ + coop_yield(); + + /* Return to old dynamic context. */ + scm_dowinds (old_winds, - scm_ilength (old_winds)); + } + + return thread; +} + +#ifdef __STDC__ +SCM +scm_join_thread (SCM t) +#else +SCM +scm_join_thread (t) + SCM t; +#endif +{ + SCM_ASSERT (SCM_NIMP (t) && SCM_THREADP (t), t, SCM_ARG1, s_join_thread); + coop_join (SCM_THREAD_DATA (t)); + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +scm_yield () +#else +SCM +scm_yield () +#endif +{ + /* Yield early */ + scm_switch_counter = SCM_THREAD_SWITCH_COUNT; + coop_yield(); + + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +scm_single_thread_p () +#else +SCM +scm_single_thread_p () +#endif +{ + return (coop_global_runq.tail == &coop_global_runq.t + ? SCM_BOOL_T + : SCM_BOOL_F); +} + +#ifdef __STDC__ +SCM +scm_make_mutex () +#else +SCM +scm_make_mutex () +#endif +{ + SCM m; + coop_m *data = (coop_m *) scm_must_malloc (sizeof (coop_m), "mutex"); + SCM_NEWCELL (m); + SCM_DEFER_INTS; + SCM_SETCAR (m, scm_tc16_mutex); + SCM_SETCDR (m, data); + SCM_ALLOW_INTS; + coop_mutex_init (data); + return m; +} + +#ifdef __STDC__ +SCM +scm_lock_mutex (SCM m) +#else +SCM +scm_lock_mutex (m) + SCM m; +#endif +{ + SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex); + coop_mutex_lock (SCM_MUTEX_DATA (m)); + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +scm_unlock_mutex (SCM m) +#else +SCM +scm_unlock_mutex (m) + SCM m; +#endif +{ + SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m), m, SCM_ARG1, s_unlock_mutex); + coop_mutex_unlock(SCM_MUTEX_DATA (m)); + + /* Yield early */ + scm_switch_counter = SCM_THREAD_SWITCH_COUNT; + coop_yield(); + + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +scm_make_condition_variable () +#else +SCM +scm_make_condition_variable () +#endif +{ + SCM c; + coop_c *data = (coop_c *) scm_must_malloc (sizeof (coop_c), "condvar"); + SCM_NEWCELL (c); + SCM_DEFER_INTS; + SCM_SETCAR (c, scm_tc16_condvar); + SCM_SETCDR (c, data); + SCM_ALLOW_INTS; + coop_condition_variable_init (SCM_CONDVAR_DATA (c)); + return c; +} + +#ifdef __STDC__ +SCM +scm_wait_condition_variable (SCM c, SCM m) +#else +SCM +scm_wait_condition_variable (c, m) + SCM c; + SCM m; +#endif +{ + SCM_ASSERT (SCM_NIMP (c) && SCM_CONDVARP (c), + c, + SCM_ARG1, + s_wait_condition_variable); + SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m), + m, + SCM_ARG2, + s_wait_condition_variable); + coop_mutex_unlock (SCM_MUTEX_DATA (m)); + coop_condition_variable_wait (SCM_CONDVAR_DATA (c)); + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +scm_signal_condition_variable (SCM c) +#else +SCM +scm_signal_condition_variable (c) + SCM c; +#endif +{ + SCM_ASSERT (SCM_NIMP (c) && SCM_CONDVARP (c), + c, + SCM_ARG1, + s_signal_condition_variable); + coop_condition_variable_signal (SCM_CONDVAR_DATA (c)); + return SCM_BOOL_T; +} diff --git a/libguile/coop-threads.c.cygnus b/libguile/coop-threads.c.cygnus new file mode 100644 index 000000000..5393d6fe0 --- /dev/null +++ b/libguile/coop-threads.c.cygnus @@ -0,0 +1,469 @@ +/* Copyright (C) 1995, 1996 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + + +/* A counter of the current number of threads */ +size_t scm_thread_count = 0; + +/* This is included rather than compiled seperately in order + to simplify the configuration mechanism. */ +#include "coop.c" + +/* A count-down counter used to determine when to switch + contexts */ +size_t scm_switch_counter = SCM_THREAD_SWITCH_COUNT; + +coop_m scm_critical_section_mutex; + +static struct gscm_type scm_thread_type; +static struct gscm_type scm_mutex_type; +static struct gscm_type scm_condition_variable_type; + +/* This mutex is used to synchronize thread creation */ +static coop_m scm_coop_create_mutex; + +/* Support structure for thread creation */ +struct scm_coop_create_info_type scm_coop_create_info; + +#ifdef __STDC__ +int +gscm_threads_thread_equal (SCM t1, SCM t2) +#else +int +gscm_threads_thread_equal (t1, t2) + SCM t1, t2; +#endif +{ + return (*(coop_t **) gscm_unwrap_obj (&scm_thread_type, &t1) == + *(coop_t **) gscm_unwrap_obj (&scm_thread_type, &t2)); +} + +#ifdef __STDC__ +void +gscm_threads_thread_die (SCM t) +#else +void +gscm_threads_thread_die (t) + SCM t; +#endif +{ + coop_t **thread = (coop_t **) gscm_unwrap_obj (&scm_thread_type, &t); + free(*thread); +} + +#ifdef __STDC__ +void +gscm_threads_mutex_die (SCM m) +#else +void +gscm_threads_scm_mutex_die (m) + SCM m; +#endif +{ + /* He's dead, Jim */ +} + +#ifdef __STDC__ +void +gscm_threads_condition_variable_die (SCM c) +#else +void +gscm_threads_condition_variable_die (c) + SCM c; +#endif +{ + /* He's dead, Jim */ +} + +#ifdef __STDC__ +void +gscm_threads_init () +#else +void +gscm_threads_init () +#endif +{ +} + +/* cleanup for info structure + */ +#ifdef __STDC__ +static void +scm_pthread_delete_info (void *ptr) +#else +static void +scm_pthread_delete_info (ptr) + void *ptr; +#endif +{ +} + +#ifdef __STDC__ +void +gscm_threads_init_coop_threads () +#else +void +gscm_threads_init_coop_threads () +#endif +{ + SCM *prots; + + coop_init(); + + scm_thread_count = 1; + + prots = (SCM *)malloc (sizeof (SCM) * scm_num_thread_local_protects); + + coop_global_main.sto = &prots; + coop_global_main.base = &prots; + coop_global_curr = &coop_global_main; + coop_all_qput (&coop_global_allq, coop_global_curr); + + coop_mutex_init(&scm_coop_create_mutex); + coop_mutex_init(&scm_critical_section_mutex); + + coop_global_main.data = prots; + + /* Initialize the root thread specific data pointer. All new threads + get a copy of this buffer. + scm_root_prots = prots; */ +} + +#ifdef __STDC__ +void +gscm_threads_mark_stacks () +#else +void +gscm_threads_mark_stacks () +#endif +{ + coop_t *thread; + int j; + jmp_buf scm_save_regs_gc_mark; + + for (thread = coop_global_allq.t.all_next; + thread != NULL; thread = thread->all_next) + { + if (thread == coop_global_curr) + { + /* Active thread */ + /* stack_len is long rather than sizet in order to guarantee + that &stack_len is long aligned */ +#ifdef STACK_GROWS_UP + long stack_len = (STACKITEM *) (&thread) - + (STACKITEM *) thread->base; + + /* Protect from the C stack. This must be the first marking + * done because it provides information about what objects + * are "in-use" by the C code. "in-use" objects are those + * for which the values from LENGTH and CHARS must remain + * usable. This requirement is stricter than a liveness + * requirement -- in particular, it constrains the implementation + * of scm_resizuve. + */ + FLUSH_REGISTER_WINDOWS; + /* This assumes that all registers are saved into the jmp_buf */ + setjmp (scm_save_regs_gc_mark); + scm_mark_locations ((STACKITEM *) scm_save_regs_gc_mark, + ((sizet) sizeof scm_save_regs_gc_mark + / sizeof (STACKITEM)), BOOL_T); + + scm_mark_locations (((size_t) thread->base, + (sizet) stack_len, BOOL_T)); +#else + long stack_len = (STACKITEM *) thread->base - + (STACKITEM *) (&thread); + + /* Protect from the C stack. This must be the first marking + * done because it provides information about what objects + * are "in-use" by the C code. "in-use" objects are those + * for which the values from LENGTH and CHARS must remain + * usable. This requirement is stricter than a liveness + * requirement -- in particular, it constrains the implementation + * of scm_resizuve. + */ + FLUSH_REGISTER_WINDOWS; + /* This assumes that all registers are saved into the jmp_buf */ + setjmp (scm_save_regs_gc_mark); + scm_mark_locations ((STACKITEM *) scm_save_regs_gc_mark, + ((sizet) sizeof scm_save_regs_gc_mark + / sizeof (STACKITEM)), BOOL_T); + + scm_mark_locations ((STACKITEM *) &thread, + stack_len, BOOL_T); +#endif + } + else + { + /* Suspended thread */ +#ifdef STACK_GROWS_UP + long stack_len = (STACKITEM *) (thread->sp) - + (STACKITEM *) thread->base; + + scm_mark_locations (((size_t)thread->base, + (sizet) stack_len, BOOL_T)); +#else + long stack_len = (STACKITEM *) thread->base - + (STACKITEM *) (thread->sp); + + /* Registers are already on the stack. No need to mark. */ + + scm_mark_locations ((STACKITEM *) (size_t)thread->sp, + stack_len, BOOL_T); +#endif + } + + /* Mark all the of this thread's thread-local protects */ + for (j = scm_num_thread_local_protects-1; j >= 0; j--) + { + scm_gc_mark (((SCM*)(thread->data))[j], BOOL_F); + } + } +} + +#ifdef __STDC__ +void +launch_thread (void *p) +#else +void +launch_thread (p) + void *p; +#endif +{ + SCM thunk = scm_coop_create_info.thunk; + SCM error = scm_coop_create_info.error; + + /* dynwinds must be set to BOOL_F for each new thread + (it is a thread-local variable) */ + dynwinds = BOOL_F; + + coop_mutex_unlock(&scm_coop_create_mutex); + + scm_with_dynamic_root (thunk, error); + + scm_thread_count--; +} + +#ifdef __STDC__ +SCM +gscm_threads_with_new_thread (SCM thunk, SCM error_thunk) +#else +SCM +gscm_threads_with_new_thread (thunk, error_thunk) + SCM thunk; + SCM error_thunk; +#endif +{ + int rc; + SCM t = gscm_alloc (&scm_thread_type, sizeof(coop_t *)); + + coop_t **pt = (coop_t **) gscm_unwrap_obj (&scm_thread_type, &t); + + int status; + + /* Rather than allocate space to hold fn and arg, a mutex is used + to serialize thread creation. */ + coop_mutex_lock(&scm_coop_create_mutex); + + /* this data is passed to the newly created thread */ + scm_coop_create_info.thunk = thunk; + scm_coop_create_info.error = error_thunk; + + *pt = coop_create(launch_thread, &scm_coop_create_info); + scm_thread_count++; + + { + SCM * prots; + + prots = (SCM *)malloc (sizeof (SCM) * scm_num_thread_local_protects); + + (*pt)->data = prots; + + /* Copy root thread specific data over */ + memcpy(prots, (SCM*)coop_global_curr->data, + sizeof (SCM) * scm_num_thread_local_protects); + + prots[SCM_THREAD_T] = t; + prots[SCM_THREAD_THUNK] = thunk; + prots[SCM_THREAD_ERROR] = error_thunk; + } + + /* we're now ready for the thread to begin */ + coop_yield(); + + return t; +} + +#ifdef __STDC__ +SCM +gscm_threads_join_thread (SCM t) +#else +SCM +gscm_threads_join_thread (t) + SCM t; +#endif +{ + coop_t **thread = (coop_t **) gscm_unwrap_obj (&scm_thread_type, &t); + + coop_join(*thread); + + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +gscm_threads_make_mutex () +#else +SCM +gscm_threads_make_mutex () +#endif +{ + SCM t = gscm_alloc (&scm_mutex_type, sizeof(coop_m)); + + coop_m *m = (coop_m *) gscm_unwrap_obj (&scm_mutex_type, &t); + + coop_mutex_init(m); + + return t; +} + +#ifdef __STDC__ +SCM +gscm_threads_lock_mutex (SCM m) +#else +SCM +gscm_threads_lock_mutex (m) + SCM m; +#endif +{ + coop_m *mutex = (coop_m *) gscm_unwrap_obj (&scm_mutex_type, &m); + + coop_mutex_lock(mutex); + + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +gscm_threads_unlock_mutex (SCM m) +#else +SCM +gscm_threads_unlock_mutex (m) + SCM m; +#endif +{ + coop_m *mutex = (coop_m *) gscm_unwrap_obj (&scm_mutex_type, &m); + + coop_mutex_unlock(mutex); + + /* Yield early */ + scm_switch_counter = SCM_THREAD_SWITCH_COUNT; + coop_yield(); + + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +gscm_threads_make_condition_variable () +#else +SCM +gscm_threads_make_condition_variable () +#endif +{ + SCM t = gscm_alloc (&scm_mutex_type, sizeof(coop_c)); + + coop_c *c = (coop_c *) gscm_unwrap_obj (&scm_condition_variable_type, &t); + + coop_condition_variable_init(c); + + return t; +} + +#ifdef __STDC__ +SCM +gscm_threads_condition_variable_wait (SCM c, SCM m) +#else +SCM +gscm_threads_condition_variable_wait (c, m) + SCM c; + SCM m; +#endif +{ + coop_c *cv = (coop_c *) gscm_unwrap_obj (&scm_condition_variable_type, &c); + coop_m *mutex = (coop_m *) gscm_unwrap_obj (&scm_mutex_type, &m); + + coop_mutex_unlock(mutex); + coop_condition_variable_wait(cv); + + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +gscm_threads_condition_variable_signal (SCM c) +#else +SCM +gscm_threads_condition_variable_signal (c) + SCM c; +#endif +{ + coop_c *cv = (coop_c *) gscm_unwrap_obj (&scm_condition_variable_type, &c); + + coop_condition_variable_signal(cv); + + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +gscm_threads_yield () +#else +SCM +gscm_threads_yield () +#endif +{ + /* Yield early */ + scm_switch_counter = SCM_THREAD_SWITCH_COUNT; + coop_yield(); + + return SCM_BOOL_T; +} diff --git a/libguile/coop-threads.h b/libguile/coop-threads.h new file mode 100644 index 000000000..0d9678eb4 --- /dev/null +++ b/libguile/coop-threads.h @@ -0,0 +1,140 @@ +/* classes: h_files */ + +#ifndef COOP_THREADSH +#define COOP_THREADSH + +/* Copyright (C) 1996 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + + +/* This file is only included by coop-threads.c while coop-defs.h is + included by threads.h, which, in turn, is included by + libguile.h. */ + +/* The coop_t struct is declared in coop-defs.h. */ + +#include "libguile/__scm.h" + +#include <time.h> + +#include "coop-defs.h" +#include "../qt/qt.h" + +/* This code is based on a sample thread libraru by David Keppel. + Portions of this file fall under the following copyright: */ + +/* + * QuickThreads -- Threads-building toolkit. + * Copyright (c) 1993 by David Keppel + * + * Permission to use, copy, modify and distribute this software and + * its documentation for any purpose and without fee is hereby + * granted, provided that the above copyright notice and this notice + * appear in all copies. This software is provided as a + * proof-of-concept and for demonstration purposes; there is no + * representation about the suitability of this software for any + * purpose. + */ + +/* A queue is a circular list of threads. The queue head is a + designated list element. If this is a uniprocessor-only + implementation we can store the `main' thread in this, but in a + multiprocessor there are several `heavy' threads but only one run + queue. A fancier implementation might have private run queues, + which would lead to a simpler (trivial) implementation */ + +typedef struct coop_q_t { + coop_t t; + coop_t *tail; +} coop_q_t; + +/* A Mutex variable is made up of a owner thread, and a queue of threads + waiting on the mutex */ + +typedef struct coop_m { + coop_t *owner; /* Mutex owner */ + coop_q_t waiting; /* Queue of waiting threads */ +} coop_m; + +/* A Condition variable is made up of a list of threads waiting on the + condition. */ + +typedef struct coop_c { + coop_q_t waiting; /* Queue of waiting threads */ +} coop_c; + +/* Each thread starts by calling a user-supplied function of this + type. */ + +typedef void (coop_userf_t)(void *p0); + +/* Call this before any other primitives. */ +extern void coop_init(); + +/* When one or more threads are created by the main thread, + the system goes multithread when this is called. It is done + (no more runable threads) when this returns. */ + +extern void coop_start (void); + +/* Create a thread and make it runable. When the thread starts + running it will call `f' with arguments `p0' and `p1'. */ + +extern coop_t *coop_create (coop_userf_t *f, void *p0); + +/* The current thread stops running but stays runable. + It is an error to call `coop_yield' before `coop_start' + is called or after `coop_start' returns. */ + +extern void coop_yield (void); + +/* Like `coop_yield' but the thread is discarded. Any intermediate + state is lost. The thread can also terminate by simply + returning. */ + +extern void coop_abort (void); + +extern coop_q_t coop_global_runq; /* A queue of runable threads. */ +extern coop_q_t coop_global_sleepq; +extern coop_q_t coop_global_allq; /* A queue of all threads. */ +extern coop_t *coop_global_curr; /* Currently-executing thread. */ + +#endif /* COOP_THREADSH */ diff --git a/libguile/coop-threads.h.cygnus b/libguile/coop-threads.h.cygnus new file mode 100644 index 000000000..bf72e824a --- /dev/null +++ b/libguile/coop-threads.h.cygnus @@ -0,0 +1,223 @@ +/* Copyright (C) 1995, 1996 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + + +#ifndef GSCM_COOP_THREADS_H +#define GSCM_COOP_THREADS_H + +#include <qt.h> +#include <time.h> + +/* This code is based on a sample thread libraru by David Keppel. + Portions of this file fall under the following copyright: */ + +/* + * QuickThreads -- Threads-building toolkit. + * Copyright (c) 1993 by David Keppel + * + * Permission to use, copy, modify and distribute this software and + * its documentation for any purpose and without fee is hereby + * granted, provided that the above copyright notice and this notice + * appear in all copies. This software is provided as a + * proof-of-concept and for demonstration purposes; there is no + * representation about the suitability of this software for any + * purpose. + */ + +/* The notion of a thread is merged with the notion of a queue. + Thread stuff: thread status (sp) and stuff to use during + (re)initialization. Queue stuff: next thread in the queue + (next). */ + +typedef struct coop_t { + qt_t *sp; /* QuickThreads handle. */ + void *sto; /* `malloc'-allocated stack. */ + + struct coop_t *next; /* Next thread in the queue. */ + + struct coop_t *all_next; + struct coop_t *all_prev; + + void *data; /* Thread local data */ + + void *base; /* Base of stack */ + void *top; /* Top of stack */ + + void *joining; /* A queue of threads waiting to join this + thread */ + + time_t wakeup_time; /* Time to stop sleeping */ + +} coop_t; + +/* A queue is a circular list of threads. The queue head is a + designated list element. If this is a uniprocessor-only + implementation we can store the `main' thread in this, but in a + multiprocessor there are several `heavy' threads but only one run + queue. A fancier implementation might have private run queues, + which would lead to a simpler (trivial) implementation */ + +typedef struct coop_q_t { + coop_t t; + coop_t *tail; +} coop_q_t; + +/* A Mutex variable is made up of a owner thread, and a queue of threads + waiting on the mutex */ + +typedef struct coop_m { + coop_t *owner; /* Mutex owner */ + coop_q_t waiting; /* Queue of waiting threads */ +} coop_m; + +/* A Condition variable is made up of a list of threads waiting on the + condition. */ + +typedef struct coop_c { + coop_q_t waiting; /* Queue of waiting threads */ +} coop_c; + +/* Each thread starts by calling a user-supplied function of this + type. */ + +typedef void (coop_userf_t)(void *p0); + +/* Call this before any other primitives. */ +extern void coop_init(); + +/* When one or more threads are created by the main thread, + the system goes multithread when this is called. It is done + (no more runable threads) when this returns. */ + +extern void coop_start (void); + +/* Create a thread and make it runable. When the thread starts + running it will call `f' with arguments `p0' and `p1'. */ + +extern coop_t *coop_create (coop_userf_t *f, void *p0); + +/* The current thread stops running but stays runable. + It is an error to call `coop_yield' before `coop_start' + is called or after `coop_start' returns. */ + +extern void coop_yield (void); + +/* Like `coop_yield' but the thread is discarded. Any intermediate + state is lost. The thread can also terminate by simply + returning. */ + +extern void coop_abort (void); + +extern coop_q_t coop_global_allq; /* A queue of all threads. */ +extern coop_t *coop_global_curr; /* Currently-executing thread. */ + + + +extern size_t scm_switch_counter; +extern size_t scm_thread_count; + + + +/* Cooperative threads don't need to have these defined */ + +#define SCM_THREAD_CRITICAL_SECTION_START +#define SCM_THREAD_CRITICAL_SECTION_END +#define SCM_THREAD_INITIALIZE_STORAGE gscm_threads_init_coop_threads() + + + +#define SCM_NO_CRITICAL_SECTION_OWNER 0 +#define SCM_THREAD_SWITCH_COUNT 10 + + + +#define SCM_DEFER_INTS \ +{ \ + scm_ints_disabled = 1; \ +} + +#define SCM_ALLOW_INTS \ +{ \ + scm_ints_disabled = 0; \ + SCM_CHECK_INTS; \ + scm_switch_counter--; \ + if (scm_switch_counter == 0) \ + { \ + scm_switch_counter = SCM_THREAD_SWITCH_COUNT; \ + if (scm_thread_count > 1) \ + coop_yield(); \ + } \ +} + +#define SCM_REDEFER_INTS \ +{ \ + ++scm_ints_disabled; \ +} + +#define SCM_REALLOW_INTS \ +{ \ + --scm_ints_disabled; \ + if (!scm_ints_disabled) \ + { \ + SCM_CHECK_INTS; \ + } \ + scm_switch_counter--; \ + if (scm_switch_counter == 0) \ + { \ + scm_switch_counter = SCM_THREAD_SWITCH_COUNT; \ + if (scm_thread_count > 1) \ + coop_yield(); \ + } \ +} + + + +/* This structure is used when creating new threads. */ + +struct scm_coop_create_info_type +{ + SCM thunk; + SCM error; +}; + +extern struct scm_coop_create_info_type scm_coop_create_info; + +#endif diff --git a/libguile/coop.c b/libguile/coop.c new file mode 100644 index 000000000..56f7175d2 --- /dev/null +++ b/libguile/coop.c @@ -0,0 +1,588 @@ +/* Copyright (C) 1995, 1996 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + + +/* $Id: coop.c,v 1.1 1997-04-15 01:34:30 jimb Exp $ */ + +/* Cooperative thread library, based on QuickThreads */ + +#include <qt.h> + +#define COOP_STKSIZE (0x10000) + +/* `alignment' must be a power of 2. */ +#define COOP_STKALIGN(sp, alignment) \ +((void *)((((qt_word_t)(sp)) + (alignment) - 1) & ~((alignment)-1))) + + + +/* Queue access functions. */ + +#ifdef __STDC__ +static void +coop_qinit (coop_q_t *q) +#else +static void +coop_qinit (q) + coop_q_t *q; +#endif +{ + q->t.next = q->tail = &q->t; + + q->t.all_prev = NULL; + q->t.all_next = NULL; +} + + +#ifdef __STDC__ +static coop_t * +coop_qget (coop_q_t *q) +#else +static coop_t * +coop_qget (q) + coop_q_t *q; +#endif +{ + coop_t *t; + + t = q->t.next; + q->t.next = t->next; + if (t->next == &q->t) { + if (t == &q->t) { /* If it was already empty .. */ + return (NULL); /* .. say so. */ + } + q->tail = &q->t; /* Else now it is empty. */ + } + return (t); +} + + +#ifdef __STDC__ +static void +coop_qput (coop_q_t *q, coop_t *t) +#else +static void +coop_qput (q, t) + coop_q_t *q; + coop_t *t; +#endif +{ + q->tail->next = t; + t->next = &q->t; + q->tail = t; +} + +#ifdef __STDC__ +static void +coop_all_qput (coop_q_t *q, coop_t *t) +#else +static void +coop_all_qput (q, t) + coop_q_t *q; + coop_t *t; +#endif +{ + if (q->t.all_next) + q->t.all_next->all_prev = t; + t->all_prev = NULL; + t->all_next = q->t.all_next; + q->t.all_next = t; +} + +#ifdef __STDC__ +static void +coop_all_qremove (coop_q_t *q, coop_t *t) +#else +static void +coop_all_qremove (q, t) + coop_q_t *q; + coop_t *t; +#endif +{ + if (t->all_prev) + t->all_prev->all_next = t->all_next; + else + q->t.all_next = t->all_next; + if (t->all_next) + t->all_next->all_prev = t->all_prev; +} + + + /* Thread routines. */ + +coop_q_t coop_global_runq; /* A queue of runable threads. */ +coop_q_t coop_global_sleepq; /* A queue of sleeping threads. */ +static coop_q_t tmp_queue; /* A temp working queue */ +coop_q_t coop_global_allq; /* A queue of all threads. */ +static coop_t coop_global_main; /* Thread for the process. */ +coop_t *coop_global_curr; /* Currently-executing thread. */ + +static void *coop_starthelp (qt_t *old, void *ignore0, void *ignore1); +static void coop_only (void *pu, void *pt, qt_userf_t *f); +static void *coop_aborthelp (qt_t *sp, void *old, void *null); +static void *coop_yieldhelp (qt_t *sp, void *old, void *blockq); + + +#ifdef __STDC__ +void +coop_init() +#else +void +coop_init() +#endif +{ + coop_qinit (&coop_global_runq); + coop_qinit (&coop_global_sleepq); + coop_qinit (&tmp_queue); + coop_qinit (&coop_global_allq); + coop_global_curr = &coop_global_main; +} + + +/* Return the next runnable thread. If no threads are currently runnable, + and there are sleeping threads - wait until one wakes up. Otherwise, + return NULL. */ + +#ifdef __STDC__ +coop_t * +coop_next_runnable_thread() +#else +coop_t * +coop_next_runnable_thread() +#endif +{ + int sleepers; + coop_t *t; + time_t now; + + do { + sleepers = 0; + now = time(NULL); + + /* Check the sleeping queue */ + while ((t = coop_qget(&coop_global_sleepq)) != NULL) + { + sleepers++; + if (t->wakeup_time <= now) + coop_qput(&coop_global_runq, t); + else + coop_qput(&tmp_queue, t); + } + while ((t = coop_qget(&tmp_queue)) != NULL) + coop_qput(&coop_global_sleepq, t); + + t = coop_qget (&coop_global_runq); + + } while ((t == NULL) && (sleepers > 0)); + + return t; +} + + +#ifdef __STDC__ +void +coop_start() +#else +void +coop_start() +#endif +{ + coop_t *next; + + while ((next = coop_qget (&coop_global_runq)) != NULL) { + coop_global_curr = next; + QT_BLOCK (coop_starthelp, 0, 0, next->sp); + } +} + + +#ifdef __STDC__ +static void * +coop_starthelp (qt_t *old, void *ignore0, void *ignore1) +#else +static void * +coop_starthelp (old, ignore0, ignore1) + qt_t *old; + void *ignore0; + void *ignore1; +#endif +{ + coop_global_main.sp = old; + coop_global_main.joining = NULL; + coop_qput (&coop_global_runq, &coop_global_main); + return NULL; /* not used, but keeps compiler happy */ +} + +#ifdef __STDC__ +void +coop_mutex_init (coop_m *m) +#else +void +coop_mutex_init (m) + coop_m *m; +#endif +{ + m->owner = NULL; + coop_qinit(&(m->waiting)); +} + +#ifdef __STDC__ +void +coop_mutex_lock (coop_m *m) +#else +void +coop_mutex_lock () + coop_m *m; +#endif +{ + if (m->owner == NULL) + { + m->owner = coop_global_curr; + } + else + { + coop_t *old, *newthread; + + /* Record the current top-of-stack before going to sleep */ + coop_global_curr->top = &old; + + newthread = coop_next_runnable_thread(); + old = coop_global_curr; + coop_global_curr = newthread; + QT_BLOCK (coop_yieldhelp, old, &(m->waiting), newthread->sp); + } +} + + +#ifdef __STDC__ +void +coop_mutex_unlock (coop_m *m) +#else +void +coop_mutex_unlock (m) + coop_m *m; +#endif +{ + coop_t *old, *newthread; + + newthread = coop_qget (&(m->waiting)); + if (newthread != NULL) + { + /* Record the current top-of-stack before going to sleep */ + coop_global_curr->top = &old; + + old = coop_global_curr; + coop_global_curr = newthread; + m->owner = coop_global_curr; + QT_BLOCK (coop_yieldhelp, old, &coop_global_runq, newthread->sp); + } + else + { + m->owner = NULL; + } +} + + +#ifdef __STDC__ +void +coop_condition_variable_init (coop_c *c) +#else +void +coop_condition_variable_init (c) + coop_c *c; +#endif +{ + coop_qinit(&(c->waiting)); +} + +#ifdef __STDC__ +void +coop_condition_variable_wait (coop_c *c) +#else +void +coop_condition_variable_wait (c) + coop_c *c; +#endif +{ + coop_t *old, *newthread; + + newthread = coop_next_runnable_thread(); + old = coop_global_curr; + coop_global_curr = newthread; + QT_BLOCK (coop_yieldhelp, old, &(c->waiting), newthread->sp); +} + +#ifdef __STDC__ +void +coop_condition_variable_signal (coop_c *c) +#else +void +coop_condition_variable_signal (c) + coop_c *c; +#endif +{ + coop_t *newthread; + + while ((newthread = coop_qget (&(c->waiting))) != NULL) + { + coop_qput (&coop_global_runq, newthread); + } +} + + +#ifdef __STDC__ +coop_t * +coop_create (coop_userf_t *f, void *pu) +#else +coop_t * +coop_create (f, pu) + coop_userf_t *f; + void *pu; +#endif +{ + coop_t *t; + void *sto; + + t = malloc (sizeof(coop_t)); + + t->data = NULL; + t->sto = malloc (COOP_STKSIZE); + sto = COOP_STKALIGN (t->sto, QT_STKALIGN); + t->sp = QT_SP (sto, COOP_STKSIZE - QT_STKALIGN); + t->base = t->sp; + t->sp = QT_ARGS (t->sp, pu, t, (qt_userf_t *)f, coop_only); + t->joining = NULL; + coop_qput (&coop_global_runq, t); + coop_all_qput (&coop_global_allq, t); + + return t; +} + + +#ifdef __STDC__ +static void +coop_only (void *pu, void *pt, qt_userf_t *f) +#else +static void +coop_only (pu. pt, f) + void *pu, + void *pt, + qt_userf_t *f; +#endif +{ + coop_global_curr = (coop_t *)pt; + (*(coop_userf_t *)f)(pu); + coop_abort(); + /* NOTREACHED */ +} + + +#ifdef __STDC__ +void +coop_abort () +#else +void +coop_abort () +#endif +{ + coop_t *old, *newthread; + + /* Wake up any threads that are waiting to join this one */ + if (coop_global_curr->joining) + { + while ((newthread = coop_qget ((coop_q_t *)(coop_global_curr->joining))) + != NULL) + { + coop_qput (&coop_global_runq, newthread); + } + free(coop_global_curr->joining); + } + + newthread = coop_next_runnable_thread(); + coop_all_qremove(&coop_global_allq, coop_global_curr); + old = coop_global_curr; + coop_global_curr = newthread; + QT_ABORT (coop_aborthelp, old, (void *)NULL, newthread->sp); +} + + +#ifdef __STDC__ +static void * +coop_aborthelp (qt_t *sp, void *old, void *null) +#else +static void * +coop_aborthelp (sp, old, null) + qt_t *sp; + void *old; + void *null; +#endif +{ + coop_t *oldthread = (coop_t *) old; + + free (oldthread->sto); + + /* "old" is freed in scm_threads_thread_die(). + Marking old->base NULL indicates that this thread is dead */ + + oldthread->base = NULL; + + return NULL; +} + + +#ifdef __STDC__ +void +coop_join(coop_t *t) +#else +void +coop_join() + coop_t *t; +#endif +{ + coop_t *old, *newthread; + + /* Check if t is already finished */ + if (t->base == NULL) + return; + + /* Create a join list if necessary */ + if (t->joining == NULL) + { + t->joining = malloc(sizeof(coop_q_t)); + coop_qinit((coop_q_t *) t->joining); + } + + newthread = coop_next_runnable_thread(); + old = coop_global_curr; + coop_global_curr = newthread; + QT_BLOCK (coop_yieldhelp, old, (coop_q_t *) t->joining, newthread->sp); +} + +#ifdef __STDC__ +void +coop_yield() +#else +void +coop_yield() +#endif +{ + coop_t *old = NULL; + coop_t *newthread; + + newthread = coop_next_runnable_thread(); + + /* There may be no other runnable threads. Return if this is the + case. */ + if (newthread == NULL) + return; + + old = coop_global_curr; + + coop_global_curr = newthread; + QT_BLOCK (coop_yieldhelp, old, &coop_global_runq, newthread->sp); +} + + +#ifdef __STDC__ +static void * +coop_yieldhelp (qt_t *sp, void *old, void *blockq) +#else +static void * +coop_yieldhelp (sp, old, blockq) + qt_t *sp; + void *old; + void *blockq; +#endif +{ + ((coop_t *)old)->sp = sp; + coop_qput ((coop_q_t *)blockq, (coop_t *)old); + return NULL; +} + +/* Replacement for the system's sleep() function. Does the right thing + for the process - but not for the system (it busy-waits) */ + +#ifdef __STDC__ +static void * +coop_sleephelp (qt_t *sp, void *old, void *blockq) +#else +static void * +coop_sleephelp (sp, old, bolckq) + qt_t *sp; + void *old; + void *blockq; +#endif +{ + ((coop_t *)old)->sp = sp; + /* old is already on the sleep queue - so there's no need to + do anything extra here */ + return NULL; +} + +#ifdef __STDC__ +unsigned +sleep (unsigned s) +#else +unsigned +sleep (s) + unsigned s; +#endif +{ + coop_t *newthread, *old; + time_t now = time(NULL); + coop_global_curr->wakeup_time = now + s; + + /* Put the current thread on the sleep queue */ + coop_qput (&coop_global_sleepq, coop_global_curr); + + newthread = coop_next_runnable_thread(); + + /* If newthread is the same as the sleeping thread, do nothing */ + if (newthread == coop_global_curr) + return s; + + old = coop_global_curr; + + coop_global_curr = newthread; + QT_BLOCK (coop_sleephelp, old, NULL, newthread->sp); + + return s; +} diff --git a/libguile/fsu-pthreads.h b/libguile/fsu-pthreads.h new file mode 100644 index 000000000..58122e5a5 --- /dev/null +++ b/libguile/fsu-pthreads.h @@ -0,0 +1,166 @@ +/* Copyright (C) 1995, 1996 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + + +#ifndef SCM_FSU_PTHREADS_H +#define SCM_FSU_PTHREADS_H + +#define PTHREAD_KERNEL +#include <pthread.h> + +/* Identify where the stack pointer can be found in a jmpbuf. + */ + +#if defined(__sparc_setjmp_h) +# define THREAD_SP machdep_data.machdep_state[2] +#endif + +#if defined(linux) +# define THREAD_SP machdep_data.machdep_state[0].__sp +#endif + +#if defined(sgi) +# define THREAD_SP machdep_data.machdep_state[JB_SP] +#endif + +/* ...define THREAD_SP for your architecture here... + */ + +#if !defined(THREAD_SP) +--> where is your stack pointer? +#endif + + + +#define PTHREAD_MAX_PRIORITY 64 + + + +/* Boost the priority of this thread so that it is the only + one running. PTHREAD_MAX_PRIORITY is reserved for this + purpose */ + +#define SCM_THREAD_CRITICAL_SECTION_START \ + struct sched_param param; \ + int previous_prio; \ + int policy; \ + pthread_getschedparam(pthread_self(), &policy, ¶m); \ + previous_prio = param.prio; \ + param.prio = PTHREAD_MAX_PRIORITY; \ + pthread_setschedparam(pthread_self(), policy, ¶m) + +#define SCM_THREAD_CRITICAL_SECTION_END \ + param.prio = previous_prio; \ + pthread_setschedparam(pthread_self(), policy, ¶m) + +#define SCM_THREAD_INITIALIZE_STORAGE \ + scm_threads_init_mit_pthreads () + + + +#define SCM_NO_CRITICAL_SECTION_OWNER 0 + +#define SCM_DEFER_INTS \ +{ \ + SCM_IASSERT(scm_critical_section_owner != pthread_self()); \ + pthread_mutex_lock(&scm_critical_section_mutex); \ + scm_critical_section_owner = pthread_self(); \ + scm_ints_disabled = 1; \ +} + +#define SCM_ALLOW_INTS \ +{ \ + SCM_IASSERT(scm_critical_section_owner == pthread_self()); \ + scm_ints_disabled = 0; \ + scm_critical_section_owner = SCM_NO_CRITICAL_SECTION_OWNER; \ + pthread_mutex_unlock(&scm_critical_section_mutex); \ + SCM_CHECK_INTS; \ +} + +#define SCM_REDEFER_INTS \ +{ \ + if ((scm_critical_section_owner != pthread_self()) || \ + (scm_critical_section_owner == SCM_NO_CRITICAL_SECTION_OWNER)) \ + { \ + pthread_mutex_lock(&scm_critical_section_mutex); \ + scm_critical_section_owner = pthread_self(); \ + } \ + ++scm_ints_disabled; \ +} + +#define SCM_REALLOW_INTS \ +{ \ + SCM_IASSERT(scm_critical_section_owner == pthread_self()); \ + --scm_ints_disabled; \ + if (!scm_ints_disabled) \ + { \ + scm_critical_section_owner = SCM_NO_CRITICAL_SECTION_OWNER; \ + pthread_mutex_unlock(&scm_critical_section_mutex); \ + SCM_CHECK_INTS; \ + } \ +} + +*fixme* +#define scm_root ((scm_root_state *) pthread_self()->prots) +#define scm_set_root(new_root) (pthread_self()->prots = (new_root)) + + + +void scm_threads_init_mit_pthreads (); + +typedef struct QUEUE { + struct QUEUE *flink, *blink; +} queue; + +extern pthread_mutex_t scm_critical_section_mutex; +extern pthread_t scm_critical_section_owner; + +/* Key to thread specific data */ +extern pthread_key_t info_key; + +struct scm_pthread_create_info_type +{ + SCM thunk; + SCM error; + SCM *prots; +} scm_pthread_create_info; + +#endif diff --git a/libguile/libguile.h b/libguile/libguile.h index a15ff4143..a35a09b11 100644 --- a/libguile/libguile.h +++ b/libguile/libguile.h @@ -122,7 +122,7 @@ #include "libguile/vports.h" #include "libguile/weaks.h" #ifdef USE_THREADS -#include "libguile/../threads/threads.h" +#include "libguile/threads.h" #endif diff --git a/libguile/mit-pthreads.c b/libguile/mit-pthreads.c new file mode 100644 index 000000000..d58912c39 --- /dev/null +++ b/libguile/mit-pthreads.c @@ -0,0 +1,495 @@ +/* Copyright (C) 1995, 1996 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + + +typedef struct scm_pthread_info { + queue q; /* the dequeue on which this structure exists */ + /* reqired to be the first element */ + pthread_t thread; /* the corresponding thread structure */ + void *stack_top; /* the highest address in this thread's stack */ + scm_root_state *root; /* root for this thread */ +} scm_pthread_info; + +pthread_mutex_t scm_critical_section_mutex; +pthread_t scm_critical_section_owner; + +static queue infos = { &infos, &infos }; /* the dequeue of info structures */ + +/* Key to thread specific data */ +pthread_key_t info_key; + +#ifdef __STDC__ +size_t +scm_threads_free_thread (SCM t) +#else +size_t +scm_threads_free_thread (t) + SCM t; +#endif +{ + scm_must_free (SCM_THREAD_DATA (t)); + return sizeof (pthread_t); +} + +#ifdef __STDC__ +size_t +scm_threads_free_mutex (SCM m) +#else +size_t +scm_threads_free_mutex (m) + SCM m; +#endif +{ + pthread_mutex_destroy (SCM_MUTEX_DATA (m)); + scm_must_free (SCM_MUTEX_DATA (m)); + return sizeof (pthread_mutex_t); +} + +#ifdef __STDC__ +size_t +scm_threads_free_condvar (SCM c) +#else +size_t +scm_threads_free_condvar (c) + SCM c; +#endif +{ + pthread_cond_destroy (SCM_CONDVAR_DATA (c)); + scm_must_free (SCM_CONDVAR_DATA (c)); + return sizeof (pthread_cond_t); +} + +/* cleanup for info structure + */ +#ifdef __STDC__ +static void +scm_pthread_delete_info (void *ptr) +#else +static void +scm_pthread_delete_info (ptr) + void *ptr; +#endif +{ + scm_pthread_info *info = (scm_pthread_info *) ptr; + info->q.blink->flink = info->q.flink; + info->q.flink->blink = info->q.blink; + scm_must_free ((char *) info); +} + +#ifdef __STDC__ +void +scm_threads_init (SCM_STACKITEM *i) +#else +void +scm_threads_init (i) + SCM_STACKITEM *i; +#endif +{ + /* + * each info structure is made thread-specific, so that the cleanup + * mechanism can be used to reclaim the space in a timely fashion. + */ + pthread_key_create (&info_key, scm_pthread_delete_info); + + /* initialize various mutex variables */ + pthread_mutex_init (&scm_critical_section_mutex, NULL); + + /* + * create an info structure for the initial thread and push it onto + * the info dequeue + */ + { + scm_pthread_info *info; + info = (scm_pthread_info *) scm_must_malloc (sizeof (scm_pthread_info), + "threads_init"); + infos.flink = infos.blink = &info->q; + info->q.flink = info->q.blink = &infos; + info->thread = pthread_initial; + info->stack_top = (void *) i; + pthread_setspecific(info_key, info); + } + /* The root state pointer gets initialized in init.c. */ +} + +/* given some thread, find the corresponding info + */ +static scm_pthread_info *pthreads_find_info (pthread_t target) +{ + queue *ptr = infos.flink; + + while (ptr != &infos) + { + scm_pthread_info *info = (scm_pthread_info *) ptr; + + if (info->thread == target) + { + return (info); + } + ptr = ptr->flink; + } +} + +#ifdef __STDC__ +void +scm_threads_mark_stacks () +#else +void +scm_threads_mark_stacks () +#endif +{ + scm_pthread_info *info; + pthread_t thread; + int j; + + for (info = (scm_pthread_info *) infos.flink; + info != (scm_pthread_info *) &infos; + info = (scm_pthread_info *) info->q.flink) + { + thread = info->thread; + if (thread == pthread_run) + { + /* Active thread */ + /* stack_len is long rather than sizet in order to guarantee + that &stack_len is long aligned */ +#ifdef STACK_GROWS_UP + long stack_len = ((SCM_STACKITEM *) (&thread) - + (SCM_STACKITEM *) info->stack_top); + + /* Protect from the C stack. This must be the first marking + * done because it provides information about what objects + * are "in-use" by the C code. "in-use" objects are those + * for which the values from SCM_LENGTH and SCM_CHARS must remain + * usable. This requirement is stricter than a liveness + * requirement -- in particular, it constrains the implementation + * of scm_resizuve. + */ + SCM_FLUSH_REGISTER_WINDOWS; + /* This assumes that all registers are saved into the jmp_buf */ + setjmp (scm_save_regs_gc_mark); + scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark, + ((scm_sizet) sizeof scm_save_regs_gc_mark + / sizeof (SCM_STACKITEM))); + + scm_mark_locations (((size_t) info->stack_top, + (sizet) stack_len)); +#else + long stack_len = ((SCM_STACKITEM *) info->stack_top - + (SCM_STACKITEM *) (&thread)); + + /* Protect from the C stack. This must be the first marking + * done because it provides information about what objects + * are "in-use" by the C code. "in-use" objects are those + * for which the values from SCM_LENGTH and SCM_CHARS must remain + * usable. This requirement is stricter than a liveness + * requirement -- in particular, it constrains the implementation + * of scm_resizuve. + */ + SCM_FLUSH_REGISTER_WINDOWS; + /* This assumes that all registers are saved into the jmp_buf */ + setjmp (scm_save_regs_gc_mark); + scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark, + ((scm_sizet) sizeof scm_save_regs_gc_mark + / sizeof (SCM_STACKITEM))); + + scm_mark_locations ((SCM_STACKITEM *) &thread, + stack_len); +#endif + } + else + { + /* Suspended thread */ +#ifdef STACK_GROWS_UP + long stack_len = ((SCM_STACKITEM *) (thread->THREAD_SP) - + (SCM_STACKITEM *) info->stack_top); + + scm_mark_locations ((size_t)info->stack_top, + (sizet) stack_len); +#else + long stack_len = ((SCM_STACKITEM *) info->stack_top - + (SCM_STACKITEM *) (thread->THREAD_SP)); + + scm_mark_locations ((SCM_STACKITEM *) thread->machdep_data.machdep_state, + ((scm_sizet) sizeof (*thread->machdep_data.machdep_state) + / sizeof (SCM_STACKITEM))); + scm_mark_locations ((SCM_STACKITEM *) (size_t) thread->THREAD_SP, + stack_len); +#endif + } + + /* Mark this thread's root */ + scm_gc_mark (((scm_root_state *) info->root) -> handle); + } +} + +#ifdef __STDC__ +void * +launch_thread (void *p) +#else +void * +launch_thread (p) + void *p; +#endif +{ + /* The thread object will be GC protected by being a member of the + list given as argument to launch_thread. It will be marked + during the conservative sweep of the stack. */ + SCM args = (SCM) p; + pthread_attr_setcleanup (&pthread_self () -> attr, + NULL, + SCM_ROOT_STATE (SCM_CAR (args))); + scm_call_with_dynamic_root (SCM_CADDR (args), SCM_CADDDR (args)); + return NULL; +} + +#ifdef __STDC__ +SCM +scm_call_with_new_thread (SCM argl) +#else +SCM +scm_call_with_new_thread (argl) + SCM argl; +#endif +{ + SCM thread; + + /* Check arguments. */ + { + register SCM args = argl; + SCM thunk, handler; + SCM_ASSERT (SCM_NIMP (args), argl, SCM_WNA, s_call_with_new_thread); + thunk = SCM_CAR (args); + SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)), + thunk, + SCM_ARG1, + s_call_with_new_thread); + args = SCM_CDR (args); + SCM_ASSERT (SCM_NIMP (args), argl, SCM_WNA, s_call_with_new_thread); + handler = SCM_CAR (args); + SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (handler)), + handler, + SCM_ARG2, + s_call_with_new_thread); + SCM_ASSERT (SCM_NULLP (SCM_CDR (args)), argl, SCM_WNA, s_call_with_new_thread); + } + + /* Make new thread. */ + { + pthread_attr_t attr; + pthread_t t; + scm_pthread_info *info = + (scm_pthread_info *) scm_must_malloc (sizeof (scm_pthread_info), + "pthread_info"); + SCM root, old_winds; + + /* Unwind wind chain. */ + old_winds = scm_dynwinds; + scm_dowinds (SCM_EOL, scm_ilength (scm_root->dynwinds)); + + /* Allocate thread locals. */ + root = scm_make_root (scm_root->handle); + /* Make thread. */ + SCM_NEWCELL (thread); + SCM_DEFER_INTS; + SCM_SETCAR (thread, scm_tc16_thread); + argl = scm_cons2 (root, thread, argl); + + /* thread mustn't start until we've built the info struct */ + pthread_kernel_lock++; + + /* initialize and create the thread. */ + pthread_attr_init (&attr); + pthread_attr_setschedpolicy (&attr, SCHED_RR); + + pthread_create (&t, &attr, launch_thread, (void *) argl); + pthread_attr_destroy (&attr); + + /* push the info onto the dequeue */ + info->q.flink = infos.flink; + info->q.blink = &infos; + infos.flink->blink = &info->q; + infos.flink = &info->q; + /* pthread_create filled in the initial SP -- profitons-en ! */ + info->stack_top = (void *) (t->THREAD_SP); + info->thread = t; + info->root = SCM_ROOT_STATE (root); + SCM_SETCDR (thread, t); + SCM_ALLOW_INTS; + + /* we're now ready for the thread to begin */ + pthread_kernel_lock--; + + /* Return to old dynamic context. */ + scm_dowinds (old_winds, - scm_ilength (old_winds)); + } + + return thread; +} + +#ifdef __STDC__ +SCM +scm_join_thread (SCM t) +#else +SCM +scm_join_thread (t) + SCM t; +#endif +{ + void *value; + pthread_join (SCM_THREAD_DATA (t), &value); + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +scm_yield () +#else +SCM +scm_yield () +#endif +{ + pthread_yield (); + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +scm_make_mutex () +#else +SCM +scm_make_mutex () +#endif +{ + SCM m; + pthread_mutex_t *data = (pthread_mutex_t *) scm_must_malloc (sizeof (pthread_mutex_t), "mutex"); + SCM_NEWCELL (m); + SCM_DEFER_INTS; + SCM_SETCAR (m, scm_tc16_mutex); + SCM_SETCDR (m, data); + SCM_ALLOW_INTS; + pthread_mutex_init (SCM_MUTEX_DATA (m), NULL); + return m; +} + +#ifdef __STDC__ +SCM +scm_lock_mutex (SCM m) +#else +SCM +scm_lock_mutex (m) + SCM m; +#endif +{ + SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex); + pthread_mutex_lock (SCM_MUTEX_DATA (m)); + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +scm_unlock_mutex (SCM m) +#else +SCM +scm_unlock_mutex (m) + SCM m; +#endif +{ + SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m), m, SCM_ARG1, s_unlock_mutex); + pthread_mutex_unlock (SCM_MUTEX_DATA (m)); + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +scm_make_condition_variable () +#else +SCM +scm_make_condition_variable () +#endif +{ + SCM c; + pthread_cond_t *data = (pthread_cond_t *) scm_must_malloc (sizeof (pthread_cond_t), "condvar"); + SCM_NEWCELL (c); + SCM_DEFER_INTS; + SCM_SETCAR (c, scm_tc16_condvar); + SCM_SETCDR (c, data); + SCM_ALLOW_INTS; + pthread_cond_init (SCM_CONDVAR_DATA (c), NULL); + return c; +} + +#ifdef __STDC__ +SCM +scm_wait_condition_variable (SCM c, SCM m) +#else +SCM +scm_wait_condition_variable (c, m) + SCM c; + SCM m; +#endif +{ + SCM_ASSERT (SCM_NIMP (c) && SCM_CONDVARP (c), + c, + SCM_ARG1, + s_wait_condition_variable); + SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m), + m, + SCM_ARG2, + s_wait_condition_variable); + pthread_cond_wait (SCM_CONDVAR_DATA (m), SCM_MUTEX_DATA (c)); + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +scm_signal_condition_variable (SCM c) +#else +SCM +scm_signal_condition_variable (c) + SCM c; +#endif +{ + SCM_ASSERT (SCM_NIMP (c) && SCM_CONDVARP (c), + c, + SCM_ARG1, + s_signal_condition_variable); + pthread_cond_signal (SCM_CONDVAR_DATA (c)); + return SCM_BOOL_T; +} diff --git a/libguile/mit-pthreads.h b/libguile/mit-pthreads.h new file mode 100644 index 000000000..ea93c63d1 --- /dev/null +++ b/libguile/mit-pthreads.h @@ -0,0 +1,187 @@ +/* classes: h_files */ + +#ifndef MIT_PTHREADSH +#define MIT_PTHREADSH + +/* Copyright (C) 1996 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + + +#include "libguile/__scm.h" + +#define PTHREAD_KERNEL +#include <pthread.h> + +/* Identify where the stack pointer can be found in a jmpbuf. + */ + +/* Solaris 2.4 */ +#if defined(__sparc_setjmp_h) +# define THREAD_SP machdep_data.machdep_state[2] +#endif + +/* Solaris 2.5 */ +#if defined(__sparc) +#ifndef THREAD_SP +# define THREAD_SP machdep_data.machdep_state[2] +#endif +#endif + +#if defined(linux) +# define THREAD_SP machdep_data.machdep_state[0].__sp +#endif + +#if defined(sgi) +# define THREAD_SP machdep_data.machdep_state[JB_SP] +#endif + +/* ...define THREAD_SP for your architecture here... + */ + +#if !defined(THREAD_SP) +--> where is your stack pointer? +#endif + + + +/* Boost the priority of this thread so that it is the only + one running. PTHREAD_MAX_PRIORITY is reserved for this + purpose */ + +#define SCM_THREAD_CRITICAL_SECTION_START \ + struct sched_param param; \ + int previous_prio; \ + int policy; \ + pthread_getschedparam(pthread_self(), &policy, ¶m); \ + previous_prio = param.prio; \ + param.prio = PTHREAD_MAX_PRIORITY; \ + pthread_setschedparam(pthread_self(), policy, ¶m) + +#define SCM_THREAD_CRITICAL_SECTION_END \ + param.prio = previous_prio; \ + pthread_setschedparam(pthread_self(), policy, ¶m) + + + +#if 1 + +#define SCM_NO_CRITICAL_SECTION_OWNER 0 + +#define SCM_THREAD_DEFER pthread_kernel_lock++ +#define SCM_THREAD_ALLOW pthread_kernel_lock-- + +#define SCM_THREAD_REDEFER pthread_kernel_lock++ +#define SCM_THREAD_REALLOW_1 pthread_kernel_lock-- +#define SCM_THREAD_REALLOW_2 \ +{ \ + scm_critical_section_owner = SCM_NO_CRITICAL_SECTION_OWNER; \ + pthread_mutex_unlock(&scm_critical_section_mutex); \ +} + +#else + +#define SCM_NO_CRITICAL_SECTION_OWNER 0 + +#define SCM_THREAD_DEFER \ +{ \ + pthread_mutex_lock (&scm_critical_section_mutex); \ + scm_critical_section_owner = pthread_self(); \ +} + +#define SCM_THREAD_ALLOW \ +{ \ + scm_critical_section_owner = SCM_NO_CRITICAL_SECTION_OWNER; \ + pthread_mutex_unlock (&scm_critical_section_mutex); \ +} + +#define SCM_THREAD_REDEFER \ +{ \ + if ((scm_critical_section_owner != pthread_self()) || \ + (scm_critical_section_owner == SCM_NO_CRITICAL_SECTION_OWNER)) \ + { \ + pthread_mutex_lock(&scm_critical_section_mutex); \ + scm_critical_section_owner = pthread_self(); \ + } \ +} + +#define SCM_THREAD_REALLOW_1 +#define SCM_THREAD_REALLOW_2 \ +{ \ + scm_critical_section_owner = SCM_NO_CRITICAL_SECTION_OWNER; \ + pthread_mutex_unlock (&scm_critical_section_mutex); \ +} + +#endif + +#define SCM_THREAD_SWITCHING_CODE + +#define SCM_THREAD_LOCAL_DATA (pthread_self () -> attr.arg_attr) +#define SCM_SET_THREAD_LOCAL_DATA(new_root) \ +{ \ + pthread_t t = pthread_self (); \ + void *r = (new_root); \ + pthread_attr_setcleanup (&t -> attr, NULL, r); \ + pthreads_find_info (t) -> root = r; \ +} + + + + +void scm_threads_init_mit_pthreads (); + +typedef struct QUEUE { + struct QUEUE *flink, *blink; +} queue; + +extern pthread_mutex_t scm_critical_section_mutex; +extern pthread_t scm_critical_section_owner; + +/* Key to thread specific data */ +extern pthread_key_t info_key; + +struct scm_pthread_create_info_type +{ + SCM thunk; + SCM error; + SCM *prots; +} scm_pthread_create_info; + +#endif /* MIT_PTHREADSH */ diff --git a/libguile/threads.c b/libguile/threads.c new file mode 100644 index 000000000..f1c826f2a --- /dev/null +++ b/libguile/threads.c @@ -0,0 +1,161 @@ +/* Copyright (C) 1995, 1996 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + + +#include <stdio.h> +#include "_scm.h" +#include "dynwind.h" +#include "smob.h" + +#include "threads.h" + + + +long scm_tc16_thread; + +long scm_tc16_mutex; + +long scm_tc16_condvar; + + +/* Scheme-visible thread functions. */ + +#ifdef USE_COOP_THREADS +SCM_PROC(s_single_thread_p, "single-active-thread?", 0, 0, 0, scm_single_thread_p); +#endif +SCM_PROC(s_yield, "yield", 0, 0, 0, scm_yield); +SCM_PROC(s_call_with_new_thread, "call-with-new-thread", 0, 0, 1, scm_call_with_new_thread); +SCM_PROC(s_join_thread, "join-thread", 1, 0, 0, scm_join_thread); +SCM_PROC(s_make_mutex, "make-mutex", 0, 0, 0, scm_make_mutex); +SCM_PROC(s_lock_mutex, "lock-mutex", 1, 0, 0, scm_lock_mutex); +SCM_PROC(s_unlock_mutex, "unlock-mutex", 1, 0, 0, scm_unlock_mutex); +SCM_PROC(s_make_condition_variable, "make-condition-variable", 0, 0, 0, scm_make_condition_variable); +SCM_PROC(s_wait_condition_variable, "wait-condition-variable", 2, 0, 0, scm_wait_condition_variable); +SCM_PROC(s_signal_condition_variable, "signal-condition-variable", 1, 0, 0, scm_signal_condition_variable); + + + +#ifdef USE_MIT_PTHREADS +#include "mit-pthreads.c" +#endif + +#ifdef USE_COOP_THREADS +#include "coop-threads.c" +#endif + +static int +print_thread (exp, port, pstate) + SCM exp; + SCM port; + scm_print_state *pstate; +{ + scm_gen_puts (scm_regular_string, "#<thread ", port); + scm_intprint (SCM_CDR (exp), 16, port); + scm_gen_putc ('>', port); + return 1; +} + +static scm_smobfuns thread_smob = +{ + scm_mark0, + scm_threads_free_thread, + print_thread, + 0 +}; + +static int +print_mutex (exp, port, pstate) + SCM exp; + SCM port; + scm_print_state *pstate; +{ + scm_gen_puts (scm_regular_string, "#<mutex ", port); + scm_intprint (SCM_CDR (exp), 16, port); + scm_gen_putc ('>', port); + return 1; +} + +static scm_smobfuns mutex_smob = +{ + scm_mark0, + scm_threads_free_mutex, + print_mutex, + 0 +}; + +static int +print_condvar (exp, port, pstate) + SCM exp; + SCM port; + scm_print_state *pstate; +{ + scm_gen_puts (scm_regular_string, "#<condition-variable ", port); + scm_intprint (SCM_CDR (exp), 16, port); + scm_gen_putc ('>', port); + return 1; +} + +static scm_smobfuns condvar_smob = +{ + scm_mark0, + scm_threads_free_condvar, + print_condvar, + 0 +}; + + + +#ifdef __STDC__ +void +scm_init_threads (SCM_STACKITEM *i) +#else +void +scm_init_threads (i) + SCM_STACKITEM *i; +#endif +{ + scm_tc16_thread = scm_newsmob (&thread_smob); + scm_tc16_mutex = scm_newsmob (&mutex_smob); + scm_tc16_condvar = scm_newsmob (&condvar_smob); +#include "threads.x" + /* Initialize implementation specific details of the threads support */ + scm_threads_init (i); +} diff --git a/libguile/threads.h b/libguile/threads.h new file mode 100644 index 000000000..cebd28827 --- /dev/null +++ b/libguile/threads.h @@ -0,0 +1,91 @@ +/* classes: h_files */ + +#ifndef THREADSH +#define THREADSH + +/* Copyright (C) 1996 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + + +#include "libguile/__scm.h" +#include "libguile/procs.h" + +/* smob tags for the thread datatypes */ +extern long scm_tc16_thread; +extern long scm_tc16_mutex; +extern long scm_tc16_condvar; + +#define SCM_THREADP(obj) (scm_tc16_thread == SCM_TYP16 (obj)) +#define SCM_THREAD_DATA(obj) ((void *) SCM_CDR (obj)) + +#define SCM_MUTEXP(obj) (scm_tc16_mutex == SCM_TYP16 (obj)) +#define SCM_MUTEX_DATA(obj) ((void *) SCM_CDR (obj)) + +#define SCM_CONDVARP(obj) (scm_tc16_condvar == SCM_TYP16 (obj)) +#define SCM_CONDVAR_DATA(obj) ((void *) SCM_CDR (obj)) + +/* Initialize implementation specific details of the threads support */ +void scm_threads_init SCM_P ((SCM_STACKITEM *)); +void scm_threads_mark_stacks SCM_P ((void)); +void scm_init_threads SCM_P ((SCM_STACKITEM *)); + +/* */ +SCM scm_threads_make_mutex SCM_P ((void)); +SCM scm_threads_lock_mutex SCM_P ((SCM)); +SCM scm_threads_unlock_mutex SCM_P ((SCM)); +SCM scm_threads_monitor SCM_P ((void)); + +#if 0 +/* These don't work any more. */ +#ifdef USE_MIT_PTHREADS +#include "mit-pthreads.h" +#endif + +#ifdef USE_FSU_PTHREADS +#include "fsu-pthreads.h" +#endif +#endif + +#ifdef USE_COOP_THREADS +#include "libguile/coop-defs.h" +#endif + +#endif /* THREADSH */ |