summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ChangeLog28
-rw-r--r--HACKING665
-rw-r--r--NEWS13
-rw-r--r--configure.in26
-rw-r--r--libguile/ChangeLog64
-rw-r--r--libguile/gen-scmconfig.c5
-rw-r--r--libguile/gen-scmconfig.h.in1
-rw-r--r--libguile/i18n.c8
-rw-r--r--libguile/null-threads.h3
-rw-r--r--libguile/pthread-threads.h9
-rw-r--r--libguile/read.c7
-rw-r--r--libguile/scmsigs.c50
-rw-r--r--libguile/scmsigs.h8
-rw-r--r--libguile/threads.c133
-rw-r--r--libguile/threads.h9
-rw-r--r--test-suite/ChangeLog22
-rw-r--r--test-suite/standalone/Makefile.am4
-rw-r--r--test-suite/standalone/test-conversion.c54
-rw-r--r--test-suite/tests/reader.test6
-rw-r--r--test-suite/tests/threads.test60
20 files changed, 1120 insertions, 55 deletions
diff --git a/ChangeLog b/ChangeLog
index 18f16fd7b..d55a14aae 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,31 @@
+2007-10-20 Ludovic Courtès <ludo@gnu.org>
+
+ * THANKS: Add Julian.
+
+2007-10-20 Julian Graham <joolean@gmail.com>
+
+ * NEWS: Mention thread cancellation and cleanup API.
+
+2007-10-17 Ludovic Courtès <ludo@gnu.org>
+
+ * NEWS: Mention reader bug-fix.
+
+2007-10-16 Ludovic Courtès <ludo@gnu.org>
+
+ Guile 1.8.3 released.
+
+ * GUILE-VERSION (GUILE_MICRO_VERSION): Incremented.
+ (LIBGUILE_INTERFACE_REVISION): Incremented.
+
+2007-10-10 Ludovic Courtès <ludo@gnu.org>
+
+ * configure.in (SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT):
+ New substituted variable.
+ Use `-Werror' when using GCC and checking for
+ `PTHREAD_ONCE_INIT'. Add check for braces around
+ `PTHREAD_MUTEX_INITIALIZER'.
+ * NEWS: Mention build fix for IRIX.
+
2007-10-02 Ludovic Courtès <ludo@gnu.org>
* NEWS: Mention `(ice-9 slib)' fix and threading fix.
diff --git a/HACKING b/HACKING
new file mode 100644
index 000000000..ebd78e45c
--- /dev/null
+++ b/HACKING
@@ -0,0 +1,665 @@
+-*-text-*-
+Guile Hacking Guide
+Copyright (c) 1996, 1997, 1998, 1999, 2000, 2001, 2002 Free software Foundation, Inc.
+
+ Permission is granted to anyone to make or distribute verbatim copies
+ of this document as received, in any medium, provided that the
+ copyright notice and permission notice are preserved,
+ and that the distributor grants the recipient permission
+ for further redistribution as permitted by this notice.
+
+ Permission is granted to distribute modified versions
+ of this document, or of portions of it,
+ under the above conditions, provided also that they
+ carry prominent notices stating who last changed them,
+ and that any new or changed statements about the activities
+ of the Free Software Foundation are approved by the Foundation.
+
+
+What to Hack =========================================================
+
+You can hack whatever you want, thank GNU.
+
+However, to see what others have indicated as their interest (and avoid
+potential wasteful duplication of effort), see file TODO. Note that
+the version you find may be out of date; a CVS checkout is recommended:
+see below for details (see also the files ANON-CVS and SNAPSHOTS).
+
+It's also a good idea to join the guile-devel@gnu.org mailing list.
+See http://www.gnu.org/software/guile/mail/mail.html for more info.
+
+
+Hacking It Yourself ==================================================
+
+When Guile is obtained from CVS, a few extra steps must be taken
+before the usual configure, make, make install. You will need to have
+up-to-date versions of the tools listed below, correctly installed.
+i.e., they must be found in the current PATH and not shadowed or
+otherwise broken by files left behind from other versions.
+
+"up-to-date" means the latest released versions at the time that Guile
+was obtained from CVS. Sometimes older or newer versions will work.
+(See below for versions to avoid.)
+
+Then you must run the autogen.sh script, as described below.
+
+In case of problems, it may be worth getting a fresh copy of Guile
+from CVS: synchronisation problems have been known to occur
+occasionally.
+
+The same procedure can be used to regenerate the files in released
+versions of Guile. In that case the headers of the original generated
+files (e.g., configure, Makefile.in, ltmain.sh) can be used to
+identify which tool versions may be required.
+
+Autoconf --- a system for automatically generating `configure'
+ scripts from templates which list the non-portable features a
+ program would like to use. Available in
+ "ftp://ftp.gnu.org/pub/gnu/autoconf"
+
+Automake --- a system for automatically generating Makefiles that
+ conform to the (rather Byzantine) GNU coding standards. The
+ nice thing is that it takes care of hairy targets like 'make
+ dist' and 'make distclean', and automatically generates
+ Makefile dependencies. Automake is available in
+ "ftp://ftp.gnu.org/pub/gnu/automake"
+
+libtool --- a system for managing the zillion hairy options needed
+ on various systems to produce shared libraries. Available in
+ "ftp://ftp.gnu.org/pub/gnu/libtool"
+
+gettext --- a system for rigging a program so that it can output its
+ messages in the local tongue. Guile presently only exports
+ the gettext functionality to Scheme, it does not use it
+ itself.
+
+flex --- a scanner generator. It's probably not essential to have the
+ latest version.
+
+One false move and you will be lost in a little maze of automatically
+generated files, all different.
+
+Here is the authoritative list of tool/version/platform tuples that
+have been known to cause problems, and a short description of the problem.
+
+- automake 1.4 adds extraneous rules to the top-level Makefile if
+ you specify specific Makefiles to rebuild on the command line.
+
+- automake 1.4-p4 (debian "1:1.4-p4-1.1") all platforms
+ automake "include" facility does not recognize filenames w/ "-".
+
+- libtool 1.4 uses acconfig.h, which is deprecated by newest autoconf
+ (which constructs the equivalent through 3rd arg of AC_DEFINE forms).
+
+- autoreconf from autoconf prior to 2.59 will run gettextize, which
+ will mess up the Guile tree.
+
+- (add here.)
+
+
+Sample GDB Initialization File=========================================
+
+Here is a sample .gdbinit posted by Bill Schottstaedt (modified to
+use `set' instead of `call' in some places):
+
+ define gp
+ set gdb_print($arg0)
+ print gdb_output
+ end
+ document gp
+ Executes (object->string arg)
+ end
+
+ define ge
+ call gdb_read($arg0)
+ call gdb_eval(gdb_result)
+ set gdb_print(gdb_result)
+ print gdb_output
+ end
+ document ge
+ Executes (print (eval (read arg))): ge "(+ 1 2)" => 3
+ end
+
+ define gh
+ call g_help(scm_str2symbol($arg0), 20)
+ set gdb_print($1)
+ print gdb_output
+ end
+ document gh
+ Prints help string for arg: gh "enved-target"
+ end
+
+Bill further writes:
+
+ so in gdb if you see something useless like:
+
+ #32 0x081ae8f4 in scm_primitive_load (filename=1112137128) at load.c:129
+
+ You can get the file name with gp:
+
+ (gdb) gp 1112137128
+ $1 = 0x40853fac "\"/home/bil/test/share/guile/1.5.0/ice-9/session.scm\""
+
+
+Contributing Your Changes ============================================
+
+- If you have put together a change that meets the coding standards
+described below, we encourage you to submit it to Guile. The best
+place to post it is guile-devel@gnu.org. Please don't send it
+directly to me; I often don't have time to look things over. If you
+have tested your change, then you don't need to be shy.
+
+- Please submit patches using either context or unified diffs (diff -c
+or diff -u). Don't include a patch for ChangeLog; such patches don't
+apply cleanly, since we've probably changed the top of ChangeLog too.
+Instead, provide the unaltered text at the top of your patch.
+
+- For proper credit, also make sure you update the AUTHORS file
+(for new files for which you've assigned copyright to the FSF), or
+the THANKS file (for everything else).
+
+Please don't include patches for generated files like configure,
+aclocal.m4, or any Makefile.in. Such patches are often large, and
+we're just going to regenerate those files anyway.
+
+
+CVS conventions ======================================================
+
+- We use CVS to manage the Guile sources. The repository lives on
+subversions.gnu.org, in /cvs; you will need an
+account on that machine to access the repository. Also, for security
+reasons, subversions presently only supports CVS connections via the SSH
+protocol, so you must first install the SSH client. Then, you should
+set your CVS_RSH environment variable to ssh, and use the following as
+your CVS root:
+
+ :ext:USER@subversions.gnu.org:/cvs
+
+Either set your CVSROOT environment variable to that, or give it as
+the value of the global -d option to CVS when you check out a working
+directory.
+
+For more information on SSH, see http://www.openssh.com.
+
+The Guile sources live in several modules:
+
+ - guile-core --- the interpreter, QuickThreads, and ice-9
+ - guile-tcltk --- the Guile/Tk interface
+ - guile-tk --- the new Guile/Tk interface, based on STk's modified Tk
+ - guile-rgx-ctax --- the Guile/Rx interface, and the ctax implementation
+ - guile-scsh --- the port of SCSH to guile, talk to Gary Houston
+ - guile-www --- A Guile module for making HTTP requests.
+ - guile-statprof --- an experimental statistical profiler.
+
+There is a mailing list for CVS commit messages; see README for details.
+
+- The guile-core tree is now versioned similarly to the Linux kernel.
+Guile now always uses three numbers to represent the version,
+i.e. "1.6.5". The first number, 1, is the major version number, the
+second number, 6, is the minor version number, and the third number,
+5, is the micro version number. Changes in major version number
+indicate major changes in Guile.
+
+Minor version numbers that are even denote stable releases, and odd
+minor version numbers denote development versions (which may be
+unstable). The micro version number indicates a minor sub-revision of
+a given MAJOR.MINOR release.
+
+- A default CVS checkout will get the current unstable development
+tree. However, for each stable release, a CVS branch is created so
+that release (and ongoing maintenance) of the stable version can
+proceed independent of the development of the next unstable version.
+To check out a particular stable branch, you just need to specify "-r
+branch_release-X-Y" to your CVS checkout command (or to any update).
+For example, if you wanted to check out the 1.6 stable branch, you
+would specify "-r branch_release-1-6".
+
+So, for example, during a normal development cycle, work will proceed
+on an unstable version, say 1.5.X, until it is decided that it's time
+for a stable release. At that point, a branch named
+branch_release-1-6 will be created, and the version numbers on the
+HEAD of the CVS tree (the trunk, i.e. what you get by default), will
+be changed to reflect the new unstable version 1.7.X. Then unstable
+development will proceed on the unstable version, while the stable
+1.5.X branch is fixed up for the eventual 1.6.0 release.
+
+Anytime you want to yank an existing checked out tree to the stable
+branch, you can run a command like this:
+
+ cvs -z3 update -r branch_release-1-6 -Pd
+
+This will yank the working directory over on to the stable release
+branch. Note that this directory will track that branch from then on
+unless you do something to yank it back to the main (unstable) trunk.
+
+To go back to the unstable branch, you can use
+
+ cvs -z3 update -A -Pd
+
+Note that in either case, you should probably make sure you've
+commited or removed all local changes before running the commands or
+you're likely to have some unexpected results.
+
+Finally note that one approach, should you need to work on both
+branches, is to keep two trees checked out, one stable, the other
+unstable and you can work in whichever is appropriate.
+
+To save some initial bandwidth, you can check out either the stable
+tree or the unstable tree, and then do something like this:
+
+ cp -a core-unstable core-1.5
+ cd core-1.5
+ cvs -z3 update -r branch_release-1-6 -Pd
+
+- The stable and unstable CVS trees are distinct, and no changes will
+automatically propagate between them. If you make changes that need
+to show up both places, you'll need to apply the changes both places.
+You *might* be able to do this with a cvs command, but often you'll
+probably need to apply the changes by hand or risk migrating
+superfluous modifications between the two versions. This is
+particularly important when moving a change from the unstable branch
+to the stable branch.
+
+- In general, please don't be adventurous with the stable branch. We
+mostly want bugfixes, documentation improvements, build improvements,
+etc., though exceptions will doubtless exist.
+
+- There are a few CVS tagging conventions which follow the Scheme
+convention that dashes are used to separate words within a single
+symbol, and so dashes bind more tightly than underscores. This means
+that foo-bar_baz-bax indicates that foo-bar is somehow separate from
+baz-bax. The conventions are as follows:
+
+ Branch root tags:
+ -----------------
+ anytime just before you create a branch it's a good
+ idea to create a normal tag so that you can refer to the branch point
+ on the main trunk as well as on the branch. So please use a tag of
+ the form
+
+ branch-root-release-1-X
+
+ or more generally, for other non-release branches:
+
+ branch-root_FOO
+
+ Branch tags:
+ ------------
+ for the branch tag itself please use
+
+ branch_release-1-6
+
+ or more generally, for other non-release branches:
+
+ branch_FOO
+
+ Merge tags:
+ -----------
+ Whenever you're merging a branch back into the trunk (or into another
+ branch repeatedly) you need to tag the branch each time you merge. If
+ you don't do that, you won't be able to merge repeatedly without
+ possibly tedious conflicts. For those tags, we suggest:
+
+ branch-merge_SOME-FOO_to_SOME-BAR_1
+ branch-merge_SOME-FOO_to_SOME-BAR_2
+ ..
+
+ As an example, SOME-BAR might be trunk, or even perhaps another branch
+ like branch-mvo-super-fixes :>
+
+ More mundanely, you might have
+
+ branch-merge_release-1-6_to_trunk_1
+
+ (Merging the stable branch to the trunk like this
+ will probably be much more common, when it happens, than the
+ reverse for the reasons mentioned above.
+
+ Release tags:
+ -------------
+ When releasing a new version of guile, please use:
+
+ release_X-Y-Z
+
+ i.e.
+
+ release_1-6-0
+
+- If you hack on a stable branch, please apply any relevant patches or
+fixes to the current unstable version (the main CVS trunk) as well.
+Similarly, please back-port any important fixes to the unstable CVS
+tree to the current stable branch.
+
+- We check Makefile.am and configure.in files into CVS, but the
+"autogen.sh" script must be run from the top-level to generate the
+actual "configure" script that then must be run to create the various
+Makefile-s to build guile. The general rule is that you should be able
+to check out a working directory of Guile from CVS, and then type
+"./autogen.sh", then "configure", and finally "make". No
+automatically generated files should be checked into the CVS
+repository.
+
+- The .cvsignore file is contained in the repository, to provide a
+reasonable list of auto-generated files that should not be checked in.
+This, however, prohibits one from having local additions to the
+.cvsignore file (yes, you can modify it and never check it in, but
+that doesn't seem to be a good solution to me). To get around this
+problem, you might want to patch your cvs program so that it uses a
+.cvsignore-local file (say) instead of the one from the repository. A
+patch for this can be found at the very end of this file.
+
+- (Automake 1.4 only) Be sure to run automake at the top of the tree
+with no arguments. Do not use `automake Makefile' to regenerate
+specific Makefile.in files, and do not trust the Makefile rules to
+rebuild them when they are out of date. Automake 1.4 will add
+extraneous rules to the top-level Makefile if you specify specific
+Makefiles to rebuild on the command line. Running the command
+`autoreconf --force' should take care of everything correctly.
+
+- Make sure your changes compile and work, at least on your own
+machine, before checking them into the main branch of the Guile
+repository. A good way for testing this is to run "make distcheck".
+If you really need to check in untested changes, make a branch.
+
+- Include each log entry in both the ChangeLog and in the CVS logs.
+If you're using Emacs, the pcl-cvs interface to CVS has features to
+make this easier; it checks the ChangeLog, and generates good default
+CVS log entries from that.
+
+
+Coding standards =====================================================
+
+- Before contributing larger amounts of code to Guile, please read the
+documents in `guile-core/devel/policy' in the CVS source tree.
+
+- As for any part of Project GNU, changes to Guile should follow the
+GNU coding standards. The standards are available via anonymous FTP
+from prep.ai.mit.edu, as /pub/gnu/standards/standards.texi and
+make-stds.texi.
+
+- The Guile tree should compile without warnings under the following
+GCC switches, which are the default in the current configure script:
+
+ -O2 -Wall -Wpointer-arith -Wmissing-prototypes
+
+To make sure of this, you can use the --enable-error-on-warning option
+to configure. This option will make GCC fail if it hits a warning.
+
+Note that the warnings generated vary from one version of GCC to the
+next, and from one architecture to the next (apparently). To provide
+a concrete common standard, Guile should compile without warnings from
+GCC 2.7.2.3 in a Red Hat 5.2 i386 Linux machine. Furthermore, each
+developer should pursue any additional warnings noted by on their
+compiler. This means that people using more stringent compilers will
+have more work to do, and assures that everyone won't switch to the
+most lenient compiler they can find. :)
+
+Note also that EGCS (as of November 3 1998) doesn't handle the
+`noreturn' attribute properly, so it doesn't understand that functions
+like scm_error won't return. This may lead to some silly warnings
+about uninitialized variables. You should look into these warnings to
+make sure they are indeed spurious, but you needn't correct warnings
+caused by this EGCS bug.
+
+- If you add code which uses functions or other features that are not
+entirely portable, please make sure the rest of Guile will still
+function properly on systems where they are missing. This usually
+entails adding a test to configure.in, and then adding #ifdefs to your
+code to disable it if the system's features are missing.
+
+- The normal way of removing a function, macro or variable is to mark
+it as "deprecated", keep it for a while, and remove it in a later
+release. If a function or macro is marked as "deprecated" it
+indicates that people shouldn't use it in new programs, and should try
+to remove it in old. Make sure that an alternative exists unless it
+is our purpose to remove functionality. Don't deprecate definitions
+if it is unclear when they will be removed. (This is to ensure that a
+valid way of implementing some functionality always exists.)
+
+When deprecating a definition, always follow this procedure:
+
+1. Mark the definition using
+
+ #if (SCM_DEBUG_DEPRECATED == 0)
+ ...
+ #endif
+
+ or, for Scheme code, wrap it using
+
+ (begin-deprecated
+ ...)
+
+2. Make the deprecated code issue a warning when it is used, by using
+ scm_c_issue_deprecation_warning (in C) or issue-deprecation-warning
+ (in Scheme).
+
+3. Write a comment at the definition explaining how a programmer can
+ manage without the deprecated definition.
+
+4. Add an entry that the definition has been deprecated in NEWS and
+ explain what do do instead.
+
+5. In file TODO, there is a list of releases with reminders about what
+ to do at each release. Add a reminder about the removal of the
+ deprecated defintion at the appropriate release.
+
+- Please write log entries for functions written in C under the
+functions' C names, and write log entries for functions written in
+Scheme under the functions' Scheme names. Please don't do this:
+
+ * procs.c, procs.h (procedure-documentation): Moved from eval.c.
+
+Entries like this make it harder to search the ChangeLogs, because you
+can never tell which name the entry will refer to. Instead, write this:
+
+ * procs.c, procs.h (scm_procedure_documentation): Moved from eval.c.
+
+Changes like adding this line are special:
+
+ SCM_PROC (s_map_in_order, "map-in-order", 2, 0, 1, scm_map);
+
+Since the change here is about the name itself --- we're adding a new
+alias for scm_map that guarantees the order in which we process list
+elements, but we're not changing scm_map at all --- it's appropriate
+to use the Scheme name in the log entry.
+
+- There's no need to keep a change log for a ChangeLog file. For any
+other kind of file (including documentation, since our documentation
+is indeed precisely engineered -- we surpass GNU standards here), add
+an appropriate ChangeLog entry when you change it. Simple!
+
+- Make sure you have papers from people before integrating their
+changes or contributions. This is very frustrating, but very
+important to do right. From maintain.texi, "Information for
+Maintainers of GNU Software":
+
+ When incorporating changes from other people, make sure to follow the
+ correct procedures. Doing this ensures that the FSF has the legal
+ right to distribute and defend GNU software.
+
+ For the sake of registering the copyright on later versions ofthe
+ software you need to keep track of each person who makes significant
+ changes. A change of ten lines or so, or a few such changes, in a
+ large program is not significant.
+
+ *Before* incorporating significant changes, make sure that the person
+ has signed copyright papers, and that the Free Software Foundation has
+ received them.
+
+If you receive contributions you want to use from someone, let me know
+and I'll take care of the administrivia. Put the contributions aside
+until we have the necessary papers.
+
+Once you accept a contribution, be sure to keep the files AUTHORS and
+THANKS uptodate.
+
+- When you make substantial changes to a file, add the current year to
+the list of years in the copyright notice at the top of the file.
+
+- When you get bug reports or patches from people, be sure to list
+them in THANKS.
+
+
+Naming conventions =================================================
+
+We use certain naming conventions to structure the considerable number
+of global identifiers. All identifiers should be either all lower
+case or all upper case. Syllables are separated by underscores `_'.
+All non-static identifiers should start with scm_ or SCM_. Then might
+follow zero or more syllables giving the category of the identifier.
+The currently used category identifiers are
+
+ t - type name
+
+ c,C - something with a interface suited for C use. This is used
+ to name functions that behave like Scheme primitives but
+ have a more C friendly calling convention.
+
+ i,I - internal to libguile. It is global, but not considered part
+ of the libguile API.
+
+ f - a SCM variable pointing to a Scheme function object.
+
+ F - a bit mask for a flag.
+
+ m - a macro transformer procedure
+
+ n,N - a count of something
+
+ s - a constant C string
+
+ k - a SCM variable pointing to a keyword.
+
+ sym - a SCM variable pointing to a symbol.
+
+ var - a SCM variable pointing to a variable object.
+
+The follwing syllables also have a technical meaning:
+
+ str - this denotes a zero terminated C string
+
+ mem - a C string with an explicit count
+
+
+See also the file `devel/names.text'.
+
+
+Helpful hints ========================================================
+
+- [From Mikael Djurfeldt] When working on the Guile internals, it is
+quite often practical to implement a scheme-level procedure which
+helps you examine the feature you're working on.
+
+Examples of such procedures are: pt-size, debug-hand and
+current-pstate.
+
+I've now put #ifdef GUILE_DEBUG around all such procedures, so that
+they are not compiled into the "normal" Guile library. Please do the
+same when you add new procedures/C functions for debugging purpose.
+
+You can define the GUILE_DEBUG flag by passing --enable-guile-debug to
+the configure script.
+
+- You'll see uses of the macro SCM_P scattered throughout the code;
+those are vestiges of a time when Guile was meant to compile on
+pre-ANSI compilers. Guile now requires ANSI C, so when you write new
+functions, feel free to use ANSI declarations, and please provide
+prototypes for everything. You don't need to use SCM_P in new code.
+
+
+Jim Blandy, and others
+
+
+Patches ===========================================================
+
+This one makes cvs-1.10 consider the file $CVSDOTIGNORE instead of
+.cvsignore when that environment variable is set.
+
+=== patch start ===
+diff -r -u cvs-1.10/src/cvs.h cvs-1.10.ignore-hack/src/cvs.h
+--- cvs-1.10/src/cvs.h Mon Jul 27 04:54:11 1998
++++ cvs-1.10.ignore-hack/src/cvs.h Sun Jan 23 12:58:09 2000
+@@ -516,7 +516,7 @@
+
+ extern int ign_name PROTO ((char *name));
+ void ign_add PROTO((char *ign, int hold));
+-void ign_add_file PROTO((char *file, int hold));
++int ign_add_file PROTO((char *file, int hold));
+ void ign_setup PROTO((void));
+ void ign_dir_add PROTO((char *name));
+ int ignore_directory PROTO((char *name));
+diff -r -u cvs-1.10/src/ignore.c cvs-1.10.ignore-hack/src/ignore.c
+--- cvs-1.10/src/ignore.c Mon Sep 8 01:04:15 1997
++++ cvs-1.10.ignore-hack/src/ignore.c Sun Jan 23 12:57:50 2000
+@@ -99,9 +99,9 @@
+ /*
+ * Open a file and read lines, feeding each line to a line parser. Arrange
+ * for keeping a temporary list of wildcards at the end, if the "hold"
+- * argument is set.
++ * argument is set. Return true when the file exists and has been handled.
+ */
+-void
++int
+ ign_add_file (file, hold)
+ char *file;
+ int hold;
+@@ -149,8 +149,8 @@
+ if (fp == NULL)
+ {
+ if (! existence_error (errno))
+- error (0, errno, "cannot open %s", file);
+- return;
++ error (0, errno, "cannot open %s", file);
++ return 0;
+ }
+ while (getline (&line, &line_allocated, fp) >= 0)
+ ign_add (line, hold);
+@@ -159,6 +159,7 @@
+ if (fclose (fp) < 0)
+ error (0, errno, "cannot close %s", file);
+ free (line);
++ return 1;
+ }
+
+ /* Parse a line of space-separated wildcards and add them to the list. */
+@@ -375,6 +376,7 @@
+ struct stat sb;
+ char *file;
+ char *xdir;
++ char *cvsdotignore;
+
+ /* Set SUBDIRS if we have subdirectory information in ENTRIES. */
+ if (entries == NULL)
+@@ -397,7 +399,10 @@
+ if (dirp == NULL)
+ return;
+
+- ign_add_file (CVSDOTIGNORE, 1);
++ cvsdotignore = getenv("CVSDOTIGNORE");
++ if (cvsdotignore == NULL || !ign_add_file (cvsdotignore, 1))
++ ign_add_file (CVSDOTIGNORE, 1);
++
+ wrap_add_file (CVSDOTWRAPPER, 1);
+
+ while ((dp = readdir (dirp)) != NULL)
+=== patch end ===
+
+This one is for pcl-cvs-2.9.2, so that `i' adds to the local
+.cvsignore file.
+
+=== patch start ===
+--- pcl-cvs.el~ Mon Nov 1 12:33:46 1999
++++ pcl-cvs.el Tue Jan 25 21:46:27 2000
+@@ -1177,7 +1177,10 @@
+ "Append the file in FILEINFO to the .cvsignore file.
+ Can only be used in the *cvs* buffer."
+ (save-window-excursion
+- (set-buffer (find-file-noselect (expand-file-name ".cvsignore" dir)))
++ (set-buffer (find-file-noselect
++ (expand-file-name (or (getenv "CVSDOTIGNORE")
++ ".cvsignore")
++ dir)))
+ (goto-char (point-max))
+ (unless (zerop (current-column)) (insert "\n"))
+ (insert str "\n")
+=== patch end ===
diff --git a/NEWS b/NEWS
index e4fbb145b..da38ce54a 100644
--- a/NEWS
+++ b/NEWS
@@ -26,11 +26,22 @@ be used for efficiently implementing a Scheme code coverage.
** Duplicate bindings among used modules are resolved lazily.
This slightly improves program startup times.
+** New thread cancellation and thread cleanup API
+See `cancel-thread', `set-thread-cleanup!', and `thread-cleanup'.
+
* Changes to the C interface
** Functions for handling `scm_option' now no longer require an argument
indicating length of the `scm_t_option' array.
+
+
+Changes in 1.8.4 (since 1.8.3)
+
+* Bugs fixed
+
+** CR (ASCII 0x0d) is (again) recognized as a token delimiter by the reader
+
Changes in 1.8.3 (since 1.8.2)
@@ -47,7 +58,7 @@ Changes in 1.8.3 (since 1.8.2)
** A memory leak in `make-socket-address' was fixed
** Alignment issues (e.g., on SPARC) in network routines were fixed
** A threading issue that showed up at least on NetBSD was fixed
-** Build problems on Solaris fixed
+** Build problems on Solaris and IRIX fixed
* Implementation improvements
diff --git a/configure.in b/configure.in
index 541e3a6d8..788130733 100644
--- a/configure.in
+++ b/configure.in
@@ -1102,6 +1102,7 @@ AC_ARG_WITH(threads, [ --with-threads thread interface],
, with_threads=yes)
AC_SUBST(SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT, 0)
+AC_SUBST(SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER, 0)
case "$with_threads" in
"yes" | "pthread" | "pthreads" | "pthread-threads" | "")
@@ -1125,23 +1126,42 @@ case "$with_threads" in
# On past versions of Solaris, believe 8 through 10 at least, you
# had to write "pthread_once_t foo = { PTHREAD_ONCE_INIT };".
- # This is contrary to posix:
+ # This is contrary to POSIX:
# http://www.opengroup.org/onlinepubs/000095399/functions/pthread_once.html
# Check here if this style is required.
#
# glibc (2.3.6 at least) works both with or without braces, so the
# test checks whether it works without.
#
+
+ if test "$GCC" = "yes"; then
+ # Since GCC only issues a warning for missing braces, so we need
+ # `-Werror' to catch it.
+ CFLAGS="-Werror -Wmissing-braces $CFLAGS"
+ fi
+
AC_CACHE_CHECK([whether PTHREAD_ONCE_INIT needs braces],
guile_cv_need_braces_on_pthread_once_init,
- [AC_TRY_COMPILE([#include <pthread.h>],
- [pthread_once_t foo = PTHREAD_ONCE_INIT;],
+ [AC_COMPILE_IFELSE([#include <pthread.h>
+ pthread_once_t foo = PTHREAD_ONCE_INIT;],
[guile_cv_need_braces_on_pthread_once_init=no],
[guile_cv_need_braces_on_pthread_once_init=yes])])
if test "$guile_cv_need_braces_on_pthread_once_init" = yes; then
SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT=1
fi
+ # Same problem with `PTHREAD_MUTEX_INITIALIZER', e.g., on IRIX
+ # 6.5.30m with GCC 3.3.
+ AC_CACHE_CHECK([whether PTHREAD_MUTEX_INITIALIZER needs braces],
+ guile_cv_need_braces_on_pthread_mutex_initializer,
+ [AC_COMPILE_IFELSE([#include <pthread.h>
+ pthread_mutex_t foo = PTHREAD_MUTEX_INITIALIZER;],
+ [guile_cv_need_braces_on_pthread_mutex_initializer=no],
+ [guile_cv_need_braces_on_pthread_mutex_initializer=yes])])
+ if test "$guile_cv_need_braces_on_pthread_mutex_initializer" = yes; then
+ SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER=1
+ fi
+
CFLAGS="$old_CFLAGS"
# On Solaris, sched_yield lives in -lrt.
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index f3dd1c5f7..691159b52 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,67 @@
+2007-10-20 Julian Graham <joolean@gmail.com>
+
+ Add support for thread cancellation and user-defined thread
+ cleanup handlers. Small rework by Ludovic Courtès.
+
+ * null-threads.h (scm_i_pthread_cancel,
+ scm_i_pthread_cleanup_push, scm_i_pthread_cleanup_pop): New.
+ * pthread-threads.h (scm_i_pthread_cancel,
+ scm_i_pthread_cleanup_push, scm_i_pthread_cleanup_pop): New.
+ * scmsigs.c (scm_i_signal_delivery_thread,
+ signal_delivery_thread_mutex): New.
+ (signal_delivery_thread): Leave when `read_without_guile ()'
+ returns zero.
+ (start_signal_delivery_thread): Acquire SIGNAL_DELIVERY_THREAD
+ before spawning the thread. Initialize
+ SCM_I_SIGNAL_DELIVERY_THREAD.
+ (ensure_signal_delivery_thread): Renamed to...
+ (scm_i_ensure_signal_delivery_thread): this.
+ (scm_i_close_signal_pipe): New.
+ * scmsigs.h: Updated.
+ * threads.c (thread_mark): Mark `t->cleanup_handler'.
+ (guilify_self_1): Initialize `t->cleanup_handler' and
+ `t->canceled'.
+ (do_thread_exit): Invoke `t->cleanup_handler'.
+ (on_thread_exit): Call `scm_i_ensure_signal_delivery_thread ()'.
+ Call `scm_i_close_signal_pipe ()' when the next-to-last thread
+ vanishes.
+ (scm_leave_guile_cleanup): New.
+ (scm_i_with_guile_and_parent): Use `scm_i_pthread_cleanup_push ()'
+ and `scm_leave_guile_cleanup ()' to leave guile mode, rather
+ than call `scm_leave_guile ()' after FUNC.
+ (scm_cancel_thread, scm_set_thread_cleanup_x,
+ scm_threads_cleanup): New.
+ (scm_all_threads): Remove SCM_I_SIGNAL_DELIVERY_THREAD from the
+ returned list.
+ * threads.h (scm_i_thread)[cleanup_handler, canceled]: New
+ fields.
+ Add declarations of new functions.
+
+2007-10-17 Ludovic Courtès <ludo@gnu.org>
+
+ * read.c (CHAR_IS_BLANK_): Add `\r' (ASCII 0x0d). This fixes a
+ regression compared to 1.8.2. Reported by Puneet
+ <schemer@gmail.com>.
+
+2007-10-10 Ludovic Courtès <ludo@gnu.org>
+
+ * pthread-threads.h (SCM_I_PTHREAD_MUTEX_INITIALIZER): Check
+ `SCM_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER'.
+ * gen-scmconfig.h.in
+ (SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER): New.
+ * gen-scmconfig.c (main): Define
+ `SCM_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER'.
+
+2007-10-04 Ludovic Courtès <ludo@gnu.org>
+
+ * i18n.c (scm_make_locale)[!USE_GNU_LOCALE_API]: Don't call
+ `leave_locale_section ()' on failure of
+ `enter_locale_section ()' since the mutex is not held and locale
+ settings are unchanged.
+ (scm_nl_langinfo)[!USE_GNU_LOCALE_API]: Use
+ `restore_locale_settings ()' instead of `leave_locale_section ()'
+ since the mutex is not held.
+
2007-10-02 Ludovic Courtès <ludo@gnu.org>
* threads.c (on_thread_exit): Don't call `scm_leave_guile ()'
diff --git a/libguile/gen-scmconfig.c b/libguile/gen-scmconfig.c
index 43a2a989d..6afa72fcc 100644
--- a/libguile/gen-scmconfig.c
+++ b/libguile/gen-scmconfig.c
@@ -382,6 +382,11 @@ main (int argc, char *argv[])
pf ("#define SCM_NEED_BRACES_ON_PTHREAD_ONCE_INIT %d /* 0 or 1 */\n",
SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT);
+ pf ("/* Define to 1 if need braces around PTHREAD_MUTEX_INITIALIZER\n"
+ " (for IRIX with GCC) */\n");
+ pf ("#define SCM_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER %d /* 0 or 1 */\n",
+ SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER);
+
#if USE_DLL_IMPORT
pf ("\n");
pf ("/* Define some additional CPP macros on Win32 platforms. */\n");
diff --git a/libguile/gen-scmconfig.h.in b/libguile/gen-scmconfig.h.in
index b4e0561f1..cdc59b047 100644
--- a/libguile/gen-scmconfig.h.in
+++ b/libguile/gen-scmconfig.h.in
@@ -29,6 +29,7 @@
#define SCM_I_GSC_USE_PTHREAD_THREADS @SCM_I_GSC_USE_PTHREAD_THREADS@
#define SCM_I_GSC_USE_NULL_THREADS @SCM_I_GSC_USE_NULL_THREADS@
#define SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT @SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT@
+#define SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER @SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER@
/*
Local Variables:
diff --git a/libguile/i18n.c b/libguile/i18n.c
index 88652efd2..43381f4ed 100644
--- a/libguile/i18n.c
+++ b/libguile/i18n.c
@@ -685,12 +685,14 @@ SCM_DEFINE (scm_make_locale, "make-locale", 2, 1, 0,
scm_t_locale_settings prev_locale;
err = enter_locale_section (c_locale, &prev_locale);
- leave_locale_section (&prev_locale);
if (err)
goto fail;
else
- SCM_NEWSMOB (locale, scm_tc16_locale_smob_type, c_locale);
+ {
+ leave_locale_section (&prev_locale);
+ SCM_NEWSMOB (locale, scm_tc16_locale_smob_type, c_locale);
+ }
}
#endif
@@ -1410,7 +1412,7 @@ SCM_DEFINE (scm_nl_langinfo, "nl-langinfo", 1, 1, 0,
{
c_result = nl_langinfo (c_item);
- leave_locale_section (&lsec_prev_locale);
+ restore_locale_settings (&lsec_prev_locale);
free_locale_settings (&lsec_prev_locale);
}
#endif
diff --git a/libguile/null-threads.h b/libguile/null-threads.h
index 233b8139d..5a61dbf50 100644
--- a/libguile/null-threads.h
+++ b/libguile/null-threads.h
@@ -41,6 +41,9 @@
#define scm_i_pthread_create(t,a,f,d) (*(t)=0, (void)(f), ENOSYS)
#define scm_i_pthread_detach(t) do { } while (0)
#define scm_i_pthread_exit(v) exit(0)
+#define scm_i_pthread_cancel(t) 0
+#define scm_i_pthread_cleanup_push(t,v) 0
+#define scm_i_pthread_cleanup_pop(e) 0
#define scm_i_sched_yield() 0
/* Signals
diff --git a/libguile/pthread-threads.h b/libguile/pthread-threads.h
index 5f652252a..bd6d4854d 100644
--- a/libguile/pthread-threads.h
+++ b/libguile/pthread-threads.h
@@ -38,6 +38,9 @@
#define scm_i_pthread_create pthread_create
#define scm_i_pthread_detach pthread_detach
#define scm_i_pthread_exit pthread_exit
+#define scm_i_pthread_cancel pthread_cancel
+#define scm_i_pthread_cleanup_push pthread_cleanup_push
+#define scm_i_pthread_cleanup_pop pthread_cleanup_pop
#define scm_i_sched_yield sched_yield
/* Signals
@@ -46,7 +49,11 @@
/* Mutexes
*/
-#define SCM_I_PTHREAD_MUTEX_INITIALIZER PTHREAD_MUTEX_INITIALIZER
+#if SCM_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER
+# define SCM_I_PTHREAD_MUTEX_INITIALIZER { PTHREAD_MUTEX_INITIALIZER }
+#else
+# define SCM_I_PTHREAD_MUTEX_INITIALIZER PTHREAD_MUTEX_INITIALIZER
+#endif
#define scm_i_pthread_mutex_t pthread_mutex_t
#define scm_i_pthread_mutex_init pthread_mutex_init
#define scm_i_pthread_mutex_destroy pthread_mutex_destroy
diff --git a/libguile/read.c b/libguile/read.c
index d1013c586..53715f2b5 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -150,7 +150,7 @@ static SCM *scm_read_hash_procedures;
/* `isblank' is only in C99. */
#define CHAR_IS_BLANK_(_chr) \
(((_chr) == ' ') || ((_chr) == '\t') || ((_chr) == '\n') \
- || ((_chr) == '\f'))
+ || ((_chr) == '\f') || ((_chr) == '\r'))
#ifdef MSDOS
# define CHAR_IS_BLANK(_chr) \
@@ -182,9 +182,8 @@ static SCM *scm_read_hash_procedures;
/* Read an SCSH block comment. */
static inline SCM scm_read_scsh_block_comment (int chr, SCM port);
-/* Helper function similar to `scm_read_token ()'. Read from PORT until a
- whitespace is read. Return zero if the whole token could fit in BUF,
- non-zero otherwise. */
+/* Read from PORT until a delimiter (e.g., a whitespace) is read. Return
+ zero if the whole token fits in BUF, non-zero otherwise. */
static inline int
read_token (SCM port, char *buf, size_t buf_size, size_t *read)
{
diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c
index 989ddcab1..d05bdac67 100644
--- a/libguile/scmsigs.c
+++ b/libguile/scmsigs.c
@@ -33,6 +33,7 @@
#include "libguile/eval.h"
#include "libguile/root.h"
#include "libguile/vectors.h"
+#include "libguile/threads.h"
#include "libguile/validate.h"
#include "libguile/scmsigs.h"
@@ -99,6 +100,14 @@ static SCM *signal_handlers;
static SCM signal_handler_asyncs;
static SCM signal_handler_threads;
+/* The signal delivery thread. */
+scm_i_thread *scm_i_signal_delivery_thread = NULL;
+
+/* The mutex held when launching the signal delivery thread. */
+static scm_i_pthread_mutex_t signal_delivery_thread_mutex =
+ SCM_I_PTHREAD_MUTEX_INITIALIZER;
+
+
/* saves the original C handlers, when a new handler is installed.
set to SIG_ERR if the original handler is installed. */
#ifdef HAVE_SIGACTION
@@ -185,24 +194,34 @@ signal_delivery_thread (void *data)
if (scm_is_true (h))
scm_system_async_mark_for_thread (h, t);
}
+ else if (n == 0)
+ break; /* the signal pipe was closed. */
else if (n < 0 && errno != EINTR)
perror ("error in signal delivery thread");
}
- return SCM_UNSPECIFIED; /* not reached */
+ return SCM_UNSPECIFIED; /* not reached unless all other threads exited */
}
static void
start_signal_delivery_thread (void)
{
+ SCM signal_thread;
+
+ scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex);
+
if (pipe (signal_pipe) != 0)
scm_syserror (NULL);
- scm_spawn_thread (signal_delivery_thread, NULL,
- scm_handle_by_message, "signal delivery thread");
+ signal_thread = scm_spawn_thread (signal_delivery_thread, NULL,
+ scm_handle_by_message,
+ "signal delivery thread");
+ scm_i_signal_delivery_thread = SCM_I_THREAD_DATA (signal_thread);
+
+ scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex);
}
-static void
-ensure_signal_delivery_thread ()
+void
+scm_i_ensure_signal_delivery_thread ()
{
static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
scm_i_pthread_once (&once, start_signal_delivery_thread);
@@ -228,8 +247,8 @@ take_signal (int signum)
#endif
}
-static void
-ensure_signal_delivery_thread ()
+void
+scm_i_ensure_signal_delivery_thread ()
{
return;
}
@@ -332,7 +351,7 @@ SCM_DEFINE (scm_sigaction_for_thread, "sigaction", 1, 3, 0,
SCM_MISC_ERROR ("thread has already exited", SCM_EOL);
}
- ensure_signal_delivery_thread ();
+ scm_i_ensure_signal_delivery_thread ();
SCM_CRITICAL_SECTION_START;
old_handler = SCM_SIMPLE_VECTOR_REF (*signal_handlers, csig);
@@ -653,6 +672,21 @@ SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
void
+scm_i_close_signal_pipe()
+{
+ /* SIGNAL_DELIVERY_THREAD_MUTEX is only locked while the signal delivery
+ thread is being launched. The thread that calls this function is
+ already holding the thread admin mutex, so if the delivery thread hasn't
+ been launched at this point, it never will be before shutdown. */
+ scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex);
+
+ if (scm_i_signal_delivery_thread != NULL)
+ close (signal_pipe[1]);
+
+ scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex);
+}
+
+void
scm_init_scmsigs ()
{
int i;
diff --git a/libguile/scmsigs.h b/libguile/scmsigs.h
index 54742de14..2aced3a3c 100644
--- a/libguile/scmsigs.h
+++ b/libguile/scmsigs.h
@@ -3,7 +3,7 @@
#ifndef SCM_SCMSIGS_H
#define SCM_SCMSIGS_H
-/* Copyright (C) 1995,1996,1997,1998,2000, 2002, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000, 2002, 2006, 2007 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -23,6 +23,7 @@
#include "libguile/__scm.h"
+#include "libguile/threads.h"
@@ -41,6 +42,11 @@ SCM_API SCM scm_usleep (SCM i);
SCM_API SCM scm_raise (SCM sig);
SCM_API void scm_init_scmsigs (void);
+SCM_API void scm_i_close_signal_pipe (void);
+SCM_API void scm_i_ensure_signal_delivery_thread (void);
+
+SCM_API scm_i_thread *scm_i_signal_delivery_thread;
+
#endif /* SCM_SCMSIGS_H */
/*
diff --git a/libguile/threads.c b/libguile/threads.c
index 77dcbb37a..c1b681a9e 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -49,6 +49,7 @@
#include "libguile/continuations.h"
#include "libguile/gc.h"
#include "libguile/init.h"
+#include "libguile/scmsigs.h"
#ifdef __MINGW32__
#ifndef ETIMEDOUT
@@ -405,6 +406,7 @@ guilify_self_1 (SCM_STACKITEM *base)
t->pthread = scm_i_pthread_self ();
t->handle = SCM_BOOL_F;
t->result = SCM_BOOL_F;
+ t->cleanup_handler = SCM_BOOL_F;
t->join_queue = SCM_EOL;
t->dynamic_state = SCM_BOOL_F;
t->dynwinds = SCM_EOL;
@@ -426,6 +428,7 @@ guilify_self_1 (SCM_STACKITEM *base)
t->gc_running_p = 0;
t->current_mark_stack_ptr = NULL;
t->current_mark_stack_limit = NULL;
+ t->canceled = 0;
t->exited = 0;
t->freelist = SCM_EOL;
@@ -470,7 +473,17 @@ guilify_self_2 (SCM parent)
static void *
do_thread_exit (void *v)
{
- scm_i_thread *t = (scm_i_thread *)v;
+ scm_i_thread *t = (scm_i_thread *) v;
+
+ if (!scm_is_false (t->cleanup_handler))
+ {
+ SCM ptr = t->cleanup_handler;
+
+ t->cleanup_handler = SCM_BOOL_F;
+ t->result = scm_internal_catch (SCM_BOOL_T,
+ (scm_t_catch_body) scm_call_0, ptr,
+ scm_handle_by_message_noexit, NULL);
+ }
scm_i_scm_pthread_mutex_lock (&thread_admin_mutex);
@@ -481,6 +494,7 @@ do_thread_exit (void *v)
;
scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+
return NULL;
}
@@ -488,10 +502,14 @@ static void
on_thread_exit (void *v)
{
/* This handler is executed in non-guile mode. */
- scm_i_thread *t = (scm_i_thread *)v, **tp;
+ scm_i_thread *t = (scm_i_thread *) v, **tp;
scm_i_pthread_setspecific (scm_i_thread_key, v);
+ /* Ensure the signal handling thread has been launched, because we might be
+ shutting it down. */
+ scm_i_ensure_signal_delivery_thread ();
+
/* Unblocking the joining threads needs to happen in guile mode
since the queue is a SCM data structure. */
scm_with_guile (do_thread_exit, v);
@@ -507,6 +525,14 @@ on_thread_exit (void *v)
break;
}
thread_count--;
+
+ /* If there's only one other thread, it could be the signal delivery
+ thread, so we need to notify it to shut down by closing its read pipe.
+ If it's not the signal delivery thread, then closing the read pipe isn't
+ going to hurt. */
+ if (thread_count <= 1)
+ scm_i_close_signal_pipe ();
+
scm_i_pthread_mutex_unlock (&thread_admin_mutex);
scm_i_pthread_setspecific (scm_i_thread_key, NULL);
@@ -676,17 +702,30 @@ scm_with_guile (void *(*func)(void *), void *data)
scm_i_default_dynamic_state);
}
+static void
+scm_leave_guile_cleanup (void *x)
+{
+ scm_leave_guile ();
+}
+
void *
-scm_i_with_guile_and_parent (void *(*func)(void *), void *data,
- SCM parent)
+scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent)
{
void *res;
int really_entered;
SCM_STACKITEM base_item;
+
really_entered = scm_i_init_thread_for_guile (&base_item, parent);
- res = scm_c_with_continuation_barrier (func, data);
if (really_entered)
- scm_leave_guile ();
+ {
+ scm_i_pthread_cleanup_push (scm_leave_guile_cleanup, NULL);
+ res = scm_c_with_continuation_barrier (func, data);
+ scm_i_pthread_cleanup_pop (0);
+ scm_leave_guile ();
+ }
+ else
+ res = scm_c_with_continuation_barrier (func, data);
+
return res;
}
@@ -872,6 +911,74 @@ SCM_DEFINE (scm_yield, "yield", 0, 0, 0,
}
#undef FUNC_NAME
+SCM_DEFINE (scm_cancel_thread, "cancel-thread", 1, 0, 0,
+ (SCM thread),
+"Asynchronously force the target @var{thread} to terminate. @var{thread} "
+"cannot be the current thread, and if @var{thread} has already terminated or "
+"been signaled to terminate, this function is a no-op.")
+#define FUNC_NAME s_scm_cancel_thread
+{
+ scm_i_thread *t = NULL;
+
+ SCM_VALIDATE_THREAD (1, thread);
+ t = SCM_I_THREAD_DATA (thread);
+ scm_i_scm_pthread_mutex_lock (&thread_admin_mutex);
+ if (!t->canceled)
+ {
+ t->canceled = 1;
+ scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+ scm_i_pthread_cancel (t->pthread);
+ }
+ else
+ scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_set_thread_cleanup_x, "set-thread-cleanup!", 2, 0, 0,
+ (SCM thread, SCM proc),
+"Set the thunk @var{proc} as the cleanup handler for the thread @var{thread}. "
+"This handler will be called when the thread exits.")
+#define FUNC_NAME s_scm_set_thread_cleanup_x
+{
+ scm_i_thread *t;
+
+ SCM_VALIDATE_THREAD (1, thread);
+ if (!scm_is_false (proc))
+ SCM_VALIDATE_THUNK (2, proc);
+
+ scm_i_pthread_mutex_lock (&thread_admin_mutex);
+
+ t = SCM_I_THREAD_DATA (thread);
+ if (!(t->exited || t->canceled))
+ t->cleanup_handler = proc;
+
+ scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_thread_cleanup, "thread-cleanup", 1, 0, 0,
+ (SCM thread),
+"Return the cleanup handler installed for the thread @var{thread}.")
+#define FUNC_NAME s_scm_thread_cleanup
+{
+ scm_i_thread *t;
+ SCM ret;
+
+ SCM_VALIDATE_THREAD (1, thread);
+
+ scm_i_pthread_mutex_lock (&thread_admin_mutex);
+ t = SCM_I_THREAD_DATA (thread);
+ ret = (t->exited || t->canceled) ? SCM_BOOL_F : t->cleanup_handler;
+ scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+
+ return ret;
+}
+#undef FUNC_NAME
+
SCM_DEFINE (scm_join_thread, "join-thread", 1, 0, 0,
(SCM thread),
"Suspend execution of the calling thread until the target @var{thread} "
@@ -883,7 +990,7 @@ SCM_DEFINE (scm_join_thread, "join-thread", 1, 0, 0,
SCM_VALIDATE_THREAD (1, thread);
if (scm_is_eq (scm_current_thread (), thread))
- SCM_MISC_ERROR ("can not join the current thread", SCM_EOL);
+ SCM_MISC_ERROR ("cannot join the current thread", SCM_EOL);
scm_i_scm_pthread_mutex_lock (&thread_admin_mutex);
@@ -903,10 +1010,13 @@ SCM_DEFINE (scm_join_thread, "join-thread", 1, 0, 0,
res = t->result;
scm_i_pthread_mutex_unlock (&thread_admin_mutex);
+
return res;
}
#undef FUNC_NAME
+
+
/*** Fat mutexes */
/* We implement our own mutex type since we want them to be 'fair', we
@@ -1492,8 +1602,11 @@ SCM_DEFINE (scm_all_threads, "all-threads", 0, 0, 0,
l = &list;
for (t = all_threads; t && n > 0; t = t->next_thread)
{
- SCM_SETCAR (*l, t->handle);
- l = SCM_CDRLOC (*l);
+ if (t != scm_i_signal_delivery_thread)
+ {
+ SCM_SETCAR (*l, t->handle);
+ l = SCM_CDRLOC (*l);
+ }
n--;
}
*l = SCM_EOL;
diff --git a/libguile/threads.h b/libguile/threads.h
index dced696ea..834f38525 100644
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -3,7 +3,7 @@
#ifndef SCM_THREADS_H
#define SCM_THREADS_H
-/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2007 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -49,9 +49,11 @@ typedef struct scm_i_thread {
SCM handle;
scm_i_pthread_t pthread;
-
+
+ SCM cleanup_handler;
SCM join_queue;
SCM result;
+ int canceled;
int exited;
SCM sleep_object;
@@ -158,6 +160,9 @@ do { \
SCM_API SCM scm_call_with_new_thread (SCM thunk, SCM handler);
SCM_API SCM scm_yield (void);
+SCM_API SCM scm_cancel_thread (SCM t);
+SCM_API SCM scm_set_thread_cleanup_x (SCM thread, SCM proc);
+SCM_API SCM scm_thread_cleanup (SCM thread);
SCM_API SCM scm_join_thread (SCM t);
SCM_API SCM scm_make_mutex (void);
diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog
index f40adfa22..a48a11c12 100644
--- a/test-suite/ChangeLog
+++ b/test-suite/ChangeLog
@@ -1,3 +1,25 @@
+2007-10-20 Julian Graham <joolean@gmail.com>
+
+ * tests/threads.test: Use proper `define-module'.
+ (cancel-thread, handler result passed to join, can cancel self,
+ handler supplants final expr, remove handler by setting false,
+ initial handler is false): New tests.
+
+2007-10-17 Ludovic Courtès <ludo@gnu.org>
+
+ * tests/reader.test (reading)[CR recognized as a token
+ delimiter]: New test.
+
+2007-10-10 Ludovic Courtès <ludo@gnu.org>
+
+ * standalone/test-conversion.c: Include <inttypes.h> where
+ available. Use `PRIiMAX' and `PRIuMAX' to print
+ `scm_t_u?intmax'. Fixes warnings on x86_64. Reported by Poor
+ Yorick <org.gnu.lists.guile-user@pooryorick.com>.
+
+ * standalone/Makefile.am (test_cflags): Removed reference to
+ `libguile-ltdl'.
+
2007-09-03 Ludovic Courtès <ludo@gnu.org>
* tests/reader.test (reading)[block comment finishing sexp]: New
diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am
index e41f168c0..9a3c3a3c0 100644
--- a/test-suite/standalone/Makefile.am
+++ b/test-suite/standalone/Makefile.am
@@ -1,6 +1,6 @@
## Process this file with automake to produce Makefile.in.
##
-## Copyright 2003, 2004, 2005, 2006 Software Foundation, Inc.
+## Copyright 2003, 2004, 2005, 2006, 2007 Software Foundation, Inc.
##
## This file is part of GUILE.
##
@@ -32,7 +32,7 @@ TESTS_ENVIRONMENT = "${top_builddir}/pre-inst-guile-env"
test_cflags = \
-I$(top_srcdir)/test-suite/standalone \
-I$(top_srcdir) \
- -I$(top_srcdir)/libguile-ltdl $(EXTRA_DEFS) $(GUILE_CFLAGS)
+ $(EXTRA_DEFS) $(GUILE_CFLAGS)
AM_LDFLAGS = $(GUILE_CFLAGS)
diff --git a/test-suite/standalone/test-conversion.c b/test-suite/standalone/test-conversion.c
index 2ddbf75a6..2e8c057fc 100644
--- a/test-suite/standalone/test-conversion.c
+++ b/test-suite/standalone/test-conversion.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1999,2000,2001,2003,2004, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1999,2000,2001,2003,2004, 2006, 2007 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -21,6 +21,21 @@
#include <assert.h>
#include <string.h>
+#include "config.h"
+
+#ifdef HAVE_INTTYPES_H
+# include <inttypes.h>
+#elif (!defined PRIiMAX)
+# if (defined SIZEOF_LONG_LONG) && (SIZEOF_LONG_LONG >= 8)
+# define PRIiMAX "lli"
+# define PRIuMAX "llu"
+# else
+# define PRIiMAX "li"
+# define PRIuMAX "lu"
+# endif
+#endif
+
+
static void
test_1 (const char *str, scm_t_intmax min, scm_t_intmax max,
int result)
@@ -28,7 +43,8 @@ test_1 (const char *str, scm_t_intmax min, scm_t_intmax max,
int r = scm_is_signed_integer (scm_c_eval_string (str), min, max);
if (r != result)
{
- fprintf (stderr, "fail: scm_is_signed_integer (%s, %Ld, %Ld) == %d\n",
+ fprintf (stderr, "fail: scm_is_signed_integer (%s, "
+ "%" PRIiMAX ", %" PRIiMAX ") == %d\n",
str, min, max, result);
exit (1);
}
@@ -113,7 +129,8 @@ test_2 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
int r = scm_is_unsigned_integer (scm_c_eval_string (str), min, max);
if (r != result)
{
- fprintf (stderr, "fail: scm_is_unsigned_integer (%s, %Lu, %Lu) == %d\n",
+ fprintf (stderr, "fail: scm_is_unsigned_integer (%s, "
+ "%" PRIuMAX ", %" PRIuMAX ") == %d\n",
str, min, max, result);
exit (1);
}
@@ -233,7 +250,8 @@ test_3 (const char *str, scm_t_intmax min, scm_t_intmax max,
out_of_range_handler, NULL)))
{
fprintf (stderr,
- "fail: scm_to_signed_int (%s, %Ld, %Ld) -> out of range\n",
+ "fail: scm_to_signed_int (%s, "
+ "%" PRIiMAX ", %" PRIiMAX ") -> out of range\n",
str, min, max);
exit (1);
}
@@ -245,7 +263,8 @@ test_3 (const char *str, scm_t_intmax min, scm_t_intmax max,
wrong_type_handler, NULL)))
{
fprintf (stderr,
- "fail: scm_to_signed_int (%s, %Ld, %Ld) -> wrong type\n",
+ "fail: scm_to_signed_int (%s, "
+ "%" PRIiMAX", %" PRIiMAX ") -> wrong type\n",
str, min, max);
exit (1);
}
@@ -258,7 +277,8 @@ test_3 (const char *str, scm_t_intmax min, scm_t_intmax max,
|| data.result != result)
{
fprintf (stderr,
- "fail: scm_to_signed_int (%s, %Ld, %Ld) = %Ld\n",
+ "fail: scm_to_signed_int (%s, "
+ "%" PRIiMAX ", %" PRIiMAX ") = %" PRIiMAX "\n",
str, min, max, result);
exit (1);
}
@@ -365,7 +385,8 @@ test_4 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
out_of_range_handler, NULL)))
{
fprintf (stderr,
- "fail: scm_to_unsigned_int (%s, %Lu, %Lu) -> out of range\n",
+ "fail: scm_to_unsigned_int (%s, "
+ "%" PRIuMAX ", %" PRIuMAX ") -> out of range\n",
str, min, max);
exit (1);
}
@@ -377,7 +398,8 @@ test_4 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
wrong_type_handler, NULL)))
{
fprintf (stderr,
- "fail: scm_to_unsigned_int (%s, %Lu, %Lu) -> wrong type\n",
+ "fail: scm_to_unsigned_int (%s, "
+ "%" PRIuMAX ", %" PRIuMAX ") -> wrong type\n",
str, min, max);
exit (1);
}
@@ -390,7 +412,8 @@ test_4 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
|| data.result != result)
{
fprintf (stderr,
- "fail: scm_to_unsigned_int (%s, %Lu, %Lu) == %Lu\n",
+ "fail: scm_to_unsigned_int (%s, "
+ "%" PRIuMAX ", %" PRIuMAX ") == %" PRIuMAX "\n",
str, min, max, result);
exit (1);
}
@@ -446,7 +469,7 @@ test_5 (scm_t_intmax val, const char *result)
SCM res = scm_c_eval_string (result);
if (scm_is_false (scm_equal_p (scm_from_signed_integer (val), res)))
{
- fprintf (stderr, "fail: scm_from_signed_integer (%Ld) == %s\n",
+ fprintf (stderr, "fail: scm_from_signed_integer (%" PRIiMAX ") == %s\n",
val, result);
exit (1);
}
@@ -478,7 +501,8 @@ test_6 (scm_t_uintmax val, const char *result)
SCM res = scm_c_eval_string (result);
if (scm_is_false (scm_equal_p (scm_from_unsigned_integer (val), res)))
{
- fprintf (stderr, "fail: scm_from_unsigned_integer (%Lu) == %s\n",
+ fprintf (stderr, "fail: scm_from_unsigned_integer (%"
+ PRIuMAX ") == %s\n",
val, result);
exit (1);
}
@@ -507,7 +531,7 @@ test_7s (SCM n, scm_t_intmax c_n, const char *result, const char *func)
if (scm_is_false (scm_equal_p (n, r)))
{
- fprintf (stderr, "fail: %s (%Ld) == %s\n", func, c_n, result);
+ fprintf (stderr, "fail: %s (%" PRIiMAX ") == %s\n", func, c_n, result);
exit (1);
}
}
@@ -521,7 +545,7 @@ test_7u (SCM n, scm_t_uintmax c_n, const char *result, const char *func)
if (scm_is_false (scm_equal_p (n, r)))
{
- fprintf (stderr, "fail: %s (%Lu) == %s\n", func, c_n, result);
+ fprintf (stderr, "fail: %s (%" PRIuMAX ") == %s\n", func, c_n, result);
exit (1);
}
}
@@ -580,7 +604,7 @@ test_8s (const char *str, scm_t_intmax (*func) (SCM), const char *func_name,
|| data.result != result)
{
fprintf (stderr,
- "fail: %s (%s) = %Ld\n", func_name, str, result);
+ "fail: %s (%s) = %" PRIiMAX "\n", func_name, str, result);
exit (1);
}
}
@@ -638,7 +662,7 @@ test_8u (const char *str, scm_t_uintmax (*func) (SCM), const char *func_name,
|| data.result != result)
{
fprintf (stderr,
- "fail: %s (%s) = %Ld\n", func_name, str, result);
+ "fail: %s (%s) = %" PRIiMAX "\n", func_name, str, result);
exit (1);
}
}
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index 7f24aa695..d6047a2d3 100644
--- a/test-suite/tests/reader.test
+++ b/test-suite/tests/reader.test
@@ -84,7 +84,11 @@
(pass-if "unprintable symbol"
;; The reader tolerates unprintable characters for symbols.
(equal? (string->symbol "\001\002\003")
- (read-string "\001\002\003"))))
+ (read-string "\001\002\003")))
+
+ (pass-if "CR recognized as a token delimiter"
+ ;; In 1.8.3, character 0x0d was not recognized as a delimiter.
+ (equal? (read-string "one\x0dtwo") 'one)))
(pass-if-exception "radix passed to number->string can't be zero"
diff --git a/test-suite/tests/threads.test b/test-suite/tests/threads.test
index 014601611..10b1b91a0 100644
--- a/test-suite/tests/threads.test
+++ b/test-suite/tests/threads.test
@@ -1,6 +1,6 @@
;;;; threads.test --- Tests for Guile threading. -*- scheme -*-
;;;;
-;;;; Copyright 2003, 2006 Free Software Foundation, Inc.
+;;;; Copyright 2003, 2006, 2007 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
@@ -17,8 +17,10 @@
;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;;;; Boston, MA 02110-1301 USA
-(use-modules (ice-9 threads)
- (test-suite lib))
+(define-module (test-threads)
+ :use-module (ice-9 threads)
+ :use-module (test-suite lib))
+
(if (provided? 'threads)
(begin
@@ -133,4 +135,54 @@
(lambda (n) (set! result (cons n result)))
(lambda (n) (* 2 n))
'(0 1 2 3 4 5))
- (equal? result '(10 8 6 4 2 0)))))))
+ (equal? result '(10 8 6 4 2 0)))))
+
+ ;;
+ ;; thread cancellation
+ ;;
+
+ (with-test-prefix "cancel-thread"
+
+ (pass-if "cancel succeeds"
+ (let ((m (make-mutex)))
+ (lock-mutex m)
+ (let ((t (begin-thread (begin (lock-mutex m) 'foo))))
+ (cancel-thread t)
+ (join-thread t)
+ #t)))
+
+ (pass-if "handler result passed to join"
+ (let ((m (make-mutex)))
+ (lock-mutex m)
+ (let ((t (begin-thread (lock-mutex m))))
+ (set-thread-cleanup! t (lambda () 'foo))
+ (cancel-thread t)
+ (eq? (join-thread t) 'foo))))
+
+ (pass-if "can cancel self"
+ (let ((m (make-mutex)))
+ (lock-mutex m)
+ (let ((t (begin-thread (begin
+ (set-thread-cleanup! (current-thread)
+ (lambda () 'foo))
+ (cancel-thread (current-thread))
+ (lock-mutex m)))))
+ (eq? (join-thread t) 'foo))))
+
+ (pass-if "handler supplants final expr"
+ (let ((t (begin-thread (begin (set-thread-cleanup! (current-thread)
+ (lambda () 'bar))
+ 'foo))))
+ (eq? (join-thread t) 'bar)))
+
+ (pass-if "remove handler by setting false"
+ (let ((m (make-mutex)))
+ (lock-mutex m)
+ (let ((t (begin-thread (lock-mutex m) 'bar)))
+ (set-thread-cleanup! t (lambda () 'foo))
+ (set-thread-cleanup! t #f)
+ (unlock-mutex m)
+ (eq? (join-thread t) 'bar))))
+
+ (pass-if "initial handler is false"
+ (not (thread-cleanup (current-thread)))))))