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

Merge threads directory into libguile.

Browse source 
* 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.
This commit is contained in:
Jim Blandy 1997-04-15 01:34:36 +00:00
parent c520b64ca6
commit 7bfd3b9e94
17 changed files with 3388 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

251
libguile/ChangeLog-threads Normal file
View file

@ -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.

16
libguile/Makefile.am
View file

@ -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

18
libguile/Makefile.in
View file

@ -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)

4
libguile/_scm.h
View file

@ -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. */

1
libguile/configure.in
View file

@ -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.

149
libguile/coop-defs.h Normal file
View file

@ -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 */

439
libguile/coop-threads.c Normal file
View file

@ -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;
}

469
libguile/coop-threads.c.cygnus Normal file
View file

@ -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;
}

140
libguile/coop-threads.h Normal file
View file

@ -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 */

223
libguile/coop-threads.h.cygnus Normal file
View file

@ -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

588
libguile/coop.c Normal file
View file

@ -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;
}

166
libguile/fsu-pthreads.h Normal file
View file

@ -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, &param); \
previous_prio = param.prio; \
param.prio = PTHREAD_MAX_PRIORITY; \
pthread_setschedparam(pthread_self(), policy, &param)
#define SCM_THREAD_CRITICAL_SECTION_END \
param.prio = previous_prio; \
pthread_setschedparam(pthread_self(), policy, &param)
#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

2
libguile/libguile.h
View file

@ -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

495
libguile/mit-pthreads.c Normal file
View file

@ -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;
}

187
libguile/mit-pthreads.h Normal file
View file

@ -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, &param); \
previous_prio = param.prio; \
param.prio = PTHREAD_MAX_PRIORITY; \
pthread_setschedparam(pthread_self(), policy, &param)
#define SCM_THREAD_CRITICAL_SECTION_END \
param.prio = previous_prio; \
pthread_setschedparam(pthread_self(), policy, &param)
#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 */

161
libguile/threads.c Normal file
View file

@ -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);
}

91
libguile/threads.h Normal file
View file

@ -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 */