mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
Merge commit '2e77f7202b' into boehm-demers-weiser-gc
Conflicts: libguile/threads.c
This commit is contained in:
Ludovic Courtès
commit
e0513d4d77
20 changed files with 1120 additions and 55 deletions
28
ChangeLog
28
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.
|
||||
|
|
|
|||
665
HACKING
Normal file
665
HACKING
Normal file
|
|
@ -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 ===
|
||||
13
NEWS
13
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
|
||||
|
||||
|
|
|
|||
26
configure.in
26
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.
|
||||
|
|
|
|||
|
|
@ -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 ()'
|
||||
|
|
|
|||
|
|
@ -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");
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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 */
|
||||
|
||||
/*
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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)))))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue