diff --git a/ChangeLog b/ChangeLog index 18f16fd7b..d55a14aae 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,31 @@ +2007-10-20 Ludovic Courtès + + * THANKS: Add Julian. + +2007-10-20 Julian Graham + + * NEWS: Mention thread cancellation and cleanup API. + +2007-10-17 Ludovic Courtès + + * NEWS: Mention reader bug-fix. + +2007-10-16 Ludovic Courtès + + Guile 1.8.3 released. + + * GUILE-VERSION (GUILE_MICRO_VERSION): Incremented. + (LIBGUILE_INTERFACE_REVISION): Incremented. + +2007-10-10 Ludovic Courtès + + * 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 * 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_once_t foo = PTHREAD_ONCE_INIT;], + [AC_COMPILE_IFELSE([#include + 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_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 + + 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 + + * read.c (CHAR_IS_BLANK_): Add `\r' (ASCII 0x0d). This fixes a + regression compared to 1.8.2. Reported by Puneet + . + +2007-10-10 Ludovic Courtès + + * 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 + + * 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 * 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); @@ -652,6 +671,21 @@ SCM_DEFINE (scm_raise, "raise", 1, 0, 0, +void +scm_i_close_signal_pipe() +{ + /* SIGNAL_DELIVERY_THREAD_MUTEX is only locked while the signal delivery + thread is being launched. The thread that calls this function is + already holding the thread admin mutex, so if the delivery thread hasn't + been launched at this point, it never will be before shutdown. */ + scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex); + + if (scm_i_signal_delivery_thread != NULL) + close (signal_pipe[1]); + + scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex); +} + void scm_init_scmsigs () { 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 + + * 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 + + * tests/reader.test (reading)[CR recognized as a token + delimiter]: New test. + +2007-10-10 Ludovic Courtès + + * standalone/test-conversion.c: Include where + available. Use `PRIiMAX' and `PRIuMAX' to print + `scm_t_u?intmax'. Fixes warnings on x86_64. Reported by Poor + Yorick . + + * standalone/Makefile.am (test_cflags): Removed reference to + `libguile-ltdl'. + 2007-09-03 Ludovic Courtès * 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 #include +#include "config.h" + +#ifdef HAVE_INTTYPES_H +# include +#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)))))))