diff options
author | Ludovic Courtès <ludo@gnu.org> | 2008-09-10 23:09:30 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2008-09-10 23:09:30 +0200 |
commit | 6f03035fe80d1c25ffadc42ec59c473402f65f60 (patch) | |
tree | a552a077bafe408ced8737674aecdf3007f31679 | |
parent | 328efeb9a66dddcf78a24fad96d3db58e9c3375d (diff) | |
parent | c5cd474d8c37bf32d7236e63d754a0eee9eb9071 (diff) | |
download | guile-6f03035fe80d1c25ffadc42ec59c473402f65f60.tar.gz |
Merge branch 'master' into boehm-demers-weiser-gc
Conflicts:
libguile/Makefile.am
libguile/coop-defs.h
libguile/gc-card.c
libguile/gc-freelist.c
libguile/gc-malloc.c
libguile/gc-mark.c
libguile/gc-segment.c
libguile/gc.c
libguile/gc.h
libguile/gc_os_dep.c
libguile/hashtab.c
libguile/hashtab.h
libguile/inline.h
libguile/private-gc.h
libguile/struct.c
libguile/struct.h
libguile/threads.c
libguile/threads.h
libguile/vectors.h
libguile/weaks.h
test-suite/tests/gc.test
298 files changed, 15411 insertions, 3248 deletions
diff --git a/.cvsignore b/.cvsignore index 109038aaa..20ee0b84c 100644 --- a/.cvsignore +++ b/.cvsignore @@ -10,12 +10,10 @@ compile confdefs.h config.build-subdirs config.cache -config.guess config.h config.h.in config.log config.status -config.sub configure conftest conftest.c @@ -24,6 +22,7 @@ elisp-comp guile-*.tar.gz guile-tools install-sh +lib libtool ltconfig ltmain.sh diff --git a/.gitignore b/.gitignore index 62660e298..a1221767f 100644 --- a/.gitignore +++ b/.gitignore @@ -28,6 +28,7 @@ mdate-sh install-sh texinfo.tex *~ +,* BUGS Makefile Makefile.in @@ -63,3 +64,9 @@ mkinstalldirs pre-inst-guile pre-inst-guile-env stamp-h1 +guile-procedures.txt +guile-config/guile-config +guile-readline/guile-readline-config.h +guile-readline/guile-readline-config.h.in +TAGS +guile-1.8.pc diff --git a/COPYING b/COPYING deleted file mode 100644 index e69de29bb..000000000 --- a/COPYING +++ /dev/null diff --git a/COPYING.LESSER b/COPYING.LESSER new file mode 100644 index 000000000..8add30ad5 --- /dev/null +++ b/COPYING.LESSER @@ -0,0 +1,504 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 2.1, February 1999 + + Copyright (C) 1991, 1999 Free Software Foundation, Inc. + 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +[This is the first released version of the Lesser GPL. It also counts + as the successor of the GNU Library Public License, version 2, hence + the version number 2.1.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Lesser General Public License, applies to some +specially designated software packages--typically libraries--of the +Free Software Foundation and other authors who decide to use it. You +can use it too, but we suggest you first think carefully about whether +this license or the ordinary General Public License is the better +strategy to use in any particular case, based on the explanations below. + + When we speak of free software, we are referring to freedom of use, +not price. Our General Public Licenses are designed to make sure that +you have the freedom to distribute copies of free software (and charge +for this service if you wish); that you receive source code or can get +it if you want it; that you can change the software and use pieces of +it in new free programs; and that you are informed that you can do +these things. + + To protect your rights, we need to make restrictions that forbid +distributors to deny you these rights or to ask you to surrender these +rights. These restrictions translate to certain responsibilities for +you if you distribute copies of the library or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link other code with the library, you must provide +complete object files to the recipients, so that they can relink them +with the library after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + We protect your rights with a two-step method: (1) we copyright the +library, and (2) we offer you this license, which gives you legal +permission to copy, distribute and/or modify the library. + + To protect each distributor, we want to make it very clear that +there is no warranty for the free library. Also, if the library is +modified by someone else and passed on, the recipients should know +that what they have is not the original version, so that the original +author's reputation will not be affected by problems that might be +introduced by others. + + Finally, software patents pose a constant threat to the existence of +any free program. We wish to make sure that a company cannot +effectively restrict the users of a free program by obtaining a +restrictive license from a patent holder. Therefore, we insist that +any patent license obtained for a version of the library must be +consistent with the full freedom of use specified in this license. + + Most GNU software, including some libraries, is covered by the +ordinary GNU General Public License. This license, the GNU Lesser +General Public License, applies to certain designated libraries, and +is quite different from the ordinary General Public License. We use +this license for certain libraries in order to permit linking those +libraries into non-free programs. + + When a program is linked with a library, whether statically or using +a shared library, the combination of the two is legally speaking a +combined work, a derivative of the original library. The ordinary +General Public License therefore permits such linking only if the +entire combination fits its criteria of freedom. The Lesser General +Public License permits more lax criteria for linking other code with +the library. + + We call this license the "Lesser" General Public License because it +does Less to protect the user's freedom than the ordinary General +Public License. It also provides other free software developers Less +of an advantage over competing non-free programs. These disadvantages +are the reason we use the ordinary General Public License for many +libraries. However, the Lesser license provides advantages in certain +special circumstances. + + For example, on rare occasions, there may be a special need to +encourage the widest possible use of a certain library, so that it becomes +a de-facto standard. To achieve this, non-free programs must be +allowed to use the library. A more frequent case is that a free +library does the same job as widely used non-free libraries. In this +case, there is little to gain by limiting the free library to free +software only, so we use the Lesser General Public License. + + In other cases, permission to use a particular library in non-free +programs enables a greater number of people to use a large body of +free software. For example, permission to use the GNU C Library in +non-free programs enables many more people to use the whole GNU +operating system, as well as its variant, the GNU/Linux operating +system. + + Although the Lesser General Public License is Less protective of the +users' freedom, it does ensure that the user of a program that is +linked with the Library has the freedom and the wherewithal to run +that program using a modified version of the Library. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, whereas the latter must +be combined with the library in order to run. + + GNU LESSER GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library or other +program which contains a notice placed by the copyright holder or +other authorized party saying it may be distributed under the terms of +this Lesser General Public License (also called "this License"). +Each licensee is addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control compilation +and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. + + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. + + 6. As an exception to the Sections above, you may also combine or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (1) uses at run time a + copy of the library already present on the user's computer system, + rather than copying library functions into the executable, and (2) + will operate properly with a modified version of the library, if + the user installs one, as long as the modified version is + interface-compatible with the version that the work was made with. + + c) Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + d) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + e) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the materials to be distributed need not include anything that is +normally distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. + + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties with +this License. + + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any +particular circumstance, the balance of the section is intended to apply, +and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License may add +an explicit geographical distribution limitation excluding those countries, +so that distribution is permitted only in or among countries not thus +excluded. In such case, this License incorporates the limitation as if +written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Lesser General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. + + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Libraries + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms of the +ordinary General Public License). + + To apply these terms, attach the following notices to the library. It is +safest to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + <one line to give the library's name and a brief idea of what it does.> + Copyright (C) <year> <name of author> + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +Also add information on how to contact you by electronic and paper mail. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the library, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + library `Frob' (a library for tweaking knobs) written by James Random Hacker. + + <signature of Ty Coon>, 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! + + diff --git a/COPYING.LIB b/COPYING.LIB deleted file mode 100644 index e69de29bb..000000000 --- a/COPYING.LIB +++ /dev/null @@ -1,3 +1,157 @@ +2008-08-25 Ludovic Courtès <ludo@gnu.org> + + * configure.in (GCC_CFLAGS): New variable. Store GCC flags like + `-Werror' inside it so that they are not used when compiling + Gnulib modules. + +2008-08-21 Ludovic Courtès <ludo@gnu.org> + + * autogen.sh: Don't use `gnulib-tool', use the Gnulib files + available in the repository. + +2008-08-07 Neil Jerram <neil@ossau.uklinux.net> + + * configure.in (SCM_I_GSC_STACK_GROWS_UP): Remove use of + AC_CACHE_CHECK, which was inadvertently causing + SCM_I_GSC_STACK_GROWS_UP _always_ to be 0. + +2008-07-17 Neil Jerram <neil@ossau.uklinux.net> + + * configure.in: Update stack direction test to be like that in + Autoconf _AC_LIBOBJ_ALLOCA and Gnulib; specifically in involving a + function calling itself. + +2008-07-16 Ludovic Courtès <ludo@gnu.org> + + * configure.in: Look for `struct dirent64' and `readdir64_r ()', + not available on HP-UX 11.11. + +2008-07-06 Ludovic Courtès <ludo@gnu.org> + + * configure.in: Update to Autoconf 2.61. + +2008-06-28 Ludovic Courtès <ludo@gnu.org> + + * configure.in: Use Automake with `-Wall -Wno-override'. + +2008-05-07 Ludovic Courtès <ludo@gnu.org> + + Guile 1.8.5 released. + + * GUILE-VERSION (LIBGUILE_INTERFACE_CURRENT): Increment due to + the addition of an inlined version of `scm getc ()' and friends. + (LIBGUILE_INTERFACE_AGE): Increment. + (LIBGUILE_INTERFACE_REVISION): Zeroed. + (LIBGUILE_SRFI_SRFI_1_INTERFACE_REVISION): Increment. + +2008-05-04 Ludovic Courtès <ludo@gnu.org> + + Add `pkg-config' support. Suggested by Aaron VanDevender, Greg + Troxel, and others. + + * configure.in: Substitute `sitedir', produce `guile-1.8.pc'. + * Makefile.am (EXTRA_DIST): Add `guile-1.8.pc.in'. + (pkgconfigdir, pkgconfig_DATA): New. + +2008-04-26 Ludovic Courtès <ludo@gnu.org> + + * configure.in (BUILD_PTHREAD_SUPPORT): New Automake + conditional. + +2008-04-26 Ludovic Courtès <ludo@gnu.org> + + * Makefile.am (EXTRA_DIST): Remove `ANON-CVS' and `SNAPSHOTS'. + +2008-02-23 Neil Jerram <neil@ossau.uklinux.net> + + * FAQ: New file. + + * Makefile.am (EXTRA_DIST): Add FAQ + +2008-02-22 Ludovic Courtès <ludo@gnu.org> + + * configure.in: Check whether `strncasecmp' is declared. + +2008-02-16 Ludovic Courtès <ludo@gnu.org> + + Guile 1.8.4 released. + + * GUILE-VERSION (LIBGUILE_INTERFACE_REVISION): Increment. + (GUILE_MICRO_VERSION): Increment. + + * configure.in (GUILE_CFLAGS): Include `$CPPFLAGS' since they + may include required `-I' flags (e.g., `-I/path/to/gmp'), so + that "guile-config compile" reports all the needed flags. + +2008-02-15 Neil Jerram <neil@ossau.uklinux.net> + + * autogen.sh: Copy versions of config.guess and config.sub from + Guile CVS to build-aux and guile-readline. + +2008-02-14 Neil Jerram <neil@ossau.uklinux.net> + + * HACKING: Note need for libtool >= 1.5.26. + + * config.rpath, build-aux/config.rpath: Updated to latest upstream + version. + + * config.guess, config.sub: 2008-01-07 versions added to Guile + CVS, to ensure that Guile developers are using new enough versions + (in particular for AIX 6.1 support). + +2008-02-11 Neil Jerram <neil@ossau.uklinux.net> + + * configure.in (--without-64-calls): Use AC_MSG_CHECKING and + AC_MSG_RESULT instead of just echo. + (GUILE_I): New programs to try using _Complex_I or 1.0fi for the + imaginary unit. + +2008-02-06 Neil Jerram <neil@ossau.uklinux.net> + + * configure.in: Default to --without-64-calls for + powerpc-ibm-aix*. Thanks to Rainer Tammer for reporting that the + 64 calls are a problem on that OS. + +2008-02-06 Ludovic Courtès <ludo@gnu.org> + + * NEWS: Mention Sun Studio compilation fix. + +2008-02-05 Neil Jerram <neil@ossau.uklinux.net> + + * configure.in (--without-64-calls): New option. + +2008-01-30 Neil Jerram <neil@ossau.uklinux.net> + + * pre-inst-guile.in (dyld_prefix), pre-inst-guile-env.in + (dyld_prefix): Construct and export dyld_prefix in a similar way + to ltdl_prefix, to allow pre-install dynamic linking to work on + MacOS. Thanks to Roger Mc Murtrie for reporting this problem. + +2008-01-22 Neil Jerram <neil@ossau.uklinux.net> + + * LICENSE: Change COPYING.LIB to COPYING.LESSER. + + * COPYING.LESSER: Renamed, previously COPYING.LIB. + + * COPYING: Removed. + + * libguile.h: Update copyright statement to LGPL. + +2007-12-04 Ludovic Courtès <ludo@gnu.org> + + * NEWS: Mention `accept' and `scm_c_{read,write}' bug fixes. + +2007-12-03 Ludovic Courtès <ludo@gnu.org> + + * NEWS: Add SRFI-69. + +2007-10-24 Neil Jerram <neil@ossau.uklinux.net> + + * .cvsignore: Add "lib". + + * build-aux/.cvsignore: Add a load more generated files to ignore, + and commit to CVS. + 2007-10-20 Ludovic Courtès <ludo@gnu.org> * THANKS: Add Julian. @@ -0,0 +1,19 @@ +Guile FAQ -*- outline -*- + +* Build problems + +** readline.c: error: `rl_pending_input' undeclared + +This occurs if the Readline library detected by Guile's configure +script is actually the BSD Editline project's supposedly +Readline-compatible library. The immediate fix is to uninstall +Editline and install the real GNU Readline instead. When you do this, +please note that it probably won't work to keep Editline in /usr and +install GNU Readline in /usr/local (or some similar arrangement), +because the Editline library will then still be picked up at link and +run time; it's best (subject to other constraints) to remove Editline +completely. + +For the longer term, please also report this problem to the Editline +project, to encourage them to fix it in the next release of their +Readline compatibility library. @@ -1,6 +1,6 @@ -*-text-*- Guile Hacking Guide -Copyright (c) 1996, 1997, 1998, 1999, 2000, 2001, 2002 Free software Foundation, Inc. +Copyright (c) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2008 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 @@ -66,7 +66,8 @@ Automake --- a system for automatically generating Makefiles that 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" + "ftp://ftp.gnu.org/pub/gnu/libtool". Version 1.5.26 (or + later) is needed for correct AIX support. gettext --- a system for rigging a program so that it can output its messages in the local tongue. Guile presently only exports @@ -163,210 +164,6 @@ 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 @@ -2,7 +2,7 @@ Installation Instructions ************************* Copyright (C) 1994, 1995, 1996, 1999, 2000, 2001, 2002, 2004, 2005, -2006 Free Software Foundation, Inc. +2006, 2007 Free Software Foundation, Inc. This file is free documentation; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. @@ -67,6 +67,9 @@ The simplest way to compile this package is: all sorts of other programs in order to regenerate files that came with the distribution. + 6. Often, you can also type `make uninstall' to remove the installed + files again. + Compilers and Options ===================== @@ -1,2 +1,2 @@ Guile is covered under the terms of the GNU Lesser General Public -License, version 2.1. See COPYING.LIB. +License, version 2.1. See COPYING.LESSER. diff --git a/Makefile.am b/Makefile.am index d86186ee4..016255a6a 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2006, 2007 Free Software Foundation, Inc. +## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2006, 2007, 2008 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -31,10 +31,8 @@ bin_SCRIPTS = guile-tools include_HEADERS = libguile.h -# automake sometimes forgets to distribute acconfig.h, -# apparently depending on the phase of the moon. -EXTRA_DIST = LICENSE HACKING GUILE-VERSION ANON-CVS SNAPSHOTS \ - m4/ChangeLog +EXTRA_DIST = LICENSE HACKING GUILE-VERSION \ + m4/ChangeLog FAQ guile-1.8.pc.in TESTS = check-guile @@ -42,4 +40,7 @@ ACLOCAL_AMFLAGS = -I guile-config -I m4 DISTCLEANFILES = check-guile.log +pkgconfigdir = $(libdir)/pkgconfig +pkgconfig_DATA = guile-1.8.pc + # Makefile.am ends here @@ -1,5 +1,5 @@ Guile NEWS --- history of user-visible changes. -Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. See the end for copying conditions. Please send Guile bug reports to bug-guile@gnu.org. Note that you @@ -11,6 +11,7 @@ Changes in 1.9.0: * New modules (see the manual for details) +** `(srfi srfi-18)', multithreading support ** The `(ice-9 i18n)' module provides internationalization support * Changes to the distribution @@ -31,16 +32,173 @@ See `cancel-thread', `set-thread-cleanup!', and `thread-cleanup'. * Changes to the C interface +** Internal `scm_i_' functions now have "hidden" linkage with GCC/ELF + +This makes these internal functions technically not callable from +application code. + ** Functions for handling `scm_option' now no longer require an argument indicating length of the `scm_t_option' array. +Changes in 1.8.6 (since 1.8.5) + +* New features (see the manual for details) + +** New convenience function `scm_c_symbol_length ()' + +** Single stepping through code from Emacs + +When you use GDS to evaluate Scheme code from Emacs, you can now use +`C-u' to indicate that you want to single step through that code. See +`Evaluating Scheme Code' in the manual for more details. + +* Changes to the distribution + +** Automake's `AM_MAINTAINER_MODE' is no longer used + +Thus, the `--enable-maintainer-mode' configure option is no longer +available: Guile is now always configured in "maintainer mode". + +* Bugs fixed + +** `guile-config link' now prints `-L$libdir' before `-lguile' +** Fix memory corruption involving GOOPS' `class-redefinition' +** Fix possible deadlock in `mutex-lock' +** Fix build issue on Tru64 and ia64-hp-hpux11.23 (`SCM_UNPACK' macro) +** Fix build issue on mips, mipsel, powerpc and ia64 (stack direction) +** Fix build issue on hppa2.0w-hp-hpux11.11 (`dirent64' and `readdir64_r') +** Fix misleading output from `(help rationalize)' +** Fix build failure on Debian hppa architecture (bad stack growth detection) + + +Changes in 1.8.5 (since 1.8.4) + +* Infrastructure changes + +** Guile repository switched from CVS to Git + +The new repository can be accessed using +"git-clone git://git.sv.gnu.org/guile.git", or can be browsed on-line at +http://git.sv.gnu.org/gitweb/?p=guile.git . See `README' for details. + +** Add support for `pkg-config' + +See "Autoconf Support" in the manual for details. + +* New modules (see the manual for details) + +** `(srfi srfi-88)' + +* New features (see the manual for details) + +** New `postfix' read option, for SRFI-88 keyword syntax +** Some I/O primitives have been inlined, which improves I/O performance +** New object-based traps infrastructure + +This is a GOOPS-based infrastructure that builds on Guile's low-level +evaluator trap calls and facilitates the development of debugging +features like single-stepping, breakpoints, tracing and profiling. +See the `Traps' node of the manual for details. + +** New support for working on Guile code from within Emacs + +Guile now incorporates the `GDS' library (previously distributed +separately) for working on Guile code from within Emacs. See the +`Using Guile In Emacs' node of the manual for details. + +* Bugs fixed + +** `scm_add_slot ()' no longer segfaults (fixes bug #22369) +** Fixed `(ice-9 match)' for patterns like `((_ ...) ...)' + +Previously, expressions like `(match '((foo) (bar)) (((_ ...) ...) #t))' +would trigger an unbound variable error for `match:andmap'. + +** `(oop goops describe)' now properly provides the `describe' feature +** Fixed `args-fold' from `(srfi srfi-37)' + +Previously, parsing short option names of argument-less options would +lead to a stack overflow. + +** `(srfi srfi-35)' is now visible through `cond-expand' +** Fixed type-checking for the second argument of `eval' +** Fixed type-checking for SRFI-1 `partition' +** Fixed `struct-ref' and `struct-set!' on "light structs" +** Honor struct field access rights in GOOPS +** Changed the storage strategy of source properties, which fixes a deadlock +** Allow compilation of Guile-using programs in C99 mode with GCC 4.3 and later +** Fixed build issue for GNU/Linux on IA64 +** Fixed build issues on NetBSD 1.6 +** Fixed build issue on Solaris 2.10 x86_64 +** Fixed build issue with DEC/Compaq/HP's compiler +** Fixed `scm_from_complex_double' build issue on FreeBSD +** Fixed `alloca' build issue on FreeBSD 6 +** Removed use of non-portable makefile constructs +** Fixed shadowing of libc's <random.h> on Tru64, which broke compilation +** Make sure all tests honor `$TMPDIR' + +* Changes to the distribution + +** New FAQ + +We've started collecting Frequently Asked Questions (FAQ), and will +distribute these (with answers!) in future Guile releases. + + Changes in 1.8.4 (since 1.8.3) * Bugs fixed ** CR (ASCII 0x0d) is (again) recognized as a token delimiter by the reader +** Fixed a segmentation fault which occurred when displaying the +backtrace of a stack with a promise object (made by `delay') in it. +** Make `accept' leave guile mode while blocking +** `scm_c_read ()' and `scm_c_write ()' now type-check their port argument +** Fixed a build problem on AIX (use of func_data identifier) +** Fixed a segmentation fault which occurred when hashx-ref or hashx-set! was +called with an associator proc that returns neither a pair nor #f. +** Secondary threads now always return a valid module for (current-module). +** Avoid MacOS build problems caused by incorrect combination of "64" +system and library calls. +** `guile-snarf' now honors `$TMPDIR' +** `guile-config compile' now reports CPPFLAGS used at compile-time +** Fixed build with Sun Studio (Solaris 9) +** Fixed wrong-type-arg errors when creating zero length SRFI-4 +uniform vectors on AIX. +** Fixed a deadlock that occurs upon GC with multiple threads. +** Fixed compile problem with GCC on Solaris and AIX (use of _Complex_I) +** Fixed autotool-derived build problems on AIX 6.1. +** Fixed NetBSD/alpha support +** Fixed MacOS build problem caused by use of rl_get_keymap(_name) + +* New modules (see the manual for details) + +** `(srfi srfi-69)' + +* Documentation fixes and improvements + +** Removed premature breakpoint documentation + +The features described are not available in the series of 1.8.x +releases, so the documentation was misleading and has been removed. + +** More about Guile's default *random-state* variable + +** GOOPS: more about how to use `next-method' + +* Changes to the distribution + +** Corrected a few files that referred incorrectly to the old GPL + special exception licence + +In fact Guile since 1.8.0 has been licensed with the GNU Lesser +General Public License, and the few incorrect files have now been +fixed to agree with the rest of the Guile distribution. + +** Removed unnecessary extra copies of COPYING* + +The distribution now contains a single COPYING.LESSER at its top level. Changes in 1.8.3 (since 1.8.2) @@ -1,5 +1,5 @@ !!! This is not a Guile release; it is a source tree retrieved via -anonymous CVS or as a nightly snapshot at some random time after the +Git or as a nightly snapshot at some random time after the Guile 1.8 release. If this were a Guile release, you would not see this message. !!! [fixme: zonk on release] @@ -364,14 +364,24 @@ guile-readline: library on your system. doc: Documentation (see above). -Anonymous CVS Access and FTP snapshots =============================== +Git Repository Access ================================================ -We make the developers' working Guile sources available via anonymous -CVS, and by nightly snapshots, accessible via FTP. See the files -`ANON-CVS' and `SNAPSHOTS' for details. +Guile's source code is stored in a Git repository at Savannah. Anyone +can access it using `git-clone' from one of the following URLs: -If you would like to receive mail when people commit changes to the -Guile CVS repository, you can subscribe to guile-cvs@gnu.org by the -Mailman mailing list interface at + git://git.sv.gnu.org/guile.git + http://git.sv.gnu.org/r/guile.git - <http://mail.gnu.org/mailman/listinfo/guile-cvs> +Developers with a Savannah SSH account can also access it from: + + ssh://git.sv.gnu.org/srv/git/guile.git + +The repository can also be browsed on-line at the following address: + + http://git.sv.gnu.org/gitweb/?p=guile.git + +For more information on Git, please see: + + http://git.or.cz/ + +Please send problem reports to <bug-guile@gnu.org>. diff --git a/README.CVS b/README.CVS deleted file mode 100644 index 93ccb0a61..000000000 --- a/README.CVS +++ /dev/null @@ -1,26 +0,0 @@ -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 in HACKING (see 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. - -In addition to the guile/guile-core module that holds the main -sources, you also need the two modules guile/guile-scripts and -guile/workbook. For example, you can use this command to check out -all three modules: - - $ cvs -d:ext:anoncvs@savannah.gnu.org:/cvsroot/guile \ - co guile/guile-core guile/guile-scripts guile/workbook - -Then you must run the autogen.sh script in guile/guile-core: - - $ cd guile/guile-core - $ ./autogen.sh - -For more information about hacking Guile and some troubleshooting -hints, see the file HACKING. It can be found in guile/guile-core and -guile/workbook/build/dist-files/. @@ -2,6 +2,7 @@ Contributors since the last release: Rob Browning Ludovic Courtès + Julian Graham Stefan Jahn Neil Jerram Antoine Mathys @@ -27,6 +28,7 @@ For fixes or providing information which led to a fix: Stephen Compall Brian Crowder Christopher Cramer + David Diffenbaugh Hyper Division Alexandre Duret-Lutz Nils Durner @@ -35,12 +37,14 @@ For fixes or providing information which led to a fix: Charles Gagnon Peter Gavin Eric Gillespie, Jr + Didier Godefroy John Goerzen Mike Gran Szavai Gyula Sven Hartrumpf Eric Hanchrow Sam Hocevar + Patrick Horgan Ales Hvezda Peter Ivanyi Wolfgang Jaehrling @@ -49,17 +53,23 @@ For fixes or providing information which led to a fix: Steve Juranich Richard Kim Bruce Korb + René Köcher Matthias Köppe Matt Kraai Miroslav Lichvar Jeff Long Marco Maggi + Gregory Marton + Antoine Mathys Dan McMahill + Roger Mc Murtrie + Tim Mooney Han-Wen Nienhuys Jan Nieuwenhuizen Hrvoje NikÅ¡ić Stefan Nordhausen Roland Orre + Peter O'Gorman Pieter Pareit Jack Pavlovsky Arno Peters @@ -71,14 +81,18 @@ For fixes or providing information which led to a fix: Hugh Sasse Werner Scheinast Bill Schottstaedt + Frank Schwidom + Thiemo Seufer Scott Shedden Alex Shinn Daniel Skarda Cesar Strauss + Rainer Tammer Richard Todd Issac Trotts Greg Troxel Aaron M. Ucko + Stephen Uitti Momchil Velikov Panagiotis Vossos Neil W. Van Dyke diff --git a/autogen.sh b/autogen.sh index a24bd6d97..47656cb3a 100755 --- a/autogen.sh +++ b/autogen.sh @@ -19,17 +19,19 @@ libtool --version echo "" ${M4:-/usr/bin/m4} --version echo "" -gnulib-tool --version -echo "" ###################################################################### ### update infrastructure -gnulib-tool --update && \ autoreconf -i --force --verbose echo "guile-readline..." (cd guile-readline && ./autogen.sh) +# Copy versions of config.guess and config.sub from Guile's repository to +# build-aux and guile-readline. +cp -f config.guess config.sub build-aux/ +cp -f config.guess config.sub guile-readline/ + echo "Now run configure and make." echo "You must pass the \`--enable-maintainer-mode' option to configure." diff --git a/benchmark-suite/COPYING b/benchmark-suite/COPYING deleted file mode 100644 index e69de29bb..000000000 --- a/benchmark-suite/COPYING +++ /dev/null diff --git a/benchmark-suite/ChangeLog b/benchmark-suite/ChangeLog index 0ec92fdb0..fcfedc2de 100644 --- a/benchmark-suite/ChangeLog +++ b/benchmark-suite/ChangeLog @@ -1,3 +1,12 @@ +2008-04-17 Ludovic Courtès <ludo@gnu.org> + + * Makefile.am (SCM_BENCHMARKS): Add `benchmarks/read.bm'. + * benchmarks/read.bm: New file. + +2008-01-22 Neil Jerram <neil@ossau.uklinux.net> + + * COPYING: Removed. + 2006-11-17 Neil Jerram <neil@ossau.uklinux.net> * README: Note need for subscription to bug-guile@gnu.org. diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am index 464150a5c..a8f471996 100644 --- a/benchmark-suite/Makefile.am +++ b/benchmark-suite/Makefile.am @@ -1,6 +1,7 @@ -SCM_BENCHMARKS = benchmarks/0-reference.bm \ - benchmarks/continuations.bm \ - benchmarks/if.bm \ - benchmarks/logand.bm +SCM_BENCHMARKS = benchmarks/0-reference.bm \ + benchmarks/continuations.bm \ + benchmarks/if.bm \ + benchmarks/logand.bm \ + benchmarks/read.bm EXTRA_DIST = guile-benchmark lib.scm $(SCM_BENCHMARKS) diff --git a/benchmark-suite/benchmarks/read.bm b/benchmark-suite/benchmarks/read.bm new file mode 100644 index 000000000..cb876b5ad --- /dev/null +++ b/benchmark-suite/benchmarks/read.bm @@ -0,0 +1,62 @@ +;;; read.bm --- Exercise the reader. -*- Scheme -*- +;;; +;;; Copyright (C) 2008 Free Software Foundation, Inc. +;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this software; see the file COPYING. If not, write to +;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;;; Boston, MA 02110-1301 USA + +(define-module (benchmarks read) + :use-module (benchmark-suite lib)) + + +(define %files-to-load + ;; Various large Scheme files. + (map %search-load-path + '("ice-9/boot-9.scm" "ice-9/common-list.scm" + "ice-9/format.scm" "ice-9/optargs.scm" + "ice-9/session.scm" "ice-9/getopt-long.scm" + "ice-9/psyntax.pp"))) + +(define (load-file-with-reader file-name reader buffering) + (with-input-from-file file-name + (lambda () + (apply setvbuf (current-input-port) buffering) + (let loop ((sexp (reader))) + (if (eof-object? sexp) + #t + (loop (reader))))))) + +(define (exercise-read buffering) + (for-each (lambda (file) + (load-file-with-reader file read buffering)) + %files-to-load)) + + +(with-benchmark-prefix "read" + + (benchmark "_IONBF" 5 ;; this one is very slow + (exercise-read (list _IONBF))) + + (benchmark "_IOLBF" 100 + (exercise-read (list _IOLBF))) + + (benchmark "_IOFBF 4096" 100 + (exercise-read (list _IOFBF 4096))) + + (benchmark "_IOFBF 8192" 100 + (exercise-read (list _IOFBF 8192))) + + (benchmark "_IOFBF 16384" 100 + (exercise-read (list _IOFBF 16384)))) diff --git a/build-aux/.cvsignore b/build-aux/.cvsignore new file mode 100644 index 000000000..0537cdb09 --- /dev/null +++ b/build-aux/.cvsignore @@ -0,0 +1,13 @@ +.deps +.dirstamp +link-warning.h +compile +config.guess +config.sub +depcomp +elisp-comp +install-sh +ltmain.sh +mdate-sh +missing +texinfo.tex diff --git a/build-aux/.gitignore b/build-aux/.gitignore new file mode 100644 index 000000000..dae5b406d --- /dev/null +++ b/build-aux/.gitignore @@ -0,0 +1 @@ +link-warning.h diff --git a/build-aux/config.rpath b/build-aux/config.rpath index c492a93b6..35f959b87 100755 --- a/build-aux/config.rpath +++ b/build-aux/config.rpath @@ -2,7 +2,7 @@ # Output a system dependent set of variables, describing how to set the # run time search path of shared libraries in an executable. # -# Copyright 1996-2006 Free Software Foundation, Inc. +# Copyright 1996-2008 Free Software Foundation, Inc. # Taken from GNU libtool, 2001 # Originally by Gordon Matzigkeit <gord@gnu.ai.mit.edu>, 1996 # @@ -64,7 +64,7 @@ else ;; esac ;; - mingw* | pw32* | os2*) + mingw* | cygwin* | pw32* | os2*) ;; hpux9* | hpux10* | hpux11*) wl='-Wl,' @@ -74,7 +74,7 @@ else ;; newsos6) ;; - linux*) + linux* | k*bsd*-gnu) case $cc_basename in icc* | ecc*) wl='-Wl,' @@ -100,7 +100,7 @@ else osf3* | osf4* | osf5*) wl='-Wl,' ;; - sco3.2v5*) + rdos*) ;; solaris*) wl='-Wl,' @@ -108,11 +108,14 @@ else sunos4*) wl='-Qoption ld ' ;; - sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*) + sysv4 | sysv4.2uw2* | sysv4.3*) wl='-Wl,' ;; sysv4*MP*) ;; + sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) + wl='-Wl,' + ;; unicos*) wl='-Wl,' ;; @@ -155,7 +158,7 @@ if test "$with_gnu_ld" = yes; then # option of GNU ld is called -rpath, not --rpath. hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' case "$host_os" in - aix3* | aix4* | aix5*) + aix[3-9]*) # On AIX/PPC, the GNU linker is very broken if test "$host_cpu" != ia64; then ld_shlibs=no @@ -189,11 +192,11 @@ if test "$with_gnu_ld" = yes; then ld_shlibs=no fi ;; - interix3*) + interix[3-9]*) hardcode_direct=no hardcode_libdir_flag_spec='${wl}-rpath,$libdir' ;; - linux*) + gnu* | linux* | k*bsd*-gnu) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then : else @@ -251,7 +254,7 @@ else hardcode_direct=unsupported fi ;; - aix4* | aix5*) + aix[4-9]*) if test "$host_cpu" = ia64; then # On IA64, the linker does run time linking by default, so we don't # have to do anything special. @@ -261,7 +264,7 @@ else # Test if we are trying to use run time linking or normal # AIX style linking. If -brtl is somewhere in LDFLAGS, we # need to do runtime linking. - case $host_os in aix4.[23]|aix4.[23].*|aix5*) + case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*) for ld_flag in $LDFLAGS; do if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then aix_use_runtimelinking=yes @@ -280,7 +283,7 @@ else strings "$collect2name" | grep resolve_lib_name >/dev/null then # We have reworked collect2 - hardcode_direct=yes + : else # We have old collect2 hardcode_direct=unsupported @@ -359,7 +362,7 @@ else hardcode_direct=yes hardcode_minus_L=yes ;; - freebsd* | kfreebsd*-gnu | dragonfly*) + freebsd* | dragonfly*) hardcode_libdir_flag_spec='-R$libdir' hardcode_direct=yes ;; @@ -412,18 +415,22 @@ else hardcode_libdir_separator=: ;; openbsd*) - hardcode_direct=yes - if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then - hardcode_libdir_flag_spec='${wl}-rpath,$libdir' + if test -f /usr/libexec/ld.so; then + hardcode_direct=yes + if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then + hardcode_libdir_flag_spec='${wl}-rpath,$libdir' + else + case "$host_os" in + openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*) + hardcode_libdir_flag_spec='-R$libdir' + ;; + *) + hardcode_libdir_flag_spec='${wl}-rpath,$libdir' + ;; + esac + fi else - case "$host_os" in - openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*) - hardcode_libdir_flag_spec='-R$libdir' - ;; - *) - hardcode_libdir_flag_spec='${wl}-rpath,$libdir' - ;; - esac + ld_shlibs=no fi ;; os2*) @@ -471,7 +478,7 @@ else ld_shlibs=yes fi ;; - sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7*) + sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*) ;; sysv5* | sco3.2v5* | sco5v6*) hardcode_libdir_flag_spec='`test -z "$SCOABSPATH" && echo ${wl}-R,$libdir`' @@ -488,33 +495,51 @@ fi # Check dynamic linker characteristics # Code taken from libtool.m4's AC_LIBTOOL_SYS_DYNAMIC_LINKER. +# Unlike libtool.m4, here we don't care about _all_ names of the library, but +# only about the one the linker finds when passed -lNAME. This is the last +# element of library_names_spec in libtool.m4, or possibly two of them if the +# linker has special search rules. +library_names_spec= # the last element of library_names_spec in libtool.m4 libname_spec='lib$name' case "$host_os" in aix3*) + library_names_spec='$libname.a' ;; - aix4* | aix5*) + aix[4-9]*) + library_names_spec='$libname$shrext' ;; amigaos*) + library_names_spec='$libname.a' ;; beos*) + library_names_spec='$libname$shrext' ;; bsdi[45]*) + library_names_spec='$libname$shrext' ;; cygwin* | mingw* | pw32*) shrext=.dll + library_names_spec='$libname.dll.a $libname.lib' ;; darwin* | rhapsody*) shrext=.dylib + library_names_spec='$libname$shrext' ;; dgux*) + library_names_spec='$libname$shrext' ;; freebsd1*) ;; - kfreebsd*-gnu) - ;; freebsd* | dragonfly*) + case "$host_os" in + freebsd[123]*) + library_names_spec='$libname$shrext$versuffix' ;; + *) + library_names_spec='$libname$shrext' ;; + esac ;; gnu*) + library_names_spec='$libname$shrext' ;; hpux9* | hpux10* | hpux11*) case $host_cpu in @@ -528,10 +553,13 @@ case "$host_os" in shrext=.sl ;; esac + library_names_spec='$libname$shrext' ;; - interix3*) + interix[3-9]*) + library_names_spec='$libname$shrext' ;; irix5* | irix6* | nonstopux*) + library_names_spec='$libname$shrext' case "$host_os" in irix5* | nonstopux*) libsuff= shlibsuff= @@ -548,41 +576,59 @@ case "$host_os" in ;; linux*oldld* | linux*aout* | linux*coff*) ;; - linux*) + linux* | k*bsd*-gnu) + library_names_spec='$libname$shrext' ;; knetbsd*-gnu) + library_names_spec='$libname$shrext' ;; netbsd*) + library_names_spec='$libname$shrext' ;; newsos6) + library_names_spec='$libname$shrext' ;; nto-qnx*) + library_names_spec='$libname$shrext' ;; openbsd*) + library_names_spec='$libname$shrext$versuffix' ;; os2*) libname_spec='$name' shrext=.dll + library_names_spec='$libname.a' ;; osf3* | osf4* | osf5*) + library_names_spec='$libname$shrext' + ;; + rdos*) ;; solaris*) + library_names_spec='$libname$shrext' ;; sunos4*) + library_names_spec='$libname$shrext$versuffix' ;; sysv4 | sysv4.3*) + library_names_spec='$libname$shrext' ;; sysv4*MP*) + library_names_spec='$libname$shrext' ;; sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) + library_names_spec='$libname$shrext' ;; uts4*) + library_names_spec='$libname$shrext' ;; esac sed_quote_subst='s/\(["`$\\]\)/\\\1/g' escaped_wl=`echo "X$wl" | sed -e 's/^X//' -e "$sed_quote_subst"` shlibext=`echo "$shrext" | sed -e 's,^\.,,'` +escaped_libname_spec=`echo "X$libname_spec" | sed -e 's/^X//' -e "$sed_quote_subst"` +escaped_library_names_spec=`echo "X$library_names_spec" | sed -e 's/^X//' -e "$sed_quote_subst"` escaped_hardcode_libdir_flag_spec=`echo "X$hardcode_libdir_flag_spec" | sed -e 's/^X//' -e "$sed_quote_subst"` LC_ALL=C sed -e 's/^\([a-zA-Z0-9_]*\)=/acl_cv_\1=/' <<EOF @@ -596,6 +642,12 @@ libext="$libext" # Shared library suffix (normally "so"). shlibext="$shlibext" +# Format of library name prefix. +libname_spec="$escaped_libname_spec" + +# Library names that the linker finds when passed -lNAME. +library_names_spec="$escaped_library_names_spec" + # Flag to hardcode \$libdir into a binary during linking. # This must work even if \$libdir does not exist. hardcode_libdir_flag_spec="$escaped_hardcode_libdir_flag_spec" diff --git a/build-aux/link-warning.h b/build-aux/link-warning.h new file mode 100644 index 000000000..fda01941a --- /dev/null +++ b/build-aux/link-warning.h @@ -0,0 +1,28 @@ +/* GL_LINK_WARNING("literal string") arranges to emit the literal string as + a linker warning on most glibc systems. + We use a linker warning rather than a preprocessor warning, because + #warning cannot be used inside macros. */ +#ifndef GL_LINK_WARNING + /* This works on platforms with GNU ld and ELF object format. + Testing __GLIBC__ is sufficient for asserting that GNU ld is in use. + Testing __ELF__ guarantees the ELF object format. + Testing __GNUC__ is necessary for the compound expression syntax. */ +# if defined __GLIBC__ && defined __ELF__ && defined __GNUC__ +# define GL_LINK_WARNING(message) \ + GL_LINK_WARNING1 (__FILE__, __LINE__, message) +# define GL_LINK_WARNING1(file, line, message) \ + GL_LINK_WARNING2 (file, line, message) /* macroexpand file and line */ +# define GL_LINK_WARNING2(file, line, message) \ + GL_LINK_WARNING3 (file ":" #line ": warning: " message) +# define GL_LINK_WARNING3(message) \ + ({ static const char warning[sizeof (message)] \ + __attribute__ ((__unused__, \ + __section__ (".gnu.warning"), \ + __aligned__ (1))) \ + = message "\n"; \ + (void)0; \ + }) +# else +# define GL_LINK_WARNING(message) ((void) 0) +# endif +#endif diff --git a/config.guess b/config.guess new file mode 100755 index 000000000..03e59a22e --- /dev/null +++ b/config.guess @@ -0,0 +1,1526 @@ +#! /bin/sh +# Attempt to guess a canonical system name. +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 +# Free Software Foundation, Inc. + +timestamp='2008-01-07' + +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA +# 02110-1301, USA. +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that program. + + +# Originally written by Per Bothner <per@bothner.com>. +# Please send patches to <config-patches@gnu.org>. Submit a context +# diff and a properly formatted ChangeLog entry. +# +# This script attempts to guess a canonical system name similar to +# config.sub. If it succeeds, it prints the system name on stdout, and +# exits with 0. Otherwise, it exits with 1. +# +# The plan is that this can be called by configure scripts if you +# don't specify an explicit build system type. + +me=`echo "$0" | sed -e 's,.*/,,'` + +usage="\ +Usage: $0 [OPTION] + +Output the configuration name of the system \`$me' is run on. + +Operation modes: + -h, --help print this help, then exit + -t, --time-stamp print date of last modification, then exit + -v, --version print version number, then exit + +Report bugs and patches to <config-patches@gnu.org>." + +version="\ +GNU config.guess ($timestamp) + +Originally written by Per Bothner. +Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 +Free Software Foundation, Inc. + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." + +help=" +Try \`$me --help' for more information." + +# Parse command line +while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) + echo "$timestamp" ; exit ;; + --version | -v ) + echo "$version" ; exit ;; + --help | --h* | -h ) + echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. + break ;; + -* ) + echo "$me: invalid option $1$help" >&2 + exit 1 ;; + * ) + break ;; + esac +done + +if test $# != 0; then + echo "$me: too many arguments$help" >&2 + exit 1 +fi + +trap 'exit 1' 1 2 15 + +# CC_FOR_BUILD -- compiler used by this script. Note that the use of a +# compiler to aid in system detection is discouraged as it requires +# temporary files to be created and, as you can see below, it is a +# headache to deal with in a portable fashion. + +# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still +# use `HOST_CC' if defined, but it is deprecated. + +# Portable tmp directory creation inspired by the Autoconf team. + +set_cc_for_build=' +trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; +trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; +: ${TMPDIR=/tmp} ; + { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || + { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || + { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || + { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; +dummy=$tmp/dummy ; +tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ; +case $CC_FOR_BUILD,$HOST_CC,$CC in + ,,) echo "int x;" > $dummy.c ; + for c in cc gcc c89 c99 ; do + if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then + CC_FOR_BUILD="$c"; break ; + fi ; + done ; + if test x"$CC_FOR_BUILD" = x ; then + CC_FOR_BUILD=no_compiler_found ; + fi + ;; + ,,*) CC_FOR_BUILD=$CC ;; + ,*,*) CC_FOR_BUILD=$HOST_CC ;; +esac ; set_cc_for_build= ;' + +# This is needed to find uname on a Pyramid OSx when run in the BSD universe. +# (ghazi@noc.rutgers.edu 1994-08-24) +if (test -f /.attbin/uname) >/dev/null 2>&1 ; then + PATH=$PATH:/.attbin ; export PATH +fi + +UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown +UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown +UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown +UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown + +# Note: order is significant - the case branches are not exclusive. + +case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + *:NetBSD:*:*) + # NetBSD (nbsd) targets should (where applicable) match one or + # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, + # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently + # switched to ELF, *-*-netbsd* would select the old + # object file format. This provides both forward + # compatibility and a consistent mechanism for selecting the + # object file format. + # + # Note: NetBSD doesn't particularly care about the vendor + # portion of the name. We always set it to "unknown". + sysctl="sysctl -n hw.machine_arch" + UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ + /usr/sbin/$sysctl 2>/dev/null || echo unknown)` + case "${UNAME_MACHINE_ARCH}" in + armeb) machine=armeb-unknown ;; + arm*) machine=arm-unknown ;; + sh3el) machine=shl-unknown ;; + sh3eb) machine=sh-unknown ;; + sh5el) machine=sh5le-unknown ;; + *) machine=${UNAME_MACHINE_ARCH}-unknown ;; + esac + # The Operating System including object format, if it has switched + # to ELF recently, or will in the future. + case "${UNAME_MACHINE_ARCH}" in + arm*|i386|m68k|ns32k|sh3*|sparc|vax) + eval $set_cc_for_build + if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep __ELF__ >/dev/null + then + # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). + # Return netbsd for either. FIX? + os=netbsd + else + os=netbsdelf + fi + ;; + *) + os=netbsd + ;; + esac + # The OS release + # Debian GNU/NetBSD machines have a different userland, and + # thus, need a distinct triplet. However, they do not need + # kernel version information, so it can be replaced with a + # suitable tag, in the style of linux-gnu. + case "${UNAME_VERSION}" in + Debian*) + release='-gnu' + ;; + *) + release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` + ;; + esac + # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: + # contains redundant information, the shorter form: + # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. + echo "${machine}-${os}${release}" + exit ;; + *:OpenBSD:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} + exit ;; + *:ekkoBSD:*:*) + echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE} + exit ;; + *:SolidBSD:*:*) + echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE} + exit ;; + macppc:MirBSD:*:*) + echo powerpc-unknown-mirbsd${UNAME_RELEASE} + exit ;; + *:MirBSD:*:*) + echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} + exit ;; + alpha:OSF1:*:*) + case $UNAME_RELEASE in + *4.0) + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` + ;; + *5.*) + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + ;; + esac + # According to Compaq, /usr/sbin/psrinfo has been available on + # OSF/1 and Tru64 systems produced since 1995. I hope that + # covers most systems running today. This code pipes the CPU + # types through head -n 1, so we only detect the type of CPU 0. + ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` + case "$ALPHA_CPU_TYPE" in + "EV4 (21064)") + UNAME_MACHINE="alpha" ;; + "EV4.5 (21064)") + UNAME_MACHINE="alpha" ;; + "LCA4 (21066/21068)") + UNAME_MACHINE="alpha" ;; + "EV5 (21164)") + UNAME_MACHINE="alphaev5" ;; + "EV5.6 (21164A)") + UNAME_MACHINE="alphaev56" ;; + "EV5.6 (21164PC)") + UNAME_MACHINE="alphapca56" ;; + "EV5.7 (21164PC)") + UNAME_MACHINE="alphapca57" ;; + "EV6 (21264)") + UNAME_MACHINE="alphaev6" ;; + "EV6.7 (21264A)") + UNAME_MACHINE="alphaev67" ;; + "EV6.8CB (21264C)") + UNAME_MACHINE="alphaev68" ;; + "EV6.8AL (21264B)") + UNAME_MACHINE="alphaev68" ;; + "EV6.8CX (21264D)") + UNAME_MACHINE="alphaev68" ;; + "EV6.9A (21264/EV69A)") + UNAME_MACHINE="alphaev69" ;; + "EV7 (21364)") + UNAME_MACHINE="alphaev7" ;; + "EV7.9 (21364A)") + UNAME_MACHINE="alphaev79" ;; + esac + # A Pn.n version is a patched version. + # A Vn.n version is a released version. + # A Tn.n version is a released field test version. + # A Xn.n version is an unreleased experimental baselevel. + # 1.2 uses "1.2" for uname -r. + echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` + exit ;; + Alpha\ *:Windows_NT*:*) + # How do we know it's Interix rather than the generic POSIX subsystem? + # Should we change UNAME_MACHINE based on the output of uname instead + # of the specific Alpha model? + echo alpha-pc-interix + exit ;; + 21064:Windows_NT:50:3) + echo alpha-dec-winnt3.5 + exit ;; + Amiga*:UNIX_System_V:4.0:*) + echo m68k-unknown-sysv4 + exit ;; + *:[Aa]miga[Oo][Ss]:*:*) + echo ${UNAME_MACHINE}-unknown-amigaos + exit ;; + *:[Mm]orph[Oo][Ss]:*:*) + echo ${UNAME_MACHINE}-unknown-morphos + exit ;; + *:OS/390:*:*) + echo i370-ibm-openedition + exit ;; + *:z/VM:*:*) + echo s390-ibm-zvmoe + exit ;; + *:OS400:*:*) + echo powerpc-ibm-os400 + exit ;; + arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) + echo arm-acorn-riscix${UNAME_RELEASE} + exit ;; + arm:riscos:*:*|arm:RISCOS:*:*) + echo arm-unknown-riscos + exit ;; + SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) + echo hppa1.1-hitachi-hiuxmpp + exit ;; + Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) + # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. + if test "`(/bin/universe) 2>/dev/null`" = att ; then + echo pyramid-pyramid-sysv3 + else + echo pyramid-pyramid-bsd + fi + exit ;; + NILE*:*:*:dcosx) + echo pyramid-pyramid-svr4 + exit ;; + DRS?6000:unix:4.0:6*) + echo sparc-icl-nx6 + exit ;; + DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) + case `/usr/bin/uname -p` in + sparc) echo sparc-icl-nx7; exit ;; + esac ;; + sun4H:SunOS:5.*:*) + echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) + echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + sun4*:SunOS:6*:*) + # According to config.sub, this is the proper way to canonicalize + # SunOS6. Hard to guess exactly what SunOS6 will be like, but + # it's likely to be more like Solaris than SunOS4. + echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + sun4*:SunOS:*:*) + case "`/usr/bin/arch -k`" in + Series*|S4*) + UNAME_RELEASE=`uname -v` + ;; + esac + # Japanese Language versions have a version number like `4.1.3-JL'. + echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` + exit ;; + sun3*:SunOS:*:*) + echo m68k-sun-sunos${UNAME_RELEASE} + exit ;; + sun*:*:4.2BSD:*) + UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` + test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 + case "`/bin/arch`" in + sun3) + echo m68k-sun-sunos${UNAME_RELEASE} + ;; + sun4) + echo sparc-sun-sunos${UNAME_RELEASE} + ;; + esac + exit ;; + aushp:SunOS:*:*) + echo sparc-auspex-sunos${UNAME_RELEASE} + exit ;; + # The situation for MiNT is a little confusing. The machine name + # can be virtually everything (everything which is not + # "atarist" or "atariste" at least should have a processor + # > m68000). The system name ranges from "MiNT" over "FreeMiNT" + # to the lowercase version "mint" (or "freemint"). Finally + # the system name "TOS" denotes a system which is actually not + # MiNT. But MiNT is downward compatible to TOS, so this should + # be no problem. + atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit ;; + atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit ;; + *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit ;; + milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; + hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; + *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; + m68k:machten:*:*) + echo m68k-apple-machten${UNAME_RELEASE} + exit ;; + powerpc:machten:*:*) + echo powerpc-apple-machten${UNAME_RELEASE} + exit ;; + RISC*:Mach:*:*) + echo mips-dec-mach_bsd4.3 + exit ;; + RISC*:ULTRIX:*:*) + echo mips-dec-ultrix${UNAME_RELEASE} + exit ;; + VAX*:ULTRIX*:*:*) + echo vax-dec-ultrix${UNAME_RELEASE} + exit ;; + 2020:CLIX:*:* | 2430:CLIX:*:*) + echo clipper-intergraph-clix${UNAME_RELEASE} + exit ;; + mips:*:*:UMIPS | mips:*:*:RISCos) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c +#ifdef __cplusplus +#include <stdio.h> /* for printf() prototype */ + int main (int argc, char *argv[]) { +#else + int main (argc, argv) int argc; char *argv[]; { +#endif + #if defined (host_mips) && defined (MIPSEB) + #if defined (SYSTYPE_SYSV) + printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_SVR4) + printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) + printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0); + #endif + #endif + exit (-1); + } +EOF + $CC_FOR_BUILD -o $dummy $dummy.c && + dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` && + SYSTEM_NAME=`$dummy $dummyarg` && + { echo "$SYSTEM_NAME"; exit; } + echo mips-mips-riscos${UNAME_RELEASE} + exit ;; + Motorola:PowerMAX_OS:*:*) + echo powerpc-motorola-powermax + exit ;; + Motorola:*:4.3:PL8-*) + echo powerpc-harris-powermax + exit ;; + Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) + echo powerpc-harris-powermax + exit ;; + Night_Hawk:Power_UNIX:*:*) + echo powerpc-harris-powerunix + exit ;; + m88k:CX/UX:7*:*) + echo m88k-harris-cxux7 + exit ;; + m88k:*:4*:R4*) + echo m88k-motorola-sysv4 + exit ;; + m88k:*:3*:R3*) + echo m88k-motorola-sysv3 + exit ;; + AViiON:dgux:*:*) + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` + if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] + then + if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ + [ ${TARGET_BINARY_INTERFACE}x = x ] + then + echo m88k-dg-dgux${UNAME_RELEASE} + else + echo m88k-dg-dguxbcs${UNAME_RELEASE} + fi + else + echo i586-dg-dgux${UNAME_RELEASE} + fi + exit ;; + M88*:DolphinOS:*:*) # DolphinOS (SVR3) + echo m88k-dolphin-sysv3 + exit ;; + M88*:*:R3*:*) + # Delta 88k system running SVR3 + echo m88k-motorola-sysv3 + exit ;; + XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) + echo m88k-tektronix-sysv3 + exit ;; + Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) + echo m68k-tektronix-bsd + exit ;; + *:IRIX*:*:*) + echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` + exit ;; + ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. + echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id + exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' + i*86:AIX:*:*) + echo i386-ibm-aix + exit ;; + ia64:AIX:*:*) + if [ -x /usr/bin/oslevel ] ; then + IBM_REV=`/usr/bin/oslevel` + else + IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} + fi + echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} + exit ;; + *:AIX:2:3) + if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #include <sys/systemcfg.h> + + main() + { + if (!__power_pc()) + exit(1); + puts("powerpc-ibm-aix3.2.5"); + exit(0); + } +EOF + if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` + then + echo "$SYSTEM_NAME" + else + echo rs6000-ibm-aix3.2.5 + fi + elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then + echo rs6000-ibm-aix3.2.4 + else + echo rs6000-ibm-aix3.2 + fi + exit ;; + *:AIX:*:[456]) + IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` + if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then + IBM_ARCH=rs6000 + else + IBM_ARCH=powerpc + fi + if [ -x /usr/bin/oslevel ] ; then + IBM_REV=`/usr/bin/oslevel` + else + IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} + fi + echo ${IBM_ARCH}-ibm-aix${IBM_REV} + exit ;; + *:AIX:*:*) + echo rs6000-ibm-aix + exit ;; + ibmrt:4.4BSD:*|romp-ibm:BSD:*) + echo romp-ibm-bsd4.4 + exit ;; + ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and + echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to + exit ;; # report: romp-ibm BSD 4.3 + *:BOSX:*:*) + echo rs6000-bull-bosx + exit ;; + DPX/2?00:B.O.S.:*:*) + echo m68k-bull-sysv3 + exit ;; + 9000/[34]??:4.3bsd:1.*:*) + echo m68k-hp-bsd + exit ;; + hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) + echo m68k-hp-bsd4.4 + exit ;; + 9000/[34678]??:HP-UX:*:*) + HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` + case "${UNAME_MACHINE}" in + 9000/31? ) HP_ARCH=m68000 ;; + 9000/[34]?? ) HP_ARCH=m68k ;; + 9000/[678][0-9][0-9]) + if [ -x /usr/bin/getconf ]; then + sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; + '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 + esac ;; + esac + fi + if [ "${HP_ARCH}" = "" ]; then + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + + #define _HPUX_SOURCE + #include <stdlib.h> + #include <unistd.h> + + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); + + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } +EOF + (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` + test -z "$HP_ARCH" && HP_ARCH=hppa + fi ;; + esac + if [ ${HP_ARCH} = "hppa2.0w" ] + then + eval $set_cc_for_build + + # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating + # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler + # generating 64-bit code. GNU and HP use different nomenclature: + # + # $ CC_FOR_BUILD=cc ./config.guess + # => hppa2.0w-hp-hpux11.23 + # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess + # => hppa64-hp-hpux11.23 + + if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | + grep __LP64__ >/dev/null + then + HP_ARCH="hppa2.0w" + else + HP_ARCH="hppa64" + fi + fi + echo ${HP_ARCH}-hp-hpux${HPUX_REV} + exit ;; + ia64:HP-UX:*:*) + HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` + echo ia64-hp-hpux${HPUX_REV} + exit ;; + 3050*:HI-UX:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #include <unistd.h> + int + main () + { + long cpu = sysconf (_SC_CPU_VERSION); + /* The order matters, because CPU_IS_HP_MC68K erroneously returns + true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct + results, however. */ + if (CPU_IS_PA_RISC (cpu)) + { + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; + case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; + default: puts ("hppa-hitachi-hiuxwe2"); break; + } + } + else if (CPU_IS_HP_MC68K (cpu)) + puts ("m68k-hitachi-hiuxwe2"); + else puts ("unknown-hitachi-hiuxwe2"); + exit (0); + } +EOF + $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` && + { echo "$SYSTEM_NAME"; exit; } + echo unknown-hitachi-hiuxwe2 + exit ;; + 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) + echo hppa1.1-hp-bsd + exit ;; + 9000/8??:4.3bsd:*:*) + echo hppa1.0-hp-bsd + exit ;; + *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) + echo hppa1.0-hp-mpeix + exit ;; + hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) + echo hppa1.1-hp-osf + exit ;; + hp8??:OSF1:*:*) + echo hppa1.0-hp-osf + exit ;; + i*86:OSF1:*:*) + if [ -x /usr/sbin/sysversion ] ; then + echo ${UNAME_MACHINE}-unknown-osf1mk + else + echo ${UNAME_MACHINE}-unknown-osf1 + fi + exit ;; + parisc*:Lites*:*:*) + echo hppa1.1-hp-lites + exit ;; + C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) + echo c1-convex-bsd + exit ;; + C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) + if getsysinfo -f scalar_acc + then echo c32-convex-bsd + else echo c2-convex-bsd + fi + exit ;; + C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) + echo c34-convex-bsd + exit ;; + C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) + echo c38-convex-bsd + exit ;; + C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) + echo c4-convex-bsd + exit ;; + CRAY*Y-MP:*:*:*) + echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*[A-Z]90:*:*:*) + echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ + | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ + -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ + -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*TS:*:*:*) + echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*T3E:*:*:*) + echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*SV1:*:*:*) + echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + *:UNICOS/mp:*:*) + echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) + FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; + 5000:UNIX_System_V:4.*:*) + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; + i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) + echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} + exit ;; + sparc*:BSD/OS:*:*) + echo sparc-unknown-bsdi${UNAME_RELEASE} + exit ;; + *:BSD/OS:*:*) + echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} + exit ;; + *:FreeBSD:*:*) + case ${UNAME_MACHINE} in + pc98) + echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + amd64) + echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + *) + echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + esac + exit ;; + i*:CYGWIN*:*) + echo ${UNAME_MACHINE}-pc-cygwin + exit ;; + *:MINGW*:*) + echo ${UNAME_MACHINE}-pc-mingw32 + exit ;; + i*:windows32*:*) + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 + exit ;; + i*:PW*:*) + echo ${UNAME_MACHINE}-pc-pw32 + exit ;; + *:Interix*:[3456]*) + case ${UNAME_MACHINE} in + x86) + echo i586-pc-interix${UNAME_RELEASE} + exit ;; + EM64T | authenticamd) + echo x86_64-unknown-interix${UNAME_RELEASE} + exit ;; + IA64) + echo ia64-unknown-interix${UNAME_RELEASE} + exit ;; + esac ;; + [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) + echo i${UNAME_MACHINE}-pc-mks + exit ;; + i*:Windows_NT*:* | Pentium*:Windows_NT*:*) + # How do we know it's Interix rather than the generic POSIX subsystem? + # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we + # UNAME_MACHINE based on the output of uname instead of i386? + echo i586-pc-interix + exit ;; + i*:UWIN*:*) + echo ${UNAME_MACHINE}-pc-uwin + exit ;; + amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) + echo x86_64-unknown-cygwin + exit ;; + p*:CYGWIN*:*) + echo powerpcle-unknown-cygwin + exit ;; + prep*:SunOS:5.*:*) + echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + *:GNU:*:*) + # the GNU system + echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` + exit ;; + *:GNU/*:*:*) + # other systems with GNU libc and userland + echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu + exit ;; + i*86:Minix:*:*) + echo ${UNAME_MACHINE}-pc-minix + exit ;; + arm*:Linux:*:*) + eval $set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo ${UNAME_MACHINE}-unknown-linux-gnu + else + echo ${UNAME_MACHINE}-unknown-linux-gnueabi + fi + exit ;; + avr32*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + cris:Linux:*:*) + echo cris-axis-linux-gnu + exit ;; + crisv32:Linux:*:*) + echo crisv32-axis-linux-gnu + exit ;; + frv:Linux:*:*) + echo frv-unknown-linux-gnu + exit ;; + ia64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + m32r*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + m68*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + mips:Linux:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #undef CPU + #undef mips + #undef mipsel + #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) + CPU=mipsel + #else + #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) + CPU=mips + #else + CPU= + #endif + #endif +EOF + eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' + /^CPU/{ + s: ::g + p + }'`" + test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } + ;; + mips64:Linux:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #undef CPU + #undef mips64 + #undef mips64el + #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) + CPU=mips64el + #else + #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) + CPU=mips64 + #else + CPU= + #endif + #endif +EOF + eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' + /^CPU/{ + s: ::g + p + }'`" + test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } + ;; + or32:Linux:*:*) + echo or32-unknown-linux-gnu + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-gnu + exit ;; + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-gnu + exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null + if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi + echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + exit ;; + parisc:Linux:*:* | hppa:Linux:*:*) + # Look for CPU level + case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in + PA7*) echo hppa1.1-unknown-linux-gnu ;; + PA8*) echo hppa2.0-unknown-linux-gnu ;; + *) echo hppa-unknown-linux-gnu ;; + esac + exit ;; + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-gnu + exit ;; + s390:Linux:*:* | s390x:Linux:*:*) + echo ${UNAME_MACHINE}-ibm-linux + exit ;; + sh64*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + sh*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + sparc:Linux:*:* | sparc64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + vax:Linux:*:*) + echo ${UNAME_MACHINE}-dec-linux-gnu + exit ;; + x86_64:Linux:*:*) + echo x86_64-unknown-linux-gnu + exit ;; + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + i*86:Linux:*:*) + # The BFD linker knows what the default object file format is, so + # first see if it will tell us. cd to the root directory to prevent + # problems with other programs or directories called `ld' in the path. + # Set LC_ALL=C to ensure ld outputs messages in English. + ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ + | sed -ne '/supported targets:/!d + s/[ ][ ]*/ /g + s/.*supported targets: *// + s/ .*// + p'` + case "$ld_supported_targets" in + elf32-i386) + TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" + ;; + a.out-i386-linux) + echo "${UNAME_MACHINE}-pc-linux-gnuaout" + exit ;; + coff-i386) + echo "${UNAME_MACHINE}-pc-linux-gnucoff" + exit ;; + "") + # Either a pre-BFD a.out linker (linux-gnuoldld) or + # one that does not give us useful --help. + echo "${UNAME_MACHINE}-pc-linux-gnuoldld" + exit ;; + esac + # Determine whether the default compiler is a.out or elf + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #include <features.h> + #ifdef __ELF__ + # ifdef __GLIBC__ + # if __GLIBC__ >= 2 + LIBC=gnu + # else + LIBC=gnulibc1 + # endif + # else + LIBC=gnulibc1 + # endif + #else + #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC) + LIBC=gnu + #else + LIBC=gnuaout + #endif + #endif + #ifdef __dietlibc__ + LIBC=dietlibc + #endif +EOF + eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' + /^LIBC/{ + s: ::g + p + }'`" + test x"${LIBC}" != x && { + echo "${UNAME_MACHINE}-pc-linux-${LIBC}" + exit + } + test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } + ;; + i*86:DYNIX/ptx:4*:*) + # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. + # earlier versions are messed up and put the nodename in both + # sysname and nodename. + echo i386-sequent-sysv4 + exit ;; + i*86:UNIX_SV:4.2MP:2.*) + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, + # I just have to hope. -- rms. + # Use sysv4.2uw... so that sysv4* matches it. + echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} + exit ;; + i*86:OS/2:*:*) + # If we were able to find `uname', then EMX Unix compatibility + # is probably installed. + echo ${UNAME_MACHINE}-pc-os2-emx + exit ;; + i*86:XTS-300:*:STOP) + echo ${UNAME_MACHINE}-unknown-stop + exit ;; + i*86:atheos:*:*) + echo ${UNAME_MACHINE}-unknown-atheos + exit ;; + i*86:syllable:*:*) + echo ${UNAME_MACHINE}-pc-syllable + exit ;; + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) + echo i386-unknown-lynxos${UNAME_RELEASE} + exit ;; + i*86:*DOS:*:*) + echo ${UNAME_MACHINE}-pc-msdosdjgpp + exit ;; + i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*) + UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` + if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then + echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL} + else + echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} + fi + exit ;; + i*86:*:5:[678]*) + # UnixWare 7.x, OpenUNIX and OpenServer 6. + case `/bin/uname -X | grep "^Machine"` in + *486*) UNAME_MACHINE=i486 ;; + *Pentium) UNAME_MACHINE=i586 ;; + *Pent*|*Celeron) UNAME_MACHINE=i686 ;; + esac + echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} + exit ;; + i*86:*:3.2:*) + if test -f /usr/options/cb.name; then + UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name` + echo ${UNAME_MACHINE}-pc-isc$UNAME_REL + elif /bin/uname -X 2>/dev/null >/dev/null ; then + UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` + (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 + (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ + && UNAME_MACHINE=i586 + (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ + && UNAME_MACHINE=i686 + (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ + && UNAME_MACHINE=i686 + echo ${UNAME_MACHINE}-pc-sco$UNAME_REL + else + echo ${UNAME_MACHINE}-pc-sysv32 + fi + exit ;; + pc:*:*:*) + # Left here for compatibility: + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i386. + echo i386-pc-msdosdjgpp + exit ;; + Intel:Mach:3*:*) + echo i386-pc-mach3 + exit ;; + paragon:*:*:*) + echo i860-intel-osf1 + exit ;; + i860:*:4.*:*) # i860-SVR4 + if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then + echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 + else # Add other i860-SVR4 vendors below as they are discovered. + echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 + fi + exit ;; + mini*:CTIX:SYS*5:*) + # "miniframe" + echo m68010-convergent-sysv + exit ;; + mc68k:UNIX:SYSTEM5:3.51m) + echo m68k-convergent-sysv + exit ;; + M680?0:D-NIX:5.3:*) + echo m68k-diab-dnix + exit ;; + M68*:*:R3V[5678]*:*) + test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; + 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) + OS_REL='' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; + 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) + echo m68k-unknown-lynxos${UNAME_RELEASE} + exit ;; + mc68030:UNIX_System_V:4.*:*) + echo m68k-atari-sysv4 + exit ;; + TSUNAMI:LynxOS:2.*:*) + echo sparc-unknown-lynxos${UNAME_RELEASE} + exit ;; + rs6000:LynxOS:2.*:*) + echo rs6000-unknown-lynxos${UNAME_RELEASE} + exit ;; + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) + echo powerpc-unknown-lynxos${UNAME_RELEASE} + exit ;; + SM[BE]S:UNIX_SV:*:*) + echo mips-dde-sysv${UNAME_RELEASE} + exit ;; + RM*:ReliantUNIX-*:*:*) + echo mips-sni-sysv4 + exit ;; + RM*:SINIX-*:*:*) + echo mips-sni-sysv4 + exit ;; + *:SINIX-*:*:*) + if uname -p 2>/dev/null >/dev/null ; then + UNAME_MACHINE=`(uname -p) 2>/dev/null` + echo ${UNAME_MACHINE}-sni-sysv4 + else + echo ns32k-sni-sysv + fi + exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says <Richard.M.Bartel@ccMail.Census.GOV> + echo i586-unisys-sysv4 + exit ;; + *:UNIX_System_V:4*:FTX*) + # From Gerald Hewes <hewes@openmarket.com>. + # How about differentiating between stratus architectures? -djm + echo hppa1.1-stratus-sysv4 + exit ;; + *:*:*:FTX*) + # From seanf@swdc.stratus.com. + echo i860-stratus-sysv4 + exit ;; + i*86:VOS:*:*) + # From Paul.Green@stratus.com. + echo ${UNAME_MACHINE}-stratus-vos + exit ;; + *:VOS:*:*) + # From Paul.Green@stratus.com. + echo hppa1.1-stratus-vos + exit ;; + mc68*:A/UX:*:*) + echo m68k-apple-aux${UNAME_RELEASE} + exit ;; + news*:NEWS-OS:6*:*) + echo mips-sony-newsos6 + exit ;; + R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) + if [ -d /usr/nec ]; then + echo mips-nec-sysv${UNAME_RELEASE} + else + echo mips-unknown-sysv${UNAME_RELEASE} + fi + exit ;; + BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. + echo powerpc-be-beos + exit ;; + BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. + echo powerpc-apple-beos + exit ;; + BePC:BeOS:*:*) # BeOS running on Intel PC compatible. + echo i586-pc-beos + exit ;; + SX-4:SUPER-UX:*:*) + echo sx4-nec-superux${UNAME_RELEASE} + exit ;; + SX-5:SUPER-UX:*:*) + echo sx5-nec-superux${UNAME_RELEASE} + exit ;; + SX-6:SUPER-UX:*:*) + echo sx6-nec-superux${UNAME_RELEASE} + exit ;; + SX-7:SUPER-UX:*:*) + echo sx7-nec-superux${UNAME_RELEASE} + exit ;; + SX-8:SUPER-UX:*:*) + echo sx8-nec-superux${UNAME_RELEASE} + exit ;; + SX-8R:SUPER-UX:*:*) + echo sx8r-nec-superux${UNAME_RELEASE} + exit ;; + Power*:Rhapsody:*:*) + echo powerpc-apple-rhapsody${UNAME_RELEASE} + exit ;; + *:Rhapsody:*:*) + echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} + exit ;; + *:Darwin:*:*) + UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown + case $UNAME_PROCESSOR in + unknown) UNAME_PROCESSOR=powerpc ;; + esac + echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} + exit ;; + *:procnto*:*:* | *:QNX:[0123456789]*:*) + UNAME_PROCESSOR=`uname -p` + if test "$UNAME_PROCESSOR" = "x86"; then + UNAME_PROCESSOR=i386 + UNAME_MACHINE=pc + fi + echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE} + exit ;; + *:QNX:*:4*) + echo i386-pc-qnx + exit ;; + NSE-?:NONSTOP_KERNEL:*:*) + echo nse-tandem-nsk${UNAME_RELEASE} + exit ;; + NSR-?:NONSTOP_KERNEL:*:*) + echo nsr-tandem-nsk${UNAME_RELEASE} + exit ;; + *:NonStop-UX:*:*) + echo mips-compaq-nonstopux + exit ;; + BS2000:POSIX*:*:*) + echo bs2000-siemens-sysv + exit ;; + DS/*:UNIX_System_V:*:*) + echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} + exit ;; + *:Plan9:*:*) + # "uname -m" is not consistent, so use $cputype instead. 386 + # is converted to i386 for consistency with other x86 + # operating systems. + if test "$cputype" = "386"; then + UNAME_MACHINE=i386 + else + UNAME_MACHINE="$cputype" + fi + echo ${UNAME_MACHINE}-unknown-plan9 + exit ;; + *:TOPS-10:*:*) + echo pdp10-unknown-tops10 + exit ;; + *:TENEX:*:*) + echo pdp10-unknown-tenex + exit ;; + KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) + echo pdp10-dec-tops20 + exit ;; + XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) + echo pdp10-xkl-tops20 + exit ;; + *:TOPS-20:*:*) + echo pdp10-unknown-tops20 + exit ;; + *:ITS:*:*) + echo pdp10-unknown-its + exit ;; + SEI:*:*:SEIUX) + echo mips-sei-seiux${UNAME_RELEASE} + exit ;; + *:DragonFly:*:*) + echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` + exit ;; + *:*VMS:*:*) + UNAME_MACHINE=`(uname -p) 2>/dev/null` + case "${UNAME_MACHINE}" in + A*) echo alpha-dec-vms ; exit ;; + I*) echo ia64-dec-vms ; exit ;; + V*) echo vax-dec-vms ; exit ;; + esac ;; + *:XENIX:*:SysV) + echo i386-pc-xenix + exit ;; + i*86:skyos:*:*) + echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//' + exit ;; + i*86:rdos:*:*) + echo ${UNAME_MACHINE}-pc-rdos + exit ;; +esac + +#echo '(No uname command or uname output not recognized.)' 1>&2 +#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 + +eval $set_cc_for_build +cat >$dummy.c <<EOF +#ifdef _SEQUENT_ +# include <sys/types.h> +# include <sys/utsname.h> +#endif +main () +{ +#if defined (sony) +#if defined (MIPSEB) + /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, + I don't know.... */ + printf ("mips-sony-bsd\n"); exit (0); +#else +#include <sys/param.h> + printf ("m68k-sony-newsos%s\n", +#ifdef NEWSOS4 + "4" +#else + "" +#endif + ); exit (0); +#endif +#endif + +#if defined (__arm) && defined (__acorn) && defined (__unix) + printf ("arm-acorn-riscix\n"); exit (0); +#endif + +#if defined (hp300) && !defined (hpux) + printf ("m68k-hp-bsd\n"); exit (0); +#endif + +#if defined (NeXT) +#if !defined (__ARCHITECTURE__) +#define __ARCHITECTURE__ "m68k" +#endif + int version; + version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; + if (version < 4) + printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); + else + printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); + exit (0); +#endif + +#if defined (MULTIMAX) || defined (n16) +#if defined (UMAXV) + printf ("ns32k-encore-sysv\n"); exit (0); +#else +#if defined (CMU) + printf ("ns32k-encore-mach\n"); exit (0); +#else + printf ("ns32k-encore-bsd\n"); exit (0); +#endif +#endif +#endif + +#if defined (__386BSD__) + printf ("i386-pc-bsd\n"); exit (0); +#endif + +#if defined (sequent) +#if defined (i386) + printf ("i386-sequent-dynix\n"); exit (0); +#endif +#if defined (ns32000) + printf ("ns32k-sequent-dynix\n"); exit (0); +#endif +#endif + +#if defined (_SEQUENT_) + struct utsname un; + + uname(&un); + + if (strncmp(un.version, "V2", 2) == 0) { + printf ("i386-sequent-ptx2\n"); exit (0); + } + if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ + printf ("i386-sequent-ptx1\n"); exit (0); + } + printf ("i386-sequent-ptx\n"); exit (0); + +#endif + +#if defined (vax) +# if !defined (ultrix) +# include <sys/param.h> +# if defined (BSD) +# if BSD == 43 + printf ("vax-dec-bsd4.3\n"); exit (0); +# else +# if BSD == 199006 + printf ("vax-dec-bsd4.3reno\n"); exit (0); +# else + printf ("vax-dec-bsd\n"); exit (0); +# endif +# endif +# else + printf ("vax-dec-bsd\n"); exit (0); +# endif +# else + printf ("vax-dec-ultrix\n"); exit (0); +# endif +#endif + +#if defined (alliant) && defined (i860) + printf ("i860-alliant-bsd\n"); exit (0); +#endif + + exit (1); +} +EOF + +$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` && + { echo "$SYSTEM_NAME"; exit; } + +# Apollos put the system type in the environment. + +test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; } + +# Convex versions that predate uname can use getsysinfo(1) + +if [ -x /usr/convex/getsysinfo ] +then + case `getsysinfo -f cpu_type` in + c1*) + echo c1-convex-bsd + exit ;; + c2*) + if getsysinfo -f scalar_acc + then echo c32-convex-bsd + else echo c2-convex-bsd + fi + exit ;; + c34*) + echo c34-convex-bsd + exit ;; + c38*) + echo c38-convex-bsd + exit ;; + c4*) + echo c4-convex-bsd + exit ;; + esac +fi + +cat >&2 <<EOF +$0: unable to guess system type + +This script, last modified $timestamp, has failed to recognize +the operating system you are using. It is advised that you +download the most up to date version of the config scripts from + + http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess +and + http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub + +If the version you run ($0) is already up to date, please +send the following data and any information you think might be +pertinent to <config-patches@gnu.org> in order to provide the needed +information to handle your system. + +config.guess timestamp = $timestamp + +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null` + +hostinfo = `(hostinfo) 2>/dev/null` +/bin/universe = `(/bin/universe) 2>/dev/null` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` +/bin/arch = `(/bin/arch) 2>/dev/null` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` + +UNAME_MACHINE = ${UNAME_MACHINE} +UNAME_RELEASE = ${UNAME_RELEASE} +UNAME_SYSTEM = ${UNAME_SYSTEM} +UNAME_VERSION = ${UNAME_VERSION} +EOF + +exit 1 + +# Local variables: +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "timestamp='" +# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-end: "'" +# End: diff --git a/config.rpath b/config.rpath index c492a93b6..35f959b87 100755 --- a/config.rpath +++ b/config.rpath @@ -2,7 +2,7 @@ # Output a system dependent set of variables, describing how to set the # run time search path of shared libraries in an executable. # -# Copyright 1996-2006 Free Software Foundation, Inc. +# Copyright 1996-2008 Free Software Foundation, Inc. # Taken from GNU libtool, 2001 # Originally by Gordon Matzigkeit <gord@gnu.ai.mit.edu>, 1996 # @@ -64,7 +64,7 @@ else ;; esac ;; - mingw* | pw32* | os2*) + mingw* | cygwin* | pw32* | os2*) ;; hpux9* | hpux10* | hpux11*) wl='-Wl,' @@ -74,7 +74,7 @@ else ;; newsos6) ;; - linux*) + linux* | k*bsd*-gnu) case $cc_basename in icc* | ecc*) wl='-Wl,' @@ -100,7 +100,7 @@ else osf3* | osf4* | osf5*) wl='-Wl,' ;; - sco3.2v5*) + rdos*) ;; solaris*) wl='-Wl,' @@ -108,11 +108,14 @@ else sunos4*) wl='-Qoption ld ' ;; - sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*) + sysv4 | sysv4.2uw2* | sysv4.3*) wl='-Wl,' ;; sysv4*MP*) ;; + sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) + wl='-Wl,' + ;; unicos*) wl='-Wl,' ;; @@ -155,7 +158,7 @@ if test "$with_gnu_ld" = yes; then # option of GNU ld is called -rpath, not --rpath. hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' case "$host_os" in - aix3* | aix4* | aix5*) + aix[3-9]*) # On AIX/PPC, the GNU linker is very broken if test "$host_cpu" != ia64; then ld_shlibs=no @@ -189,11 +192,11 @@ if test "$with_gnu_ld" = yes; then ld_shlibs=no fi ;; - interix3*) + interix[3-9]*) hardcode_direct=no hardcode_libdir_flag_spec='${wl}-rpath,$libdir' ;; - linux*) + gnu* | linux* | k*bsd*-gnu) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then : else @@ -251,7 +254,7 @@ else hardcode_direct=unsupported fi ;; - aix4* | aix5*) + aix[4-9]*) if test "$host_cpu" = ia64; then # On IA64, the linker does run time linking by default, so we don't # have to do anything special. @@ -261,7 +264,7 @@ else # Test if we are trying to use run time linking or normal # AIX style linking. If -brtl is somewhere in LDFLAGS, we # need to do runtime linking. - case $host_os in aix4.[23]|aix4.[23].*|aix5*) + case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*) for ld_flag in $LDFLAGS; do if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then aix_use_runtimelinking=yes @@ -280,7 +283,7 @@ else strings "$collect2name" | grep resolve_lib_name >/dev/null then # We have reworked collect2 - hardcode_direct=yes + : else # We have old collect2 hardcode_direct=unsupported @@ -359,7 +362,7 @@ else hardcode_direct=yes hardcode_minus_L=yes ;; - freebsd* | kfreebsd*-gnu | dragonfly*) + freebsd* | dragonfly*) hardcode_libdir_flag_spec='-R$libdir' hardcode_direct=yes ;; @@ -412,18 +415,22 @@ else hardcode_libdir_separator=: ;; openbsd*) - hardcode_direct=yes - if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then - hardcode_libdir_flag_spec='${wl}-rpath,$libdir' + if test -f /usr/libexec/ld.so; then + hardcode_direct=yes + if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then + hardcode_libdir_flag_spec='${wl}-rpath,$libdir' + else + case "$host_os" in + openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*) + hardcode_libdir_flag_spec='-R$libdir' + ;; + *) + hardcode_libdir_flag_spec='${wl}-rpath,$libdir' + ;; + esac + fi else - case "$host_os" in - openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*) - hardcode_libdir_flag_spec='-R$libdir' - ;; - *) - hardcode_libdir_flag_spec='${wl}-rpath,$libdir' - ;; - esac + ld_shlibs=no fi ;; os2*) @@ -471,7 +478,7 @@ else ld_shlibs=yes fi ;; - sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7*) + sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*) ;; sysv5* | sco3.2v5* | sco5v6*) hardcode_libdir_flag_spec='`test -z "$SCOABSPATH" && echo ${wl}-R,$libdir`' @@ -488,33 +495,51 @@ fi # Check dynamic linker characteristics # Code taken from libtool.m4's AC_LIBTOOL_SYS_DYNAMIC_LINKER. +# Unlike libtool.m4, here we don't care about _all_ names of the library, but +# only about the one the linker finds when passed -lNAME. This is the last +# element of library_names_spec in libtool.m4, or possibly two of them if the +# linker has special search rules. +library_names_spec= # the last element of library_names_spec in libtool.m4 libname_spec='lib$name' case "$host_os" in aix3*) + library_names_spec='$libname.a' ;; - aix4* | aix5*) + aix[4-9]*) + library_names_spec='$libname$shrext' ;; amigaos*) + library_names_spec='$libname.a' ;; beos*) + library_names_spec='$libname$shrext' ;; bsdi[45]*) + library_names_spec='$libname$shrext' ;; cygwin* | mingw* | pw32*) shrext=.dll + library_names_spec='$libname.dll.a $libname.lib' ;; darwin* | rhapsody*) shrext=.dylib + library_names_spec='$libname$shrext' ;; dgux*) + library_names_spec='$libname$shrext' ;; freebsd1*) ;; - kfreebsd*-gnu) - ;; freebsd* | dragonfly*) + case "$host_os" in + freebsd[123]*) + library_names_spec='$libname$shrext$versuffix' ;; + *) + library_names_spec='$libname$shrext' ;; + esac ;; gnu*) + library_names_spec='$libname$shrext' ;; hpux9* | hpux10* | hpux11*) case $host_cpu in @@ -528,10 +553,13 @@ case "$host_os" in shrext=.sl ;; esac + library_names_spec='$libname$shrext' ;; - interix3*) + interix[3-9]*) + library_names_spec='$libname$shrext' ;; irix5* | irix6* | nonstopux*) + library_names_spec='$libname$shrext' case "$host_os" in irix5* | nonstopux*) libsuff= shlibsuff= @@ -548,41 +576,59 @@ case "$host_os" in ;; linux*oldld* | linux*aout* | linux*coff*) ;; - linux*) + linux* | k*bsd*-gnu) + library_names_spec='$libname$shrext' ;; knetbsd*-gnu) + library_names_spec='$libname$shrext' ;; netbsd*) + library_names_spec='$libname$shrext' ;; newsos6) + library_names_spec='$libname$shrext' ;; nto-qnx*) + library_names_spec='$libname$shrext' ;; openbsd*) + library_names_spec='$libname$shrext$versuffix' ;; os2*) libname_spec='$name' shrext=.dll + library_names_spec='$libname.a' ;; osf3* | osf4* | osf5*) + library_names_spec='$libname$shrext' + ;; + rdos*) ;; solaris*) + library_names_spec='$libname$shrext' ;; sunos4*) + library_names_spec='$libname$shrext$versuffix' ;; sysv4 | sysv4.3*) + library_names_spec='$libname$shrext' ;; sysv4*MP*) + library_names_spec='$libname$shrext' ;; sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) + library_names_spec='$libname$shrext' ;; uts4*) + library_names_spec='$libname$shrext' ;; esac sed_quote_subst='s/\(["`$\\]\)/\\\1/g' escaped_wl=`echo "X$wl" | sed -e 's/^X//' -e "$sed_quote_subst"` shlibext=`echo "$shrext" | sed -e 's,^\.,,'` +escaped_libname_spec=`echo "X$libname_spec" | sed -e 's/^X//' -e "$sed_quote_subst"` +escaped_library_names_spec=`echo "X$library_names_spec" | sed -e 's/^X//' -e "$sed_quote_subst"` escaped_hardcode_libdir_flag_spec=`echo "X$hardcode_libdir_flag_spec" | sed -e 's/^X//' -e "$sed_quote_subst"` LC_ALL=C sed -e 's/^\([a-zA-Z0-9_]*\)=/acl_cv_\1=/' <<EOF @@ -596,6 +642,12 @@ libext="$libext" # Shared library suffix (normally "so"). shlibext="$shlibext" +# Format of library name prefix. +libname_spec="$escaped_libname_spec" + +# Library names that the linker finds when passed -lNAME. +library_names_spec="$escaped_library_names_spec" + # Flag to hardcode \$libdir into a binary during linking. # This must work even if \$libdir does not exist. hardcode_libdir_flag_spec="$escaped_hardcode_libdir_flag_spec" diff --git a/config.sub b/config.sub new file mode 100755 index 000000000..ae780f333 --- /dev/null +++ b/config.sub @@ -0,0 +1,1654 @@ +#! /bin/sh +# Configuration validation subroutine script. +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 +# Free Software Foundation, Inc. + +timestamp='2008-01-07' + +# This file is (in principle) common to ALL GNU software. +# The presence of a machine in this file suggests that SOME GNU software +# can handle that machine. It does not imply ALL GNU software can. +# +# This file is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA +# 02110-1301, USA. +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that program. + + +# Please send patches to <config-patches@gnu.org>. Submit a context +# diff and a properly formatted ChangeLog entry. +# +# Configuration subroutine to validate and canonicalize a configuration type. +# Supply the specified configuration type as an argument. +# If it is invalid, we print an error message on stderr and exit with code 1. +# Otherwise, we print the canonical config type on stdout and succeed. + +# This file is supposed to be the same for all GNU packages +# and recognize all the CPU types, system types and aliases +# that are meaningful with *any* GNU software. +# Each package is responsible for reporting which valid configurations +# it does not support. The user should be able to distinguish +# a failure to support a valid configuration from a meaningless +# configuration. + +# The goal of this file is to map all the various variations of a given +# machine specification into a single specification in the form: +# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM +# or in some cases, the newer four-part form: +# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM +# It is wrong to echo any other type of specification. + +me=`echo "$0" | sed -e 's,.*/,,'` + +usage="\ +Usage: $0 [OPTION] CPU-MFR-OPSYS + $0 [OPTION] ALIAS + +Canonicalize a configuration name. + +Operation modes: + -h, --help print this help, then exit + -t, --time-stamp print date of last modification, then exit + -v, --version print version number, then exit + +Report bugs and patches to <config-patches@gnu.org>." + +version="\ +GNU config.sub ($timestamp) + +Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 +Free Software Foundation, Inc. + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." + +help=" +Try \`$me --help' for more information." + +# Parse command line +while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) + echo "$timestamp" ; exit ;; + --version | -v ) + echo "$version" ; exit ;; + --help | --h* | -h ) + echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. + break ;; + -* ) + echo "$me: invalid option $1$help" + exit 1 ;; + + *local*) + # First pass through any local machine types. + echo $1 + exit ;; + + * ) + break ;; + esac +done + +case $# in + 0) echo "$me: missing argument$help" >&2 + exit 1;; + 1) ;; + *) echo "$me: too many arguments$help" >&2 + exit 1;; +esac + +# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). +# Here we must recognize all the valid KERNEL-OS combinations. +maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` +case $maybe_os in + nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ + uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ + storm-chaos* | os2-emx* | rtmk-nova*) + os=-$maybe_os + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` + ;; + *) + basic_machine=`echo $1 | sed 's/-[^-]*$//'` + if [ $basic_machine != $1 ] + then os=`echo $1 | sed 's/.*-/-/'` + else os=; fi + ;; +esac + +### Let's recognize common machines as not being operating systems so +### that things like config.sub decstation-3100 work. We also +### recognize some manufacturers as not being operating systems, so we +### can provide default operating systems below. +case $os in + -sun*os*) + # Prevent following clause from handling this invalid input. + ;; + -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \ + -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \ + -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \ + -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ + -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ + -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ + -apple | -axis | -knuth | -cray) + os= + basic_machine=$1 + ;; + -sim | -cisco | -oki | -wec | -winbond) + os= + basic_machine=$1 + ;; + -scout) + ;; + -wrs) + os=-vxworks + basic_machine=$1 + ;; + -chorusos*) + os=-chorusos + basic_machine=$1 + ;; + -chorusrdb) + os=-chorusrdb + basic_machine=$1 + ;; + -hiux*) + os=-hiuxwe2 + ;; + -sco6) + os=-sco5v6 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco5) + os=-sco3.2v5 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco4) + os=-sco3.2v4 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco3.2.[4-9]*) + os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco3.2v[4-9]*) + # Don't forget version if it is 3.2v4 or newer. + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco5v6*) + # Don't forget version if it is 3.2v4 or newer. + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco*) + os=-sco3.2v2 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -udk*) + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -isc) + os=-isc2.2 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -clix*) + basic_machine=clipper-intergraph + ;; + -isc*) + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -lynx*) + os=-lynxos + ;; + -ptx*) + basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` + ;; + -windowsnt*) + os=`echo $os | sed -e 's/windowsnt/winnt/'` + ;; + -psos*) + os=-psos + ;; + -mint | -mint[0-9]*) + basic_machine=m68k-atari + os=-mint + ;; +esac + +# Decode aliases for certain CPU-COMPANY combinations. +case $basic_machine in + # Recognize the basic CPU types without company name. + # Some are omitted here because they have special meanings below. + 1750a | 580 \ + | a29k \ + | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ + | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ + | am33_2.0 \ + | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ + | bfin \ + | c4x | clipper \ + | d10v | d30v | dlx | dsp16xx \ + | fido | fr30 | frv \ + | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | i370 | i860 | i960 | ia64 \ + | ip2k | iq2000 \ + | m32c | m32r | m32rle | m68000 | m68k | m88k \ + | maxq | mb | microblaze | mcore | mep \ + | mips | mipsbe | mipseb | mipsel | mipsle \ + | mips16 \ + | mips64 | mips64el \ + | mips64vr | mips64vrel \ + | mips64orion | mips64orionel \ + | mips64vr4100 | mips64vr4100el \ + | mips64vr4300 | mips64vr4300el \ + | mips64vr5000 | mips64vr5000el \ + | mips64vr5900 | mips64vr5900el \ + | mipsisa32 | mipsisa32el \ + | mipsisa32r2 | mipsisa32r2el \ + | mipsisa64 | mipsisa64el \ + | mipsisa64r2 | mipsisa64r2el \ + | mipsisa64sb1 | mipsisa64sb1el \ + | mipsisa64sr71k | mipsisa64sr71kel \ + | mipstx39 | mipstx39el \ + | mn10200 | mn10300 \ + | mt \ + | msp430 \ + | nios | nios2 \ + | ns16k | ns32k \ + | or32 \ + | pdp10 | pdp11 | pj | pjl \ + | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ + | pyramid \ + | score \ + | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ + | sh64 | sh64le \ + | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ + | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ + | spu | strongarm \ + | tahoe | thumb | tic4x | tic80 | tron \ + | v850 | v850e \ + | we32k \ + | x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \ + | z8k) + basic_machine=$basic_machine-unknown + ;; + m6811 | m68hc11 | m6812 | m68hc12) + # Motorola 68HC11/12. + basic_machine=$basic_machine-unknown + os=-none + ;; + m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) + ;; + ms1) + basic_machine=mt-unknown + ;; + + # We use `pc' rather than `unknown' + # because (1) that's what they normally are, and + # (2) the word "unknown" tends to confuse beginning users. + i*86 | x86_64) + basic_machine=$basic_machine-pc + ;; + # Object if more than one company name word. + *-*-*) + echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 + exit 1 + ;; + # Recognize the basic CPU types with company name. + 580-* \ + | a29k-* \ + | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ + | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ + | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ + | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ + | avr-* | avr32-* \ + | bfin-* | bs2000-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ + | clipper-* | craynv-* | cydra-* \ + | d10v-* | d30v-* | dlx-* \ + | elxsi-* \ + | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ + | h8300-* | h8500-* \ + | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | i*86-* | i860-* | i960-* | ia64-* \ + | ip2k-* | iq2000-* \ + | m32c-* | m32r-* | m32rle-* \ + | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ + | m88110-* | m88k-* | maxq-* | mcore-* \ + | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ + | mips16-* \ + | mips64-* | mips64el-* \ + | mips64vr-* | mips64vrel-* \ + | mips64orion-* | mips64orionel-* \ + | mips64vr4100-* | mips64vr4100el-* \ + | mips64vr4300-* | mips64vr4300el-* \ + | mips64vr5000-* | mips64vr5000el-* \ + | mips64vr5900-* | mips64vr5900el-* \ + | mipsisa32-* | mipsisa32el-* \ + | mipsisa32r2-* | mipsisa32r2el-* \ + | mipsisa64-* | mipsisa64el-* \ + | mipsisa64r2-* | mipsisa64r2el-* \ + | mipsisa64sb1-* | mipsisa64sb1el-* \ + | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipstx39-* | mipstx39el-* \ + | mmix-* \ + | mt-* \ + | msp430-* \ + | nios-* | nios2-* \ + | none-* | np1-* | ns16k-* | ns32k-* \ + | orion-* \ + | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ + | pyramid-* \ + | romp-* | rs6000-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ + | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ + | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ + | sparclite-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \ + | tahoe-* | thumb-* \ + | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tron-* \ + | v850-* | v850e-* | vax-* \ + | we32k-* \ + | x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \ + | xstormy16-* | xtensa*-* \ + | ymp-* \ + | z8k-*) + ;; + # Recognize the basic CPU types without company name, with glob match. + xtensa*) + basic_machine=$basic_machine-unknown + ;; + # Recognize the various machine names and aliases which stand + # for a CPU type and a company and sometimes even an OS. + 386bsd) + basic_machine=i386-unknown + os=-bsd + ;; + 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) + basic_machine=m68000-att + ;; + 3b*) + basic_machine=we32k-att + ;; + a29khif) + basic_machine=a29k-amd + os=-udi + ;; + abacus) + basic_machine=abacus-unknown + ;; + adobe68k) + basic_machine=m68010-adobe + os=-scout + ;; + alliant | fx80) + basic_machine=fx80-alliant + ;; + altos | altos3068) + basic_machine=m68k-altos + ;; + am29k) + basic_machine=a29k-none + os=-bsd + ;; + amd64) + basic_machine=x86_64-pc + ;; + amd64-*) + basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + amdahl) + basic_machine=580-amdahl + os=-sysv + ;; + amiga | amiga-*) + basic_machine=m68k-unknown + ;; + amigaos | amigados) + basic_machine=m68k-unknown + os=-amigaos + ;; + amigaunix | amix) + basic_machine=m68k-unknown + os=-sysv4 + ;; + apollo68) + basic_machine=m68k-apollo + os=-sysv + ;; + apollo68bsd) + basic_machine=m68k-apollo + os=-bsd + ;; + aux) + basic_machine=m68k-apple + os=-aux + ;; + balance) + basic_machine=ns32k-sequent + os=-dynix + ;; + blackfin) + basic_machine=bfin-unknown + os=-linux + ;; + blackfin-*) + basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + c90) + basic_machine=c90-cray + os=-unicos + ;; + convex-c1) + basic_machine=c1-convex + os=-bsd + ;; + convex-c2) + basic_machine=c2-convex + os=-bsd + ;; + convex-c32) + basic_machine=c32-convex + os=-bsd + ;; + convex-c34) + basic_machine=c34-convex + os=-bsd + ;; + convex-c38) + basic_machine=c38-convex + os=-bsd + ;; + cray | j90) + basic_machine=j90-cray + os=-unicos + ;; + craynv) + basic_machine=craynv-cray + os=-unicosmp + ;; + cr16) + basic_machine=cr16-unknown + os=-elf + ;; + crds | unos) + basic_machine=m68k-crds + ;; + crisv32 | crisv32-* | etraxfs*) + basic_machine=crisv32-axis + ;; + cris | cris-* | etrax*) + basic_machine=cris-axis + ;; + crx) + basic_machine=crx-unknown + os=-elf + ;; + da30 | da30-*) + basic_machine=m68k-da30 + ;; + decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) + basic_machine=mips-dec + ;; + decsystem10* | dec10*) + basic_machine=pdp10-dec + os=-tops10 + ;; + decsystem20* | dec20*) + basic_machine=pdp10-dec + os=-tops20 + ;; + delta | 3300 | motorola-3300 | motorola-delta \ + | 3300-motorola | delta-motorola) + basic_machine=m68k-motorola + ;; + delta88) + basic_machine=m88k-motorola + os=-sysv3 + ;; + djgpp) + basic_machine=i586-pc + os=-msdosdjgpp + ;; + dpx20 | dpx20-*) + basic_machine=rs6000-bull + os=-bosx + ;; + dpx2* | dpx2*-bull) + basic_machine=m68k-bull + os=-sysv3 + ;; + ebmon29k) + basic_machine=a29k-amd + os=-ebmon + ;; + elxsi) + basic_machine=elxsi-elxsi + os=-bsd + ;; + encore | umax | mmax) + basic_machine=ns32k-encore + ;; + es1800 | OSE68k | ose68k | ose | OSE) + basic_machine=m68k-ericsson + os=-ose + ;; + fx2800) + basic_machine=i860-alliant + ;; + genix) + basic_machine=ns32k-ns + ;; + gmicro) + basic_machine=tron-gmicro + os=-sysv + ;; + go32) + basic_machine=i386-pc + os=-go32 + ;; + h3050r* | hiux*) + basic_machine=hppa1.1-hitachi + os=-hiuxwe2 + ;; + h8300hms) + basic_machine=h8300-hitachi + os=-hms + ;; + h8300xray) + basic_machine=h8300-hitachi + os=-xray + ;; + h8500hms) + basic_machine=h8500-hitachi + os=-hms + ;; + harris) + basic_machine=m88k-harris + os=-sysv3 + ;; + hp300-*) + basic_machine=m68k-hp + ;; + hp300bsd) + basic_machine=m68k-hp + os=-bsd + ;; + hp300hpux) + basic_machine=m68k-hp + os=-hpux + ;; + hp3k9[0-9][0-9] | hp9[0-9][0-9]) + basic_machine=hppa1.0-hp + ;; + hp9k2[0-9][0-9] | hp9k31[0-9]) + basic_machine=m68000-hp + ;; + hp9k3[2-9][0-9]) + basic_machine=m68k-hp + ;; + hp9k6[0-9][0-9] | hp6[0-9][0-9]) + basic_machine=hppa1.0-hp + ;; + hp9k7[0-79][0-9] | hp7[0-79][0-9]) + basic_machine=hppa1.1-hp + ;; + hp9k78[0-9] | hp78[0-9]) + # FIXME: really hppa2.0-hp + basic_machine=hppa1.1-hp + ;; + hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) + # FIXME: really hppa2.0-hp + basic_machine=hppa1.1-hp + ;; + hp9k8[0-9][13679] | hp8[0-9][13679]) + basic_machine=hppa1.1-hp + ;; + hp9k8[0-9][0-9] | hp8[0-9][0-9]) + basic_machine=hppa1.0-hp + ;; + hppa-next) + os=-nextstep3 + ;; + hppaosf) + basic_machine=hppa1.1-hp + os=-osf + ;; + hppro) + basic_machine=hppa1.1-hp + os=-proelf + ;; + i370-ibm* | ibm*) + basic_machine=i370-ibm + ;; +# I'm not sure what "Sysv32" means. Should this be sysv3.2? + i*86v32) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-sysv32 + ;; + i*86v4*) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-sysv4 + ;; + i*86v) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-sysv + ;; + i*86sol2) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-solaris2 + ;; + i386mach) + basic_machine=i386-mach + os=-mach + ;; + i386-vsta | vsta) + basic_machine=i386-unknown + os=-vsta + ;; + iris | iris4d) + basic_machine=mips-sgi + case $os in + -irix*) + ;; + *) + os=-irix4 + ;; + esac + ;; + isi68 | isi) + basic_machine=m68k-isi + os=-sysv + ;; + m68knommu) + basic_machine=m68k-unknown + os=-linux + ;; + m68knommu-*) + basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + m88k-omron*) + basic_machine=m88k-omron + ;; + magnum | m3230) + basic_machine=mips-mips + os=-sysv + ;; + merlin) + basic_machine=ns32k-utek + os=-sysv + ;; + mingw32) + basic_machine=i386-pc + os=-mingw32 + ;; + mingw32ce) + basic_machine=arm-unknown + os=-mingw32ce + ;; + miniframe) + basic_machine=m68000-convergent + ;; + *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*) + basic_machine=m68k-atari + os=-mint + ;; + mips3*-*) + basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` + ;; + mips3*) + basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown + ;; + monitor) + basic_machine=m68k-rom68k + os=-coff + ;; + morphos) + basic_machine=powerpc-unknown + os=-morphos + ;; + msdos) + basic_machine=i386-pc + os=-msdos + ;; + ms1-*) + basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` + ;; + mvs) + basic_machine=i370-ibm + os=-mvs + ;; + ncr3000) + basic_machine=i486-ncr + os=-sysv4 + ;; + netbsd386) + basic_machine=i386-unknown + os=-netbsd + ;; + netwinder) + basic_machine=armv4l-rebel + os=-linux + ;; + news | news700 | news800 | news900) + basic_machine=m68k-sony + os=-newsos + ;; + news1000) + basic_machine=m68030-sony + os=-newsos + ;; + news-3600 | risc-news) + basic_machine=mips-sony + os=-newsos + ;; + necv70) + basic_machine=v70-nec + os=-sysv + ;; + next | m*-next ) + basic_machine=m68k-next + case $os in + -nextstep* ) + ;; + -ns2*) + os=-nextstep2 + ;; + *) + os=-nextstep3 + ;; + esac + ;; + nh3000) + basic_machine=m68k-harris + os=-cxux + ;; + nh[45]000) + basic_machine=m88k-harris + os=-cxux + ;; + nindy960) + basic_machine=i960-intel + os=-nindy + ;; + mon960) + basic_machine=i960-intel + os=-mon960 + ;; + nonstopux) + basic_machine=mips-compaq + os=-nonstopux + ;; + np1) + basic_machine=np1-gould + ;; + nsr-tandem) + basic_machine=nsr-tandem + ;; + op50n-* | op60c-*) + basic_machine=hppa1.1-oki + os=-proelf + ;; + openrisc | openrisc-*) + basic_machine=or32-unknown + ;; + os400) + basic_machine=powerpc-ibm + os=-os400 + ;; + OSE68000 | ose68000) + basic_machine=m68000-ericsson + os=-ose + ;; + os68k) + basic_machine=m68k-none + os=-os68k + ;; + pa-hitachi) + basic_machine=hppa1.1-hitachi + os=-hiuxwe2 + ;; + paragon) + basic_machine=i860-intel + os=-osf + ;; + parisc) + basic_machine=hppa-unknown + os=-linux + ;; + parisc-*) + basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + pbd) + basic_machine=sparc-tti + ;; + pbb) + basic_machine=m68k-tti + ;; + pc532 | pc532-*) + basic_machine=ns32k-pc532 + ;; + pc98) + basic_machine=i386-pc + ;; + pc98-*) + basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentium | p5 | k5 | k6 | nexgen | viac3) + basic_machine=i586-pc + ;; + pentiumpro | p6 | 6x86 | athlon | athlon_*) + basic_machine=i686-pc + ;; + pentiumii | pentium2 | pentiumiii | pentium3) + basic_machine=i686-pc + ;; + pentium4) + basic_machine=i786-pc + ;; + pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) + basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentiumpro-* | p6-* | 6x86-* | athlon-*) + basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) + basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentium4-*) + basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pn) + basic_machine=pn-gould + ;; + power) basic_machine=power-ibm + ;; + ppc) basic_machine=powerpc-unknown + ;; + ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ppcle | powerpclittle | ppc-le | powerpc-little) + basic_machine=powerpcle-unknown + ;; + ppcle-* | powerpclittle-*) + basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ppc64) basic_machine=powerpc64-unknown + ;; + ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ppc64le | powerpc64little | ppc64-le | powerpc64-little) + basic_machine=powerpc64le-unknown + ;; + ppc64le-* | powerpc64little-*) + basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ps2) + basic_machine=i386-ibm + ;; + pw32) + basic_machine=i586-unknown + os=-pw32 + ;; + rdos) + basic_machine=i386-pc + os=-rdos + ;; + rom68k) + basic_machine=m68k-rom68k + os=-coff + ;; + rm[46]00) + basic_machine=mips-siemens + ;; + rtpc | rtpc-*) + basic_machine=romp-ibm + ;; + s390 | s390-*) + basic_machine=s390-ibm + ;; + s390x | s390x-*) + basic_machine=s390x-ibm + ;; + sa29200) + basic_machine=a29k-amd + os=-udi + ;; + sb1) + basic_machine=mipsisa64sb1-unknown + ;; + sb1el) + basic_machine=mipsisa64sb1el-unknown + ;; + sde) + basic_machine=mipsisa32-sde + os=-elf + ;; + sei) + basic_machine=mips-sei + os=-seiux + ;; + sequent) + basic_machine=i386-sequent + ;; + sh) + basic_machine=sh-hitachi + os=-hms + ;; + sh5el) + basic_machine=sh5le-unknown + ;; + sh64) + basic_machine=sh64-unknown + ;; + sparclite-wrs | simso-wrs) + basic_machine=sparclite-wrs + os=-vxworks + ;; + sps7) + basic_machine=m68k-bull + os=-sysv2 + ;; + spur) + basic_machine=spur-unknown + ;; + st2000) + basic_machine=m68k-tandem + ;; + stratus) + basic_machine=i860-stratus + os=-sysv4 + ;; + sun2) + basic_machine=m68000-sun + ;; + sun2os3) + basic_machine=m68000-sun + os=-sunos3 + ;; + sun2os4) + basic_machine=m68000-sun + os=-sunos4 + ;; + sun3os3) + basic_machine=m68k-sun + os=-sunos3 + ;; + sun3os4) + basic_machine=m68k-sun + os=-sunos4 + ;; + sun4os3) + basic_machine=sparc-sun + os=-sunos3 + ;; + sun4os4) + basic_machine=sparc-sun + os=-sunos4 + ;; + sun4sol2) + basic_machine=sparc-sun + os=-solaris2 + ;; + sun3 | sun3-*) + basic_machine=m68k-sun + ;; + sun4) + basic_machine=sparc-sun + ;; + sun386 | sun386i | roadrunner) + basic_machine=i386-sun + ;; + sv1) + basic_machine=sv1-cray + os=-unicos + ;; + symmetry) + basic_machine=i386-sequent + os=-dynix + ;; + t3e) + basic_machine=alphaev5-cray + os=-unicos + ;; + t90) + basic_machine=t90-cray + os=-unicos + ;; + tic54x | c54x*) + basic_machine=tic54x-unknown + os=-coff + ;; + tic55x | c55x*) + basic_machine=tic55x-unknown + os=-coff + ;; + tic6x | c6x*) + basic_machine=tic6x-unknown + os=-coff + ;; + tx39) + basic_machine=mipstx39-unknown + ;; + tx39el) + basic_machine=mipstx39el-unknown + ;; + toad1) + basic_machine=pdp10-xkl + os=-tops20 + ;; + tower | tower-32) + basic_machine=m68k-ncr + ;; + tpf) + basic_machine=s390x-ibm + os=-tpf + ;; + udi29k) + basic_machine=a29k-amd + os=-udi + ;; + ultra3) + basic_machine=a29k-nyu + os=-sym1 + ;; + v810 | necv810) + basic_machine=v810-nec + os=-none + ;; + vaxv) + basic_machine=vax-dec + os=-sysv + ;; + vms) + basic_machine=vax-dec + os=-vms + ;; + vpp*|vx|vx-*) + basic_machine=f301-fujitsu + ;; + vxworks960) + basic_machine=i960-wrs + os=-vxworks + ;; + vxworks68) + basic_machine=m68k-wrs + os=-vxworks + ;; + vxworks29k) + basic_machine=a29k-wrs + os=-vxworks + ;; + w65*) + basic_machine=w65-wdc + os=-none + ;; + w89k-*) + basic_machine=hppa1.1-winbond + os=-proelf + ;; + xbox) + basic_machine=i686-pc + os=-mingw32 + ;; + xps | xps100) + basic_machine=xps100-honeywell + ;; + ymp) + basic_machine=ymp-cray + os=-unicos + ;; + z8k-*-coff) + basic_machine=z8k-unknown + os=-sim + ;; + none) + basic_machine=none-none + os=-none + ;; + +# Here we handle the default manufacturer of certain CPU types. It is in +# some cases the only manufacturer, in others, it is the most popular. + w89k) + basic_machine=hppa1.1-winbond + ;; + op50n) + basic_machine=hppa1.1-oki + ;; + op60c) + basic_machine=hppa1.1-oki + ;; + romp) + basic_machine=romp-ibm + ;; + mmix) + basic_machine=mmix-knuth + ;; + rs6000) + basic_machine=rs6000-ibm + ;; + vax) + basic_machine=vax-dec + ;; + pdp10) + # there are many clones, so DEC is not a safe bet + basic_machine=pdp10-unknown + ;; + pdp11) + basic_machine=pdp11-dec + ;; + we32k) + basic_machine=we32k-att + ;; + sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele) + basic_machine=sh-unknown + ;; + sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) + basic_machine=sparc-sun + ;; + cydra) + basic_machine=cydra-cydrome + ;; + orion) + basic_machine=orion-highlevel + ;; + orion105) + basic_machine=clipper-highlevel + ;; + mac | mpw | mac-mpw) + basic_machine=m68k-apple + ;; + pmac | pmac-mpw) + basic_machine=powerpc-apple + ;; + *-unknown) + # Make sure to match an already-canonicalized machine name. + ;; + *) + echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 + exit 1 + ;; +esac + +# Here we canonicalize certain aliases for manufacturers. +case $basic_machine in + *-digital*) + basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'` + ;; + *-commodore*) + basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'` + ;; + *) + ;; +esac + +# Decode manufacturer-specific aliases for certain operating systems. + +if [ x"$os" != x"" ] +then +case $os in + # First match some system type aliases + # that might get confused with valid system types. + # -solaris* is a basic system type, with this one exception. + -solaris1 | -solaris1.*) + os=`echo $os | sed -e 's|solaris1|sunos4|'` + ;; + -solaris) + os=-solaris2 + ;; + -svr4*) + os=-sysv4 + ;; + -unixware*) + os=-sysv4.2uw + ;; + -gnu/linux*) + os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` + ;; + # First accept the basic system types. + # The portable systems comes first. + # Each alternative MUST END IN A *, to match a version number. + # -sysv* is not here because it comes later, after sysvr4. + -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ + | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ + | -aos* \ + | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ + | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ + | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ + | -openbsd* | -solidbsd* \ + | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ + | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ + | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ + | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ + | -chorusos* | -chorusrdb* \ + | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ + | -uxpv* | -beos* | -mpeix* | -udk* \ + | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ + | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ + | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ + | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ + | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ + | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ + | -skyos* | -haiku* | -rdos* | -toppers* | -drops*) + # Remember, each alternative MUST END IN *, to match a version number. + ;; + -qnx*) + case $basic_machine in + x86-* | i*86-*) + ;; + *) + os=-nto$os + ;; + esac + ;; + -nto-qnx*) + ;; + -nto*) + os=`echo $os | sed -e 's|nto|nto-qnx|'` + ;; + -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ + | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ + | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) + ;; + -mac*) + os=`echo $os | sed -e 's|mac|macos|'` + ;; + -linux-dietlibc) + os=-linux-dietlibc + ;; + -linux*) + os=`echo $os | sed -e 's|linux|linux-gnu|'` + ;; + -sunos5*) + os=`echo $os | sed -e 's|sunos5|solaris2|'` + ;; + -sunos6*) + os=`echo $os | sed -e 's|sunos6|solaris3|'` + ;; + -opened*) + os=-openedition + ;; + -os400*) + os=-os400 + ;; + -wince*) + os=-wince + ;; + -osfrose*) + os=-osfrose + ;; + -osf*) + os=-osf + ;; + -utek*) + os=-bsd + ;; + -dynix*) + os=-bsd + ;; + -acis*) + os=-aos + ;; + -atheos*) + os=-atheos + ;; + -syllable*) + os=-syllable + ;; + -386bsd) + os=-bsd + ;; + -ctix* | -uts*) + os=-sysv + ;; + -nova*) + os=-rtmk-nova + ;; + -ns2 ) + os=-nextstep2 + ;; + -nsk*) + os=-nsk + ;; + # Preserve the version number of sinix5. + -sinix5.*) + os=`echo $os | sed -e 's|sinix|sysv|'` + ;; + -sinix*) + os=-sysv4 + ;; + -tpf*) + os=-tpf + ;; + -triton*) + os=-sysv3 + ;; + -oss*) + os=-sysv3 + ;; + -svr4) + os=-sysv4 + ;; + -svr3) + os=-sysv3 + ;; + -sysvr4) + os=-sysv4 + ;; + # This must come after -sysvr4. + -sysv*) + ;; + -ose*) + os=-ose + ;; + -es1800*) + os=-ose + ;; + -xenix) + os=-xenix + ;; + -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) + os=-mint + ;; + -aros*) + os=-aros + ;; + -kaos*) + os=-kaos + ;; + -zvmoe) + os=-zvmoe + ;; + -none) + ;; + *) + # Get rid of the `-' at the beginning of $os. + os=`echo $os | sed 's/[^-]*-//'` + echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2 + exit 1 + ;; +esac +else + +# Here we handle the default operating systems that come with various machines. +# The value should be what the vendor currently ships out the door with their +# machine or put another way, the most popular os provided with the machine. + +# Note that if you're going to try to match "-MANUFACTURER" here (say, +# "-sun"), then you have to tell the case statement up towards the top +# that MANUFACTURER isn't an operating system. Otherwise, code above +# will signal an error saying that MANUFACTURER isn't an operating +# system, and we'll never get to this point. + +case $basic_machine in + score-*) + os=-elf + ;; + spu-*) + os=-elf + ;; + *-acorn) + os=-riscix1.2 + ;; + arm*-rebel) + os=-linux + ;; + arm*-semi) + os=-aout + ;; + c4x-* | tic4x-*) + os=-coff + ;; + # This must come before the *-dec entry. + pdp10-*) + os=-tops20 + ;; + pdp11-*) + os=-none + ;; + *-dec | vax-*) + os=-ultrix4.2 + ;; + m68*-apollo) + os=-domain + ;; + i386-sun) + os=-sunos4.0.2 + ;; + m68000-sun) + os=-sunos3 + # This also exists in the configure program, but was not the + # default. + # os=-sunos4 + ;; + m68*-cisco) + os=-aout + ;; + mep-*) + os=-elf + ;; + mips*-cisco) + os=-elf + ;; + mips*-*) + os=-elf + ;; + or32-*) + os=-coff + ;; + *-tti) # must be before sparc entry or we get the wrong os. + os=-sysv3 + ;; + sparc-* | *-sun) + os=-sunos4.1.1 + ;; + *-be) + os=-beos + ;; + *-haiku) + os=-haiku + ;; + *-ibm) + os=-aix + ;; + *-knuth) + os=-mmixware + ;; + *-wec) + os=-proelf + ;; + *-winbond) + os=-proelf + ;; + *-oki) + os=-proelf + ;; + *-hp) + os=-hpux + ;; + *-hitachi) + os=-hiux + ;; + i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) + os=-sysv + ;; + *-cbm) + os=-amigaos + ;; + *-dg) + os=-dgux + ;; + *-dolphin) + os=-sysv3 + ;; + m68k-ccur) + os=-rtu + ;; + m88k-omron*) + os=-luna + ;; + *-next ) + os=-nextstep + ;; + *-sequent) + os=-ptx + ;; + *-crds) + os=-unos + ;; + *-ns) + os=-genix + ;; + i370-*) + os=-mvs + ;; + *-next) + os=-nextstep3 + ;; + *-gould) + os=-sysv + ;; + *-highlevel) + os=-bsd + ;; + *-encore) + os=-bsd + ;; + *-sgi) + os=-irix + ;; + *-siemens) + os=-sysv4 + ;; + *-masscomp) + os=-rtu + ;; + f30[01]-fujitsu | f700-fujitsu) + os=-uxpv + ;; + *-rom68k) + os=-coff + ;; + *-*bug) + os=-coff + ;; + *-apple) + os=-macos + ;; + *-atari*) + os=-mint + ;; + *) + os=-none + ;; +esac +fi + +# Here we handle the case where we know the os, and the CPU type, but not the +# manufacturer. We pick the logical manufacturer. +vendor=unknown +case $basic_machine in + *-unknown) + case $os in + -riscix*) + vendor=acorn + ;; + -sunos*) + vendor=sun + ;; + -aix*) + vendor=ibm + ;; + -beos*) + vendor=be + ;; + -hpux*) + vendor=hp + ;; + -mpeix*) + vendor=hp + ;; + -hiux*) + vendor=hitachi + ;; + -unos*) + vendor=crds + ;; + -dgux*) + vendor=dg + ;; + -luna*) + vendor=omron + ;; + -genix*) + vendor=ns + ;; + -mvs* | -opened*) + vendor=ibm + ;; + -os400*) + vendor=ibm + ;; + -ptx*) + vendor=sequent + ;; + -tpf*) + vendor=ibm + ;; + -vxsim* | -vxworks* | -windiss*) + vendor=wrs + ;; + -aux*) + vendor=apple + ;; + -hms*) + vendor=hitachi + ;; + -mpw* | -macos*) + vendor=apple + ;; + -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) + vendor=atari + ;; + -vos*) + vendor=stratus + ;; + esac + basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` + ;; +esac + +echo $basic_machine$os +exit + +# Local variables: +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "timestamp='" +# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-end: "'" +# End: diff --git a/configure.in b/configure.in index 788130733..817a1e5b5 100644 --- a/configure.in +++ b/configure.in @@ -4,7 +4,7 @@ dnl define(GUILE_CONFIGURE_COPYRIGHT,[[ -Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. This file is part of GUILE @@ -25,7 +25,7 @@ Boston, MA 02110-1301, USA. ]]) -AC_PREREQ(2.59) +AC_PREREQ(2.61) dnl `patsubst' here deletes the newline which "echo" prints. We can't use dnl "echo -n" since -n is not portable (see autoconf manual "Limitations of @@ -41,15 +41,14 @@ AC_CONFIG_AUX_DIR([build-aux]) AC_CONFIG_MACRO_DIR([m4]) AC_CONFIG_SRCDIR(GUILE-VERSION) -AM_INIT_AUTOMAKE([gnu no-define check-news]) +AM_INIT_AUTOMAKE([gnu no-define check-news -Wall -Wno-override]) AC_COPYRIGHT(GUILE_CONFIGURE_COPYRIGHT) AC_CONFIG_SRCDIR([GUILE-VERSION]) . $srcdir/GUILE-VERSION -AM_MAINTAINER_MODE -AM_CONFIG_HEADER([config.h]) +AC_CONFIG_HEADERS([config.h]) AH_TOP(/*GUILE_CONFIGURE_COPYRIGHT*/) #-------------------------------------------------------------------- @@ -62,8 +61,11 @@ AC_CONFIG_SUBDIRS(guile-readline) #-------------------------------------------------------------------- +AC_LANG([C]) + dnl Some more checks for Win32 -AC_CYGWIN +AC_CANONICAL_HOST + AC_LIBTOOL_WIN32_DLL AC_PROG_INSTALL @@ -75,7 +77,8 @@ AC_PROG_AWK dnl Gnulib. gl_INIT -AM_PROG_CC_STDC +AC_PROG_CC_C89 + # for per-target cflags in the libguile subdir AM_PROG_CC_C_O @@ -124,7 +127,7 @@ AC_ARG_ENABLE(debug-malloc, SCM_I_GSC_GUILE_DEBUG=0 AC_ARG_ENABLE(guile-debug, - [AC_HELP_STRING([--enable-guile-debug], + [AS_HELP_STRING([--enable-guile-debug], [include internal debugging functions])], if test "$enable_guile_debug" = y || test "$enable_guile_debug" = yes; then SCM_I_GSC_GUILE_DEBUG=1 @@ -143,7 +146,7 @@ AC_ARG_ENABLE(regex, enable_regex=yes) AC_ARG_ENABLE([discouraged], - AC_HELP_STRING([--disable-discouraged],[omit discouraged features])) + AS_HELP_STRING([--disable-discouraged],[omit discouraged features])) if test "$enable_discouraged" = no; then SCM_I_GSC_ENABLE_DISCOURAGED=0 @@ -152,7 +155,7 @@ else fi AC_ARG_ENABLE([deprecated], - AC_HELP_STRING([--disable-deprecated],[omit deprecated features])) + AS_HELP_STRING([--disable-deprecated],[omit deprecated features])) if test "$enable_deprecated" = no; then SCM_I_GSC_ENABLE_DEPRECATED=0 @@ -173,6 +176,51 @@ AC_ARG_ENABLE(elisp, [ --disable-elisp omit Emacs Lisp support],, enable_elisp=yes) +dnl Added the following configure option in January 2008 following +dnl investigation of problems with "64" system and library calls on +dnl Darwin (MacOS X). The libguile code (_scm.h) assumes that if a +dnl system has stat64, it will have all the other 64 APIs too; but on +dnl Darwin, stat64 is there but other APIs are missing. +dnl +dnl It also appears, from the Darwin docs, that most system call APIs +dnl there (i.e. the traditional ones _without_ "64" in their names) have +dnl been 64-bit-capable for a long time now, so it isn't necessary to +dnl use "64" versions anyway. For example, Darwin's off_t is 64-bit. +dnl +dnl A similar problem has been reported for HP-UX: +dnl http://www.nabble.com/Building-guile-1.8.2-on-hpux-td13106681.html +dnl +dnl Therefore, and also because a Guile without LARGEFILE64 support is +dnl better than no Guile at all, we provide this option to suppress +dnl trying to use "64" calls. +dnl +dnl It may be that for some 64-bit function on Darwin/HP-UX we do need +dnl to use a "64" call, and hence that by using --without-64-calls we're +dnl missing out on that. If so, someone can work on that in the future. +dnl For now, --without-64-calls allows Guile to build on OSs where it +dnl wasn't building before. +AC_MSG_CHECKING([whether to use system and library "64" calls]) +AC_ARG_WITH([64-calls], + AS_HELP_STRING([--without-64-calls], + [don't attempt to use system and library calls with "64" in their names]), + [use_64_calls=$withval], + [use_64_calls=yes + case $host in + *-apple-darwin* ) + use_64_calls=no + ;; + powerpc-ibm-aix* ) + use_64_calls=no + ;; + esac]) +AC_MSG_RESULT($use_64_calls) +case "$use_64_calls" in + y* ) + AC_DEFINE(GUILE_USE_64_CALLS, 1, + [Define to 1 in order to try to use "64" versions of system and library calls.]) + ;; +esac + #-------------------------------------------------------------------- dnl Check for dynamic linking @@ -534,9 +582,38 @@ AC_SUBST([SCM_I_GSC_NEEDS_STDINT_H]) AC_SUBST([SCM_I_GSC_NEEDS_INTTYPES_H]) AC_HEADER_STDC -AC_HEADER_DIRENT AC_HEADER_TIME AC_HEADER_SYS_WAIT +AC_HEADER_DIRENT + +# Reason for checking: +# +# HP-UX 11.11 (at least) doesn't provide `struct dirent64', even +# with `_LARGEFILE64_SOURCE', so check whether it's available. +# +AC_CHECK_MEMBER([struct dirent64.d_name], + [SCM_I_GSC_HAVE_STRUCT_DIRENT64=1], [SCM_I_GSC_HAVE_STRUCT_DIRENT64=0], + [ #ifndef _LARGEFILE64_SOURCE + # define _LARGEFILE64_SOURCE + #endif + + /* Per Autoconf manual. */ + #include <sys/types.h> + #ifdef HAVE_DIRENT_H + # include <dirent.h> + #else + # define dirent direct + # ifdef HAVE_SYS_NDIR_H + # include <sys/ndir.h> + # endif + # ifdef HAVE_SYS_DIR_H + # include <sys/dir.h> + # endif + # ifdef HAVE_NDIR_H + # include <ndir.h> + # endif + #endif ]) +AC_SUBST([SCM_I_GSC_HAVE_STRUCT_DIRENT64]) # Reasons for testing: # complex.h - new in C99 @@ -635,6 +712,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h]) # pipe - not in mingw # _pipe - specific to mingw, taking 3 args # readdir_r - recent posix, not on old systems +# readdir64_r - not available on HP-UX 11.11 # stat64 - SuS largefile stuff, not on old systems # sysconf - not on old systems # truncate - not in mingw @@ -643,7 +721,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h]) # strcoll_l, newlocale - GNU extensions (glibc), also available on Darwin # nl_langinfo - X/Open, not available on Windows. # -AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround ftime ftruncate fchown getcwd geteuid gettimeofday gmtime_r ioctl lstat mkdir mknod nice pipe _pipe readdir_r readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale nl_langinfo]) +AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround ftime ftruncate fchown getcwd geteuid gettimeofday gmtime_r ioctl lstat mkdir mknod nice pipe _pipe readdir_r readdir64_r readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale nl_langinfo]) # Reasons for testing: # netdb.h - not in mingw @@ -675,6 +753,37 @@ AC_SEARCH_LIBS(crypt, crypt, [AC_DEFINE(HAVE_CRYPT,1, [Define to 1 if you have the `crypt' function.])]) +# When compiling with GCC on some OSs (Solaris, AIX), _Complex_I doesn't +# work; in the reported cases so far, 1.0fi works well instead. According +# to the C99 spec, the complex.h header must provide a working definition +# of _Complex_I, so we always try _Complex_I first. The 1.0fi fallback +# is a workaround for the failure of some systems to conform to C99. +if test "$ac_cv_type_complex_double" = yes; then + AC_MSG_CHECKING([for i]) + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ +#if HAVE_COMPLEX_H +#include <complex.h> +#endif +complex double z; +]], [[ +z = _Complex_I; +]])], + [AC_DEFINE(GUILE_I,_Complex_I,[The imaginary unit (positive square root of -1).]) + AC_MSG_RESULT([_Complex_I])], + [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ +#if HAVE_COMPLEX_H +#include <complex.h> +#endif +complex double z; +]],[[ +z = 1.0fi; +]])], + [AC_DEFINE(GUILE_I,1.0fi) + AC_MSG_RESULT([1.0fi])], + [ac_cv_type_complex_double=no + AC_MSG_RESULT([not available])])]) +fi + # glibc 2.3.6 (circa 2006) and various prior versions had a bug where # csqrt(-i) returned a negative real part, when it should be positive # for the principal root. @@ -683,7 +792,7 @@ if test "$ac_cv_type_complex_double" = yes; then AC_CACHE_CHECK([whether csqrt is usable], guile_cv_use_csqrt, - [AC_TRY_RUN([ + [AC_RUN_IFELSE([AC_LANG_SOURCE([[ #include <complex.h> /* "volatile" is meant to prevent gcc from calculating the sqrt as a constant, we want to test libc. */ @@ -696,7 +805,7 @@ main (void) return 0; /* good */ else return 1; /* bad */ -}], +}]])], [guile_cv_use_csqrt=yes], [guile_cv_use_csqrt="no, glibc 2.3 bug"], [guile_cv_use_csqrt="yes, hopefully (cross-compiling)"])]) @@ -713,8 +822,9 @@ AC_CHECK_LIB([gmp], [__gmpz_init], , [AC_MSG_ERROR([GNU MP not found, see README])]) # mpz_import is a macro so we need to include <gmp.h> -AC_TRY_LINK([#include <gmp.h>], - [mpz_import (0, 0, 0, 0, 0, 0, 0);] , , +AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <gmp.h>]], + [[mpz_import (0, 0, 0, 0, 0, 0, 0); ]])], + [], [AC_MSG_ERROR([At least GNU MP 4.1 is required, see README])]) dnl i18n tests @@ -792,11 +902,11 @@ AC_CHECK_MEMBERS([struct sockaddr.sin_len],,, AC_MSG_CHECKING(for __libc_stack_end) AC_CACHE_VAL(guile_cv_have_libc_stack_end, -[AC_TRY_LINK([#include <stdio.h> -extern char *__libc_stack_end;], - [printf("%p", (char*) __libc_stack_end);], - guile_cv_have_libc_stack_end=yes, - guile_cv_have_libc_stack_end=no)]) +[AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <stdio.h> +extern char *__libc_stack_end;]], + [[printf("%p", (char*) __libc_stack_end);]])], + [guile_cv_have_libc_stack_end=yes], + [guile_cv_have_libc_stack_end=no])]) AC_MSG_RESULT($guile_cv_have_libc_stack_end) if test $guile_cv_have_libc_stack_end = yes; then @@ -809,9 +919,10 @@ dnl macro. With cygwin it may be in a DLL. AC_MSG_CHECKING(whether netdb.h declares h_errno) AC_CACHE_VAL(guile_cv_have_h_errno, -[AC_TRY_COMPILE([#include <netdb.h>], -[int a = h_errno;], -guile_cv_have_h_errno=yes, guile_cv_have_h_errno=no)]) + [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <netdb.h>]], + [[int a = h_errno;]])], + [guile_cv_have_h_errno=yes], + [guile_cv_have_h_errno=no])]) AC_MSG_RESULT($guile_cv_have_h_errno) if test $guile_cv_have_h_errno = yes; then AC_DEFINE(HAVE_H_ERRNO, 1, [Define if h_errno is declared in netdb.h.]) @@ -819,15 +930,16 @@ fi AC_MSG_CHECKING(whether uint32_t is defined) AC_CACHE_VAL(guile_cv_have_uint32_t, - [AC_TRY_COMPILE([#include <sys/types.h> + [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h> #if HAVE_STDINT_H #include <stdint.h> #endif #ifndef HAVE_NETDB_H #include <netdb.h> - #endif], - [uint32_t a;], - guile_cv_have_uint32_t=yes, guile_cv_have_uint32_t=no)]) + #endif]], + [[uint32_t a;]])], + [guile_cv_have_uint32_t=yes], + [guile_cv_have_uint32_t=no])]) AC_MSG_RESULT($guile_cv_have_uint32_t) if test $guile_cv_have_uint32_t = yes; then AC_DEFINE(HAVE_UINT32_T, 1, @@ -836,14 +948,15 @@ fi AC_MSG_CHECKING(for working IPv6 support) AC_CACHE_VAL(guile_cv_have_ipv6, -[AC_TRY_COMPILE([ +[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #ifdef HAVE_SYS_TYPES_H #include <sys/types.h> #endif #include <netinet/in.h> -#include <sys/socket.h>], -[struct sockaddr_in6 a; a.sin6_family = AF_INET6;], -guile_cv_have_ipv6=yes, guile_cv_have_ipv6=no)]) +#include <sys/socket.h>]], +[[struct sockaddr_in6 a; a.sin6_family = AF_INET6;]])], +[guile_cv_have_ipv6=yes], +[guile_cv_have_ipv6=no])]) AC_MSG_RESULT($guile_cv_have_ipv6) if test $guile_cv_have_ipv6 = yes; then AC_DEFINE(HAVE_IPV6, 1, [Define if you want support for IPv6.]) @@ -852,13 +965,14 @@ fi # included in rfc2553 but not in older implementations, e.g., glibc 2.1.3. AC_MSG_CHECKING(whether sockaddr_in6 has sin6_scope_id) AC_CACHE_VAL(guile_cv_have_sin6_scope_id, -[AC_TRY_COMPILE([ +[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #ifdef HAVE_SYS_TYPES_H #include <sys/types.h> #endif -#include <netinet/in.h>], -[struct sockaddr_in6 sok; sok.sin6_scope_id = 0;], -guile_cv_have_sin6_scope_id=yes, guile_cv_have_sin6_scope_id=no)]) +#include <netinet/in.h>]], +[[struct sockaddr_in6 sok; sok.sin6_scope_id = 0;]])], +[guile_cv_have_sin6_scope_id=yes], +[guile_cv_have_sin6_scope_id=no])]) AC_MSG_RESULT($guile_cv_have_sin6_scope_id) if test $guile_cv_have_sin6_scope_id = yes; then AC_DEFINE(HAVE_SIN6_SCOPE_ID, 1, @@ -875,7 +989,7 @@ AC_CHECK_MEMBERS([struct sockaddr_in6.sin6_len],,, AC_MSG_CHECKING(whether localtime caches TZ) AC_CACHE_VAL(guile_cv_localtime_cache, [if test x$ac_cv_func_tzset = xyes; then -AC_TRY_RUN([#include <time.h> +AC_RUN_IFELSE([AC_LANG_SOURCE([[#include <time.h> #if STDC_HEADERS # include <stdlib.h> #endif @@ -906,7 +1020,9 @@ main() if (localtime (&now)->tm_hour != hour_unset) exit (1); exit (0); -}], guile_cv_localtime_cache=no, guile_cv_localtime_cache=yes, +}]])], +[guile_cv_localtime_cache=no], +[guile_cv_localtime_cache=yes], [# If we have tzset, assume the worst when cross-compiling. guile_cv_localtime_cache=yes]) else @@ -1024,15 +1140,42 @@ GUILE_STRUCT_UTIMBUF # # Which way does the stack grow? # +# Following code comes from Autoconf 2.61's internal _AC_LIBOBJ_ALLOCA +# macro (/usr/share/autoconf/autoconf/functions.m4). Gnulib has +# very similar code, so in future we could look at using that. +# +# An important detail is that the code involves find_stack_direction +# calling _itself_ - which means that find_stack_direction (or at +# least the second find_stack_direction() call) cannot be inlined. +# If the code could be inlined, that might cause the test to give +# an incorrect answer. #-------------------------------------------------------------------- SCM_I_GSC_STACK_GROWS_UP=0 -AC_TRY_RUN(aux (l) unsigned long l; - { int x; exit (l >= ((unsigned long)&x)); } - main () { int q; aux((unsigned long)&q); }, - [SCM_I_GSC_STACK_GROWS_UP=1], - [], - [AC_MSG_WARN(Guessing that stack grows down -- see scmconfig.h)]) +AC_RUN_IFELSE([AC_LANG_SOURCE( +[AC_INCLUDES_DEFAULT +int +find_stack_direction () +{ + static char *addr = 0; + auto char dummy; + if (addr == 0) + { + addr = &dummy; + return find_stack_direction (); + } + else + return (&dummy > addr) ? 1 : -1; +} + +int +main () +{ + return find_stack_direction () < 0; +}])], + [SCM_I_GSC_STACK_GROWS_UP=1], + [], + [AC_MSG_WARN(Guessing that stack grows down -- see scmconfig.h)]) #-------------------------------------------------------------------- # @@ -1054,12 +1197,12 @@ fi AC_MSG_CHECKING(for struct linger) AC_CACHE_VAL(scm_cv_struct_linger, - AC_TRY_COMPILE([ + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <sys/types.h> -#include <sys/socket.h>], - [struct linger lgr; lgr.l_linger = 100], - scm_cv_struct_linger="yes", - scm_cv_struct_linger="no")) +#include <sys/socket.h>]], + [[struct linger lgr; lgr.l_linger = 100]])], + [scm_cv_struct_linger="yes"], + [scm_cv_struct_linger="no"])) AC_MSG_RESULT($scm_cv_struct_linger) if test $scm_cv_struct_linger = yes; then AC_DEFINE(HAVE_STRUCT_LINGER, 1, @@ -1072,14 +1215,13 @@ fi # AC_MSG_CHECKING(for struct timespec) AC_CACHE_VAL(scm_cv_struct_timespec, - AC_TRY_COMPILE([ + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include <time.h> #if HAVE_PTHREAD_H #include <pthread.h> -#endif], - [struct timespec t; t.tv_nsec = 100], - scm_cv_struct_timespec="yes", - scm_cv_struct_timespec="no")) +#endif]], [[struct timespec t; t.tv_nsec = 100]])], + [scm_cv_struct_timespec="yes"], + [scm_cv_struct_timespec="no"])) AC_MSG_RESULT($scm_cv_struct_timespec) if test $scm_cv_struct_timespec = yes; then AC_DEFINE(HAVE_STRUCT_TIMESPEC, 1, @@ -1106,6 +1248,9 @@ AC_SUBST(SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER, 0) case "$with_threads" in "yes" | "pthread" | "pthreads" | "pthread-threads" | "") + + build_pthread_support="yes" + ACX_PTHREAD(CC="$PTHREAD_CC" LIBS="$PTHREAD_LIBS $LIBS" SCM_I_GSC_USE_PTHREAD_THREADS=1 @@ -1185,6 +1330,10 @@ esac AC_MSG_CHECKING(what kind of threads to support) AC_MSG_RESULT($with_threads) +AM_CONDITIONAL([BUILD_PTHREAD_SUPPORT], + [test "x$build_pthread_support" = "xyes"]) + + ## Check whether pthread_attr_getstack works for the main thread if test "$with_threads" = pthreads; then @@ -1192,8 +1341,7 @@ if test "$with_threads" = pthreads; then AC_MSG_CHECKING(whether pthread_attr_getstack works for the main thread) old_CFLAGS="$CFLAGS" CFLAGS="$PTHREAD_CFLAGS $CFLAGS" -AC_TRY_RUN( -[ +AC_RUN_IFELSE([AC_LANG_SOURCE([[ #if HAVE_PTHREAD_ATTR_GETSTACK #include <pthread.h> @@ -1218,10 +1366,11 @@ int main () return 1; } #endif -], +]])], [works=yes AC_DEFINE(PTHREAD_ATTR_GETSTACK_WORKS, [1], [Define when pthread_att_get_stack works for the main thread])], -[works=no]) +[works=no], +[]) CFLAGS="$old_CFLAGS" AC_MSG_RESULT($works) @@ -1279,17 +1428,19 @@ case "$GCC" in ## less than exasperating. ## -Wpointer-arith was here too, but something changed in gcc/glibc ## and it became equally exasperating (gcc 2.95 and/or glibc 2.1.2). - CFLAGS="$CFLAGS -Wall -Wmissing-prototypes" + GCC_CFLAGS="-Wall -Wmissing-prototypes" # Do this here so we don't screw up any of the tests above that might # not be "warning free" if test "${GUILE_ERROR_ON_WARNING}" = yes then - CFLAGS="${CFLAGS} -Werror" + GCC_CFLAGS="${GCC_CFLAGS} -Werror" enable_compile_warnings=no fi ;; esac +AC_SUBST(GCC_CFLAGS) + ## If we're creating a shared library (using libtool!), then we'll ## need to generate a list of .lo files corresponding to the .o files ## given in LIBOBJS. We'll call it LIBLOBJS. @@ -1348,7 +1499,7 @@ AC_SUBST(LIBGUILE_I18N_INTERFACE) dnl Tell guile-config what flags guile users should compile and link with. GUILE_LIBS="$LDFLAGS $LIBS" -GUILE_CFLAGS="$PTHREAD_CFLAGS" +GUILE_CFLAGS="$CPPFLAGS $PTHREAD_CFLAGS" AC_SUBST(GUILE_LIBS) AC_SUBST(GUILE_CFLAGS) @@ -1363,6 +1514,12 @@ AC_SUBST(top_builddir_absolute) top_srcdir_absolute=`(cd $srcdir && pwd)` AC_SUBST(top_srcdir_absolute) +dnl We need `sitedir' in `guile-1.8.pc'. +dnl Note: `sitedir' must be kept in sync with `GUILE_SITE_DIR' in `guile.m4'. +pkgdatadir="$datadir/guile" +sitedir="$pkgdatadir/site" +AC_SUBST([sitedir]) + # Additional SCM_I_GSC definitions are above. AC_SUBST([SCM_I_GSC_GUILE_DEBUG]) AC_SUBST([SCM_I_GSC_GUILE_DEBUG_FREELIST]) @@ -1409,6 +1566,7 @@ AC_CONFIG_FILES([ test-suite/standalone/Makefile ]) +AC_CONFIG_FILES([guile-1.8.pc]) AC_CONFIG_FILES([check-guile], [chmod +x check-guile]) AC_CONFIG_FILES([benchmark-guile], [chmod +x benchmark-guile]) AC_CONFIG_FILES([guile-tools], [chmod +x guile-tools]) diff --git a/doc/.gitignore b/doc/.gitignore new file mode 100644 index 000000000..ecbb7fc6d --- /dev/null +++ b/doc/.gitignore @@ -0,0 +1 @@ +stamp-vti diff --git a/doc/COPYING b/doc/COPYING deleted file mode 100644 index e69de29bb..000000000 --- a/doc/COPYING +++ /dev/null diff --git a/doc/ChangeLog b/doc/ChangeLog index cab132e16..4153ad873 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,3 +1,13 @@ +2008-04-26 Ludovic Courtès <ludo@gnu.org> + + * Makefile.am (EXAMPLE_SMOB_FILES): Remove `COPYING'. + +2008-01-22 Neil Jerram <neil@ossau.uklinux.net> + + * COPYING: Removed. + + * oldfmt.c: Update copyright statement to LGPL. + 2002-09-14 Rob Browning <rlb@defaultvalue.org> * .cvsignore: add stamp-vti.1 diff --git a/doc/Makefile.am b/doc/Makefile.am index a9a072225..188fa8334 100644 --- a/doc/Makefile.am +++ b/doc/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 1998, 2002, 2006 Free Software Foundation, Inc. +## Copyright (C) 1998, 2002, 2006, 2008 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -27,7 +27,7 @@ SUBDIRS = ref tutorial goops r5rs # man_MANS = guile.1 EXAMPLE_SMOB_FILES = \ - ChangeLog Makefile README COPYING image-type.c image-type.h myguile.c + ChangeLog Makefile README image-type.c image-type.h myguile.c OLDFMT = oldfmt.c @@ -43,9 +43,8 @@ EXTRA_DIST = groupings.alist # guile-api.alist # pending the papers from Robert Merkel # EXTRA_DIST = guile.1 -if MAINTAINER_MODE include $(top_srcdir)/am/maintainer-dirs guile-api.alist: guile-api.alist-FORCE ( cd $(top_builddir) ; $(mscripts)/update-guile-api.alist ) guile-api.alist-FORCE: -endif + diff --git a/doc/example-smob/COPYING b/doc/example-smob/COPYING deleted file mode 100644 index e69de29bb..000000000 --- a/doc/example-smob/COPYING +++ /dev/null diff --git a/doc/example-smob/ChangeLog b/doc/example-smob/ChangeLog index 3984686fc..931860849 100644 --- a/doc/example-smob/ChangeLog +++ b/doc/example-smob/ChangeLog @@ -1,3 +1,7 @@ +2008-01-22 Neil Jerram <neil@ossau.uklinux.net> + + * COPYING: Removed. + 2004-09-24 Marius Vollmer <mvo@zagadka.de> * image-type.c: Updated from manual. diff --git a/doc/goops/ChangeLog b/doc/goops/ChangeLog index b0e742b71..a5a637d7b 100644 --- a/doc/goops/ChangeLog +++ b/doc/goops/ChangeLog @@ -1,3 +1,8 @@ +2008-02-06 Neil Jerram <neil@ossau.uklinux.net> + + * goops-tutorial.texi (Next-method): Minor improvements to the + text. + 2006-09-28 Neil Jerram <neil@ossau.uklinux.net> * goops.texi (Slot Options): Added example from Ludovic Courtès diff --git a/doc/goops/goops-tutorial.texi b/doc/goops/goops-tutorial.texi index 7ab6ebcf0..11155dfae 100644 --- a/doc/goops/goops-tutorial.texi +++ b/doc/goops/goops-tutorial.texi @@ -690,11 +690,12 @@ In this case, @node Next-method, Example, Generic functions and methods, Generic functions @subsection Next-method -When a generic function is called, the list of applicable methods is -built. As mentioned before, the most specific method of this list is -applied (see@ @ref{Generic functions and methods}). This method may call -the next method in the list of applicable methods. This is done by using -the special form @code{next-method}. Consider the following definitions +When you call a generic function, with a particular set of arguments, +GOOPS builds a list of all the methods that are applicable to those +arguments and orders them by how closely the method definitions match +the actual argument types. It then calls the method at the top of this +list. If the selected method's code wants to call on to the next method +in this list, it can do so by using @code{next-method}. @lisp (define-method (Test (a <integer>)) (cons 'integer (next-method))) @@ -702,7 +703,7 @@ the special form @code{next-method}. Consider the following definitions (define-method (Test a) (list 'top)) @end lisp -With those definitions, +With these definitions, @lisp (Test 1) @result{} (integer number top) @@ -710,6 +711,32 @@ With those definitions, (Test #t) @result{} (top) @end lisp +@code{next-method} is always called as just @code{(next-method)}. The +arguments for the next method call are always implicit, and always the +same as for the original method call. + +If you want to call on to a method with the same name but with a +different set of arguments (as you might with overloaded methods in C++, +for example), you do not use @code{next-method}, but instead simply +write the new call as usual: + +@lisp +(define-method (Test (a <number>) min max) + (if (and (>= a min) (<= a max)) + (display "Number is in range\n")) + (Test a)) + +(Test 2 1 10) +@print{} +Number is in range +@result{} +(integer number top) +@end lisp + +(You should be careful in this case that the @code{Test} calls do not +lead to an infinite recursion, but this consideration is just the same +as in Scheme code in general.) + @node Example, , Next-method, Generic functions @subsection Example diff --git a/doc/oldfmt.c b/doc/oldfmt.c index 0d2c86ead..fc82ba92a 100644 --- a/doc/oldfmt.c +++ b/doc/oldfmt.c @@ -1,43 +1,18 @@ -/* Copyright (C) 2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2000,2001, 2006, 2008 Free Software Foundation, Inc. * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301 USA - * - * As a special exception, the Free Software Foundation gives permission - * for additional uses of the text contained in its release of GUILE. + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. * - * The exception is that, if you link the GUILE library with other files - * to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the GUILE library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the - * Free Software Foundation under the name GUILE. If you copy - * code from other Free Software Foundation releases into a copy of - * GUILE, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. * - * If you write modifications of your own for GUILE, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ diff --git a/doc/ref/.cvsignore b/doc/ref/.cvsignore index 5a9c9005d..b78625611 100644 --- a/doc/ref/.cvsignore +++ b/doc/ref/.cvsignore @@ -22,6 +22,7 @@ Makefile Makefile.in autoconf-macros.texi mdate-sh +lib-version.texi stamp-vti stamp-vti.1 texinfo.tex diff --git a/doc/ref/.gitignore b/doc/ref/.gitignore new file mode 100644 index 000000000..fc69e3188 --- /dev/null +++ b/doc/ref/.gitignore @@ -0,0 +1,2 @@ +autoconf-macros.texi +lib-version.texi diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index ebb38fa33..e4ae0b1ae 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,153 @@ +2008-07-17 Neil Jerram <neil@ossau.uklinux.net> + + * scheme-using.texi (Evaluating Scheme Code): Document use of + `C-u' prefix with evaluation commands. + +2008-07-05 Ludovic Courtès <ludo@gnu.org> + + * api-data.texi (Symbol Primitives): Add `scm_c_symbol_length ()'. + +2008-06-30 Julian Graham <joolean@gmail.com> + + * srfi-modules.texi (SRFI-18): New section. + (SRFI-19 Time): Mention SRFI-18's `current-time'. + +2008-06-28 Ludovic Courtès <ludo@gnu.org> + + * api-modules.texi (Using Guile Modules): Substitute "syntax + transformer" to "system transformer". Reported by Sebastian + Tennant <sebyte@smolny.plus.com>. + +2008-06-01 Ludovic Courtès <ludo@gnu.org> + + * srfi-modules.texi (SRFI-88): Fix URL. + +2008-05-14 Julian Graham <joolean@gmail.com> + + * api-scheduling.texi (Mutexes and Condition Variables): Add + documentation for new functions "scm_mutex_owner", + "scm_mutex_level", and "scm_mutex_locked_p". Update + documentation for function "scm_lock_mutex_timed" to reflect + addition of optional ownership argument. + +2008-05-07 Ludovic Courtès <ludo@gnu.org> + + * Makefile.am (autoconf-macros.texi): Avoid use of GNU Make + specific `$<' variable. This broke with BSD Make as found on + FreeBSD 6.2. + +2008-05-05 Neil Jerram <neil@ossau.uklinux.net> + + * scheme-using.texi (Using Guile in Emacs): Add concept index + entries `GDS' and `Emacs'. + + * api-debug.texi (Debugging): Add concept index entry `Debugging'. + +2008-05-04 Ludovic Courtès <ludo@gnu.org> + + * guile.texi (Guile Modules): Include `autoconf.texi'. + * autoconf.texi (Autoconf Support): Mention `pkg-config'. + (Autoconf Macros): Document `pkg-config' support. + +2008-04-26 Ludovic Courtès <ludo@gnu.org> + + * srfi-modules.texi (SRFI-88): New section. + * api-data.texi (Keyword Read Syntax): Add reference to + `SRFI-88'. + +2008-04-17 Neil Jerram <neil@ossau.uklinux.net> + + * posix.texi (File System): New doc for file-exists?. + +2008-04-15 Ludovic Courtès <ludo@gnu.org> + + * api-data.texi (Keywords): Mention postfix syntax. + (Keyword Read Syntax): Document `postfix' read option. + * api-options.texi (Reader options): Update examples. + (Examples of option use): Likewise. + +2008-03-28 Neil Jerram <neil@ossau.uklinux.net> + + * libguile-concepts.texi (Multi-Threading): Fix typo. + +2008-03-24 Neil Jerram <neil@ossau.uklinux.net> + + Applying patch from Julian Graham, containing minor fixes to his + thread enhancements: + + * api-scheduling.texi (Mutexes and Condition Variables): Change + `flag' to `flags' in docstring. + +2008-03-19 Neil Jerram <neil@ossau.uklinux.net> + + * api-debug.texi (Low Level Trap Calls): Removed (material + duplicated elsewhere); doc for with-traps and debug-object? moved + to section on evaluator trap options. + (High Level Traps): Renamed just `Traps'. Add references to + evaluator trap options and debug options. Make language + appropriate for core Guile (as opposed to previously separate + package). + (Location Traps): Corrected to reflect that location traps now + specify a specific position, not a range of positions. + (Debugging Examples): New (content moved here from + scheme-debugging.texi, and updated to use traps instead of + breakpoints). + + * api-modules.texi (Included Guile Modules): Change `Debugging + Features' reference to `Tracing'. + + * api-options.texi (Evaluator trap options): Doc for with-traps + and debug-object? is now here. + + * guile.texi, scheme-debugging.texi: Move the `Tracing' content of + scheme-debugging.texi to the Modules section. + + * scheme-using.texi (Using Guile in Emacs, GDS Getting Started): + Minor edits. + + * scheme-debugging.texi (Debugging Features, Intro to + Breakpoints): Removed. + (Examples): Moved to api-debug.texi. + (Tracing, Old Tracing): Promoted one level. + (New Tracing, Tracing Compared): Removed. + +2008-03-08 Julian Graham <joolean@gmail.com> + + * api-scheduling.texi (Threads): Add documentation for new + functions "scm_thread_p" and new "scm_join_thread_timed". + (Mutexes and Condition Variables): Add documentation for new + functions "scm_make_mutex_with_flags", "scm_mutex_p", + "scm_lock_mutex_timed", "scm_unlock_mutex_timed", and + "scm_condition_variable_p". + +2008-02-11 Neil Jerram <neil@ossau.uklinux.net> + + * api-data.texi (Random): New text about the default random state, + following suggestions by Stephen Uitti. + +2008-02-01 Neil Jerram <neil@ossau.uklinux.net> + + * api-scheduling.texi (Threads): Add "C Function scm_join_thread" + to doc for join-thread. Thanks to Antoine Mathys for reporting + that scm_join_thread was missing. + +2007-12-09 Stephen Compall <s11@member.fsf.org> + + * srfi-modules.texi (SRFI-69): Avoid use of the first person. + +2007-12-03 Stephen Compall <s11@member.fsf.org> + + * srfi-modules.texi: Describe SRFI-69 in a new subsection. + +2007-10-29 Julian Graham <joolean@gmail.com> + + * api-scheduling.texi (Threads): Document `cancel-thread', + `set-thread-cleanup!' and `thread-cleanup'. + +2007-10-24 Neil Jerram <neil@ossau.uklinux.net> + + * .cvsignore: Add lib-version.texi. + 2007-10-02 Ludovic Courtès <ludo@gnu.org> * slib.texi (SLIB installation): Don't recommend using the site @@ -129,7 +279,7 @@ (lib-version.texi): New target. * guile.texi: Include `lib-version.texi'. - + * api-data.texi (Conversion): Link to `The ice-9 i18n Module' when describing `string->number'. (String Comparison): Likewise. @@ -317,7 +467,7 @@ * api-debug.texi (Debug on Error): Note need to handling of errors in C. - + * api-debug.texi (Debugging): New intro text. New subsection "Evaluation Model". Moved existing subsections "Capturing the Stack or Innermost Stack Frame", "Examining the Stack", "Examining @@ -353,7 +503,7 @@ * api-evaluation.texi (Fly Evaluation): Add scm_c_eval_string. (Loading): Add scm_c_primitive_load. Reported by Jon Wilson. - + 2006-06-25 Kevin Ryde <user42@zip.com.au> * posix.texi (Time): In tm:gmtoff, give example values, note not the @@ -487,7 +637,7 @@ * api-data.texi (Operations Related to Symbols): Documented `scm_take_locale_symbol ()'. - + 2005-12-15 Kevin Ryde <user42@zip.com.au> * api-evaluation.texi (Fly Evaluation): Add scm_call_4, suggested by @@ -578,7 +728,7 @@ * misc-modules.texi (Formatted Output): Show modifiers like ~:d instead of in words. - + 2005-08-06 Kevin Ryde <user42@zip.com.au> * api-compound.texi (List Modification): In filter, return may share a @@ -925,7 +1075,7 @@ * api-i18n.texi: New file. * Makefile.am (guile_TEXINFOS): Added it. * guile.texi: Include it. - + 2004-09-16 Kevin Ryde <user42@zip.com.au> * api-utility.texi (Equality): Revise for clarity. @@ -980,16 +1130,16 @@ Ran a (docstring-process-module "(guile)") and moved entries from new-docstrings.texi to their appropriate place. - + * api-undocumented.texi: New file. 2004-08-21 Marius Vollmer <mvo@zagadka.de> From Richard Todd, Thanks! - + * scheme-scripts.texi (Invoking Guile): documented new '-L' switch. - + 2004-08-20 Marius Vollmer <mvo@zagadka.de> * gh.texi: Updated transition section with new recommended things. @@ -1000,7 +1150,7 @@ mutation-sharing substrings. (Symbols): Document scm_from_locale_symbol and scm_from_locale_symboln. - + 2004-08-18 Kevin Ryde <user42@zip.com.au> * posix.texi (Network Sockets and Communication): Add SOCK_RDM and @@ -1062,7 +1212,7 @@ scm_is_complex, scm_is_number, scm_c_make_rectangular, scm_c_make_polar, scm_c_real_part, scm_c_imag_part, scm_c_magnitude, and scm_c_angle. - + 2004-08-02 Marius Vollmer <marius.vollmer@uni-dortmund.de> * gh.texi: Replaced references to scm_num2* with scm_to_* and @@ -1098,7 +1248,7 @@ * api-deprecated.texi: Removed. * intro.texi (Discouraged and Deprecated): General information about deprecation, etc. - + 2004-07-30 Marius Vollmer <marius.vollmer@uni-dortmund.de> * misc-modules.texi (Formatted Output): Changed @w to @w{} in @@ -1183,7 +1333,7 @@ * Makefile.am (CLEANFILES): Remove guile.cps guile.fns guile.rns guile.tps guile.vrs guile.tmp, cleaned by automake these days. - + 2004-05-06 Marius Vollmer <marius.vollmer@uni-dortmund.de> * scheme-smobs.texi: Updated for new SCM_SMOB_* macros. @@ -1266,7 +1416,7 @@ * scheme-control.texi (while do): Expand and clarify `do', in particular note iteration binds fresh locations, rather than values "stored". - + * srfi-modules.texi (SRFI-4): Revise for clarity, give each function explicitly rather than showing TAG so Emacs info-look can find them, merge "SRFI-4 - Read Syntax" and "SRFI-4 - Procedures" into just one @@ -1296,7 +1446,7 @@ 2004-01-21 Marius Vollmer <mvo@zagadka.de> Added copyright notices to all TeXinfo files. - + * fdl.texi: New. * guile.texi: Include it as an appendix. * preface.texi: State that the manual is FDL. @@ -1318,7 +1468,7 @@ * misc-modules.texi (Queues): New chapter. * guile.texi (Top): Add it. - + 2004-01-09 Kevin Ryde <user42@zip.com.au> * scheme-compound.texi (Bit Vectors): Revise for clarity, following @@ -1373,7 +1523,7 @@ * scheme-data.texi: Include exact rationals. From Stephen Compall. Thanks! - + * intro.texi (What is Guile?): Add @acronym for POSIX, R5RS, GUI, and HTTP. Conclude linking libguile. Say what one can find *for*. @@ -1454,7 +1604,7 @@ * data-rep.texi, scheme-memory.texi (scm_remember_upto_here_1, scm_remember_upto_here_2): Moved from data-rep.texi to scheme-memory.texi. - + 2003-10-02 Kevin Ryde <user42@zip.com.au> * scheme-io.texi (String Ports): In call-with-output-string, note proc @@ -1785,7 +1935,7 @@ remainder and modulo round their results. * scheme-io.texi (Reading): In read-char and peek-char, fix typos "?" - in @rnindex. In port-column, use @: after i.e. + in @rnindex. In port-column, use @: after i.e. (Writing): In get-print-state, two spaces after full stop. Add write, revise display. @@ -1804,7 +1954,7 @@ 2003-04-30 Marius Vollmer <marius.vollmer@uni-dortmund.de> - * posix.texi (scm_c_port_for_each): Added. + * posix.texi (scm_c_port_for_each): Added. 2003-04-26 Neil Jerram <neil@ossau.uklinux.net> @@ -1935,7 +2085,7 @@ Configuration. The following doc updates are from Ian Sheldon - thanks! - + * scheme-data.texi (Appending Strings, Regexp Functions, Match Structures): Add examples. (Regular Expressions): Add instruction to use (ice-9 regex) @@ -1973,7 +2123,7 @@ * intro.texi: Updated GNu ftp server name. Use "-lguile" instead of "libguile.a". Some small fixes/improvements. - + * scheme-reading.texi: Added www.schemers.org. Removed foldoc, it's too generic. Updated 'teach yourself ...' URL. @@ -1984,7 +2134,7 @@ 2002-08-14 Marius Vollmer <mvo@zagadka.ping.de> - * scheme-evaluation.texi (eval-string): Updated. + * scheme-evaluation.texi (eval-string): Updated. * scheme-scheduling.texi (Fluids): Touched up a bit, added with-fluids. @@ -2024,7 +2174,7 @@ * scheme-memory.texi (Memory Blocks): add scm_calloc, scm_gc_calloc. correct typos. - + 2002-08-05 Marius Vollmer <marius.vollmer@uni-dortmund.de> * intro.texi, srfi-modules.texi: Added (use-modules (ice-9 @@ -2068,7 +2218,7 @@ rather than deprecated section. Hence this change. Added `@deftp' for scm_t_bits data type so that a proper index entry is added for this. Thanks to Richard Y. Kim! - + * data-rep.texi (Subrs): Changed scm_make_gsubr to scm_c_define_gsubr. Thanks to Richard Y. Kim! @@ -2105,13 +2255,13 @@ * scheme-debug.texi (Debugging): Rename chapter `Debugging Infrastructure' and reorganize its contents. - + * scheme-debug.texi (Debugging), scheme-control.texi (Handling Errors): Move display-error to error-focussed section. * scheme-debug.texi (Debugging), debugging.texi (Backtrace): Move backtrace to user-level debugging chapter. - + * scheme-debug.texi (Debugging), scheme-procedures.texi (Procedure Properties): Move procedure-name, procedure-source and procedure-environment to procedures chapter. @@ -2194,7 +2344,7 @@ * scheme-utility.texi (Hooks): Further updates. New material on GC hooks. - + * scheme-evaluation.texi (Fly Evaluation): Note disappearance of eval2 and read-and-eval!. diff --git a/doc/ref/Makefile.am b/doc/ref/Makefile.am index 6ab2171af..60e23c27d 100644 --- a/doc/ref/Makefile.am +++ b/doc/ref/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 1998, 2004, 2006 Free Software Foundation, Inc. +## Copyright (C) 1998, 2004, 2006, 2008 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -86,7 +86,8 @@ include $(top_srcdir)/am/pre-inst-guile autoconf.texi: autoconf-macros.texi autoconf-macros.texi: $(top_srcdir)/guile-config/guile.m4 - $(preinstguiletool)/snarf-guile-m4-docs $< > $(srcdir)/$@ + $(preinstguiletool)/snarf-guile-m4-docs $(top_srcdir)/guile-config/guile.m4 \ + > $(srcdir)/$@ lib-version.texi: $(top_srcdir)/GUILE-VERSION cat "$^" | grep '^LIBGUILE_.*_MAJOR' | \ diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index 41bb9ac9c..e1db2a612 100755 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -1733,6 +1733,46 @@ The global random state used by the above functions when the @var{state} parameter is not given. @end defvar +Note that the initial value of @code{*random-state*} is the same every +time Guile starts up. Therefore, if you don't pass a @var{state} +parameter to the above procedures, and you don't set +@code{*random-state*} to @code{(seed->random-state your-seed)}, where +@code{your-seed} is something that @emph{isn't} the same every time, +you'll get the same sequence of ``random'' numbers on every run. + +For example, unless the relevant source code has changed, @code{(map +random (cdr (iota 30)))}, if the first use of random numbers since +Guile started up, will always give: + +@lisp +(map random (cdr (iota 19))) +@result{} +(0 1 1 2 2 2 1 2 6 7 10 0 5 3 12 5 5 12) +@end lisp + +To use the time of day as the random seed, you can use code like this: + +@lisp +(let ((time (gettimeofday))) + (set! *random-state* + (seed->random-state (+ (car time) + (cdr time))))) +@end lisp + +@noindent +And then (depending on the time of day, of course): + +@lisp +(map random (cdr (iota 19))) +@result{} +(0 0 1 0 2 4 5 4 5 5 9 3 10 1 8 3 14 17) +@end lisp + +For security applications, such as password generation, you should use +more bits of seed. Otherwise an open source password generator could +be attacked by guessing the seed@dots{} but that's a subject for +another manual. + @node Characters @subsection Characters @@ -4607,6 +4647,11 @@ immediately after creating the Scheme string. In certain cases, Guile can then use @var{str} directly as its internal representation. @end deftypefn +The size of a symbol can also be obtained from C: + +@deftypefn {C Function} size_t scm_c_symbol_length (SCM sym) +Return the number of characters in @var{sym}. +@end deftypefn Finally, some applications, especially those that generate new Scheme code dynamically, need to generate symbols for use in the generated @@ -4861,7 +4906,7 @@ makes them easy to type. Guile's keyword support conforms to R5RS, and adds a (switchable) read syntax extension to permit keywords to begin with @code{:} as well as -@code{#:}. +@code{#:}, or to end with @code{:}. @menu * Why Use Keywords?:: Motivation for keyword usage. @@ -5006,9 +5051,16 @@ If the @code{keyword} read option is set to @code{'prefix}, Guile also recognizes the alternative read syntax @code{:NAME}. Otherwise, tokens of the form @code{:NAME} are read as symbols, as required by R5RS. +@cindex SRFI-88 keyword syntax + +If the @code{keyword} read option is set to @code{'postfix}, Guile +recognizes the SRFI-88 read syntax @code{NAME:} (@pxref{SRFI-88}). +Otherwise, tokens of this form are read as symbols. + To enable and disable the alternative non-R5RS keyword syntax, you use the @code{read-set!} procedure documented in @ref{User level options -interfaces} and @ref{Reader options}. +interfaces} and @ref{Reader options}. Note that the @code{prefix} and +@code{postfix} syntax are mutually exclusive. @smalllisp (read-set! keywords 'prefix) @@ -5021,6 +5073,16 @@ interfaces} and @ref{Reader options}. @result{} #:type +(read-set! keywords 'postfix) + +type: +@result{} +#:type + +:type +@result{} +:type + (read-set! keywords #f) #:type diff --git a/doc/ref/api-debug.texi b/doc/ref/api-debug.texi index 68c202266..d99a56724 100644 --- a/doc/ref/api-debug.texi +++ b/doc/ref/api-debug.texi @@ -8,6 +8,7 @@ @node Debugging @section Debugging Infrastructure +@cindex Debugging In order to understand Guile's debugging facilities, you first need to understand a little about how the evaluator works and what the Scheme stack is. With that in place we explain the low level trap calls that @@ -17,9 +18,9 @@ infrastructure that builds on top of those calls. @menu * Evaluation Model:: Evaluation and the Scheme stack. * Debug on Error:: Debugging when an error occurs. -* Low Level Trap Calls:: -* High Level Traps:: +* Traps:: * Breakpoints:: +* Debugging Examples:: @end menu @node Evaluation Model @@ -610,65 +611,8 @@ Invoke the Guile debugger to explore the context of the last error. @end deffn -@node Low Level Trap Calls -@subsection Low Level Trap Calls - -@cindex Low level trap calls -@cindex Evaluator trap calls -Guile's evaluator can be configured to call the following four user-specified -procedures at various points in its operation. - -@table @dfn -@item apply-frame-handler -@item enter-frame-handler -@item exit-frame-handler -@item memoize-symbol-handler -@end table - -These procedures, and the circumstances under which the evaluator -calls them, are configured by the ``evaluator trap options'' interface -(@pxref{Evaluator trap options}), and by the @code{trace} and -@code{breakpoints} fields of the ``debug options'' interface -(@pxref{Debugger options}). - -It is not necessary to understand the fine details of these low level -calls, and of the options which configure them, in order to use the -class-based trap interface effectively. @code{guile-debugging} takes -care of setting these options as required for whatever set of -installed trap objects the user specifies.@footnote{And consequently, -when using the class-based trap interface, users/applications should -@emph{not} modify these options themselves, to avoid interfering with -@code{guile-debugging}'s option settings.} It is useful, though, to -have a overall idea of how the evaluator works and when these low -level calls can happen, as follows. - -@cindex Frame entry -@cindex Frame exit -On the basis of this description, we can now specify the points where -low level trap calls may occur (subject to configuration). Namely, -whenever a new frame is added to the stack, because the evaluator is -about to begin a new evaluation or to perform a new application, and -whenever a frame is being removed from the stack because the -computation that it refers to has completed and is returning its -value@footnote{If this raises the question of how expressions with -no return value are handled, the answer is that all computations in -Guile return a value. Those that appear to have no return value do so -by using the special @code{*unspecified*} value, which the Guile REPL -avoids displaying to the user.} to its caller. - -@deffn {Scheme Procedure} with-traps thunk -@deffnx {C Function} scm_with_traps (thunk) -Call @var{thunk} with traps enabled. -@end deffn - -@deffn {Scheme Procedure} debug-object? obj -@deffnx {C Function} scm_debug_object_p (obj) -Return @code{#t} if @var{obj} is a debug object. -@end deffn - - -@node High Level Traps -@subsection High Level Traps +@node Traps +@subsection Traps @cindex Traps @cindex Evaluator trap calls @@ -678,29 +622,33 @@ Return @code{#t} if @var{obj} is a debug object. @cindex Code coverage @cindex Profiling The low level C code of Guile's evaluator can be configured to call -out at key points to arbitrary user-specified code. In principle this -allows Scheme code to implement any model it chooses for examining the -evaluation stack as program execution proceeds, and for suspending -execution to be resumed later. Possible applications of this feature -include breakpoints, runtime tracing, code coverage, and profiling. +out at key points to arbitrary user-specified procedures. These +procedures, and the circumstances under which the evaluator calls +them, are configured by the ``evaluator trap options'' interface +(@pxref{Evaluator trap options}), and by the @code{trace} and +@code{breakpoints} fields of the ``debug options'' interface +(@pxref{Debugger options}). In principle this allows Scheme code to +implement any model it chooses for examining the evaluation stack as +program execution proceeds, and for suspending execution to be resumed +later. Possible applications of this feature include breakpoints, +runtime tracing, code coverage, and profiling. @cindex Trap classes @cindex Trap objects -Based on these low level trap calls, the enhancements described here -provide a much higher level, object-oriented interface for the -manipulation of traps. Different kinds of trap are represented as -GOOPS classes; for example, the @code{<procedure-trap>} class -describes traps that are triggered by invocation of a specified -procedure. A particular instance of a trap class --- or @dfn{trap -object} --- describes the condition under which a single trap will be -triggered, and what will happen then; for example, an instance of -@code{<procedure-trap>} whose @code{procedure} and @code{behaviour} -slots contain @code{my-factorial} and @code{debug-trap} would be a -trap that enters the command line debugger when the -@code{my-factorial} procedure is invoked. - -The following subsubsections describe all this in greater detail, for both -the user wanting to use traps, and the developer interested in +Based on these low level trap calls, Guile provides a higher level, +object-oriented interface for the manipulation of traps. Different +kinds of trap are represented as GOOPS classes; for example, the +@code{<procedure-trap>} class describes traps that are triggered by +invocation of a specified procedure. A particular instance of a trap +class --- or @dfn{trap object} --- describes the condition under which +a single trap will be triggered, and what will happen then; for +example, an instance of @code{<procedure-trap>} whose @code{procedure} +and @code{behaviour} slots contain @code{my-factorial} and +@code{debug-trap} would be a trap that enters the command line +debugger when the @code{my-factorial} procedure is invoked. + +The following subsections describe all this in detail, for both the +user wanting to use traps, and the developer interested in understanding how the interface hangs together. @@ -813,8 +761,8 @@ shorthands for setting common kinds of traps. @xref{Trap Shorthands}, for some examples. The ability to install, uninstall and reinstall a trap without losing -its definition is @code{guile-debugging}'s equivalent of the -disable/enable commands provided by debuggers like GDB. +its definition is Guile's equivalent of the disable/enable commands +provided by debuggers like GDB. @deffn {Generic Function} install-trap trap Install the trap object @var{trap}, so that its behaviour will be @@ -832,9 +780,9 @@ met. @subsubsection Specifying Trap Behaviour @cindex Trap behaviour -@code{guile-debugging} provides several ``out-of-the-box'' behaviours -for common needs. All of the following can be used directly as the -value of the @code{#:behaviour} option when creating a trap object. +Guile provides several ``out-of-the-box'' behaviours for common needs. +All of the following can be used directly as the value of the +@code{#:behaviour} option when creating a trap object. @deffn {Procedure} debug-trap trap-context Enter Guile's command line debugger to explore the stack at @@ -1179,9 +1127,9 @@ guile> (rev '(a b c)) @node Tracing and (ice-9 debug) @subsubsection Tracing and (ice-9 debug) -The @code{(ice-9 debug)} module of the core Guile distribution -provides a tracing facility that is roughly similar to that described -here, but there are important differences. +The @code{(ice-9 debug)} module provides a tracing facility +(@pxref{Tracing}) that is roughly similar to that described here, but +there are important differences. @itemize @bullet @item @@ -1202,35 +1150,30 @@ in stack depth, by using indentation like this: @end lisp However its output can @emph{only} show the information seen here, -which corresponds to @code{guile-debugging}'s @code{trace/info} -procedure; it cannot be configured to show other pieces of information -about the trap context in the way that @code{guile-debugging}'s trace -feature can. +which corresponds to @code{(ice-9 debugging trace)}'s +@code{trace/info} procedure; it cannot be configured to show other +pieces of information about the trap context in the way that the +@code{(ice-9 debugging trace)} implementation can. @item The @code{(ice-9 debug)} trace only allows the tracing of procedure -applications and their return values, whereas @code{guile-debugging}'s -trace allows any kind of trap to be traced. +applications and their return values, whereas the @code{(ice-9 debugging +trace)} implementation allows any kind of trap to be traced. It's interesting to note that @code{(ice-9 debug)}'s restriction here, which might initially appear to be just a straightforward consequence of its implementation, is also somewhat dictated by its pictorial display. The use of indentation in the output relies on hooking into the low level trap calls in such a way that the trapped application -entries and exits exactly balance each other. -@code{guile-debugging}'s more general traps interface allows traps to -be installed such that entry and exit traps don't necessarily balance, -which means that, in general, indentation diagrams like the one above -don't work. +entries and exits exactly balance each other. The @code{ice-9 +debugging trace} implementation allows traps to be installed such that +entry and exit traps don't necessarily balance, which means that, in +general, indentation diagrams like the one above don't work. @end itemize It isn't currently possible to use both @code{(ice-9 debug)} trace and -@code{guile-debugging} in the same Guile session, because their settings -of the low level trap options conflict with each other. (It should be -possible to fix this, by modifying @code{(ice-9 debug)} to use -@code{guile-debugging}'s trap installation interface, but only if and -when @code{guile-debugging} is integrated into the core Guile -distribution.) +@code{(ice-9 debugging trace)} in the same Guile session, because +their settings of the low level trap options conflict with each other. @node Traps Installing More Traps @@ -1456,9 +1399,9 @@ user would intuitively think of as single-stepping through their code, either through code in general (roughly corresponding to GDB's @code{step} command, for example), or through code from a particular source file (roughly corresponding to GDB's @code{next}). Therefore -if you are using @code{guile-debugging} to single-step through code -and finding its behaviour counter-intuitive, please let me know so -that I can improve it. +if you are using a step trap to single-step through code and finding +its behaviour counter-intuitive, please report that so we can improve +it. The implementation and options of the @code{<step-trap>} class are complicated by the fact that it is unreliable to determine whether a @@ -1620,16 +1563,16 @@ following subsubsection. @subsubsection Location Traps The @code{<location-trap>} class implements traps that are triggered -by evaluation of code at a specific source location or within a -specified range of source locations. When compared with source traps, -they are easier to set, and do not become irrelevant when the relevant -code is reloaded; but unfortunately they are considerably less -efficient, as they require running some ``are we in the right place -for a trap'' code on every low level frame entry trap call. +by evaluation of code at a specific source location. When compared +with source traps, they are easier to set, and do not become +irrelevant when the relevant code is reloaded; but unfortunately they +are a lot less efficient, as they require running some ``are we in the +right place for a trap'' code on every low level frame entry trap +call. @deffn {Class} <location-trap> Class for traps triggered by evaluation of code at a specific source -location or in a specified range of source locations. +location. @end deffn @deffn {Trap Option} #:file-regexp regexp @@ -1637,31 +1580,27 @@ A regular expression specifying the filenames that will match this trap. This option must be specified when creating a location trap. @end deffn -@deffn {Trap Option} #:line line-spec -If specified, @var{line-spec} describes either a single line, in which -case it is a single integer, or a range of lines, in which case it is -a pair of the form @code{(@var{min-line} . @var{max-line})}. All line -numbers are 0-based, and the range form is inclusive-inclusive. If -@code{#f} or not specified, the trap is not restricted by line number. -(Default value @code{#f}.) +@deffn {Trap Option} #:line line +The line number (0-based) of the source location at which the trap +should be triggered. This option must be specified when creating a +location trap. @end deffn -@deffn {Trap Option} #:column column-spec -If specified, @var{column-spec} describes either a single column, in -which case it is a single integer, or a range of columns, in which -case it is a pair of the form @code{(@var{min-column} -. @var{max-column})}. All column numbers are 0-based, and the range -form is inclusive-inclusive. If @code{#f} or not specified, the trap -is not restricted by column number. (Default value @code{#f}.) +@deffn {Trap Option} #:column column +The column number (0-based) of the source location at which the trap +should be triggered. This option must be specified when creating a +location trap. @end deffn @noindent -Example: +Here is an example, which matches the @code{(facti (- n 1) (* a n))} +expression in @file{ice-9/debugging/example-fns.scm}: @lisp (install-trap (make <location-trap> #:file-regexp "example-fns.scm" - #:line '(11 . 13) + #:line 11 + #:column 6 #:behaviour gds-debug-trap)) @end lisp @@ -1672,8 +1611,7 @@ Example: If the code described in the preceding subsubsections for creating and manipulating traps seems a little long-winded, it is of course possible to define more convenient shorthand forms for typical usage -patterns. For example, my own @file{.guile} file contains the -following definitions for setting breakpoints and for tracing. +patterns. Here are some examples. @lisp (define (break! proc) @@ -1694,11 +1632,11 @@ following definitions for setting breakpoints and for tracing. trace-until-exit)))) @end lisp -Definitions like these are not provided out-of-the-box by -@code{guile-debugging}, because different users will have different -ideas about what their default debugger should be, or, for example, -which of the common trap options (@pxref{Common Trap Options}) it -might be useful to expose through such shorthand procedures. +Definitions like these are not provided out-of-the-box by Guile, +because different users will have different ideas about what their +default debugger should be, or, for example, which of the common trap +options (@pxref{Common Trap Options}) it might be useful to expose +through such shorthand procedures. @node Trap Utilities @@ -1760,12 +1698,11 @@ While they are an important piece of infrastructure, and directly usable in some scenarios, traps are still too low level to meet some of the requirements of interactive development. -For example, in my experience a common scenario is that a newly -written procedure is not working properly, and so you'd like to be -able to step or trace through its code to find out why. Ideally this -should be possible from the IDE and without having to modify the -source code. There are two problems with using traps directly in this -scenario. +A common scenario is that a newly written procedure is not working +properly, and so you'd like to be able to step or trace through its +code to find out why. Ideally this should be possible from the IDE +and without having to modify the source code. There are two problems +with using traps directly in this scenario. @enumerate @item @@ -1885,6 +1822,216 @@ be managed through GDS. For the details of GDS's breakpoints interface, see @ref{Setting and Managing Breakpoints}. +@node Debugging Examples +@subsection Debugging Examples + +Here we present some examples of what you can do with the debugging +facilities just described. + +@menu +* Single Stepping through a Procedure's Code:: +* Profiling or Tracing a Procedure's Code:: +@end menu + + +@node Single Stepping through a Procedure's Code +@subsubsection Single Stepping through a Procedure's Code + +A good way to explore in detail what a Scheme procedure does is to set +a trap on it and then single step through what it does. To do this, +make and install a @code{<procedure-trap>} with the @code{debug-trap} +behaviour from @code{(ice-9 debugging ice-9-debugger-extensions)}. + +The following sample session illustrates this. It assumes that the +file @file{matrix.scm} defines a procedure @code{mkmatrix}, which is +the one we want to explore, and another procedure @code{do-main} which +calls @code{mkmatrix}. + +@lisp +$ /usr/bin/guile -q +guile> (use-modules (ice-9 debugger) + (ice-9 debugging ice-9-debugger-extensions) + (ice-9 debugging traps)) +guile> (load "matrix.scm") +guile> (install-trap (make <procedure-trap> + #:procedure mkmatrix + #:behaviour debug-trap)) +guile> (do-main 4) +This is the Guile debugger -- for help, type `help'. +There are 3 frames on the stack. + +Frame 2 at matrix.scm:8:3 + [mkmatrix] +debug> next +Frame 3 at matrix.scm:4:3 + (let ((x 1)) (quote this-is-a-matric)) +debug> info frame +Stack frame: 3 +This frame is an evaluation. +The expression being evaluated is: +matrix.scm:4:3: + (let ((x 1)) (quote this-is-a-matric)) +debug> next +Frame 3 at matrix.scm:5:21 + (quote this-is-a-matric) +debug> bt +In unknown file: + ?: 0* [primitive-eval (do-main 4)] +In standard input: + 4: 1* [do-main 4] +In matrix.scm: + 8: 2 [mkmatrix] + ... + 5: 3 (quote this-is-a-matric) +debug> quit +this-is-a-matric +guile> +@end lisp + +Or you can use Guile's Emacs interface (GDS), by using the module +@code{(ice-9 gds-client)} instead of @code{(ice-9 debugger)} and +@code{(ice-9 debugging ice-9-debugger-extensions)}, and changing +@code{debug-trap} to @code{gds-debug-trap}. Then the stack and +corresponding source locations are displayed in Emacs instead of on +the Guile command line. + + +@node Profiling or Tracing a Procedure's Code +@subsubsection Profiling or Tracing a Procedure's Code + +What if you wanted to get a trace of everything that the Guile +evaluator does within a given procedure, but without Guile stopping +and waiting for your input at every step? For this requirement you +can install a trap on the procedure, as in the previous example, but +instead of @code{debug-trap} or @code{gds-debug-trap}, use the +@code{trace-trap} and @code{trace-until-exit} behaviours provided by +the @code{(ice-9 debugging trace)} module. + +@lisp +guile> (use-modules (ice-9 debugging traps) (ice-9 debugging trace)) +guile> (load "matrix.scm") +guile> (install-trap (make <procedure-trap> + #:procedure mkmatrix + #:behaviour (list trace-trap trace-until-exit))) +guile> (do-main 4) +| 2: [mkmatrix] +| 3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> define #f] +| 3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> define #f] +| 4: (and (memq sym bindings) (let ...)) +| 5: (memq sym bindings) +| 5: [memq define (debug)] +| 5: =>#f +| 3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> define #f] +| 3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> define #f] +| 4: (and (memq sym bindings) (let ...)) +| 5: (memq sym bindings) +| 5: [memq define (debug)] +| 5: =>#f +| 3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f] +| 3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f] +| 4: (and (memq sym bindings) (let ...)) +| 5: (memq sym bindings) +| 5: [memq let (debug)] +| 5: =>#f +| 3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f] +| 3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f] +| 4: (and (memq sym bindings) (let ...)) +| 5: (memq sym bindings) +| 5: [memq let (debug)] +| 5: =>#f +| 3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f] +| 3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f] +| 4: (and (memq sym bindings) (let ...)) +| 5: (memq sym bindings) +| 5: [memq let (debug)] +| 5: =>#f +| 2: (letrec ((yy 23)) (let ((x 1)) (quote this-is-a-matric))) +| 3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f] +| 3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f] +| 4: (and (memq sym bindings) (let ...)) +| 5: (memq sym bindings) +| 5: [memq let (debug)] +| 5: =>#f +| 3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f] +| 3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f] +| 4: (and (memq sym bindings) (let ...)) +| 5: (memq sym bindings) +| 5: [memq let (debug)] +| 5: =>#f +| 3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f] +| 3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f] +| 4: (and (memq sym bindings) (let ...)) +| 5: (memq sym bindings) +| 5: [memq let (debug)] +| 5: =>#f +| 2: (let ((x 1)) (quote this-is-a-matric)) +| 3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f] +| 3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f] +| 4: (and (memq sym bindings) (let ...)) +| 5: (memq sym bindings) +| 5: [memq let (debug)] +| 5: =>#f +| 2: [let (let # #) (# # #)] +| 2: [let (let # #) (# # #)] +| 2: =>(#@@let* (x 1) #@@let (quote this-is-a-matric)) +this-is-a-matric +guile> (do-main 4) +| 2: [mkmatrix] +| 2: (letrec ((yy 23)) (let* ((x 1)) (quote this-is-a-matric))) +| 2: (let* ((x 1)) (quote this-is-a-matric)) +| 2: (quote this-is-a-matric) +| 2: =>this-is-a-matric +this-is-a-matric +guile> +@end lisp + +This example shows the default configuration for how each line of trace +output is formatted, which is: + +@itemize +@item +the character @code{|}, a visual clue that the line is a line of trace +output, followed by + +@item +a number indicating the real evaluator stack depth (where ``real'' means +not counting tail-calls), followed by + +@item +a summary of the expression being evaluated (@code{(@dots{})}), the +procedure being called (@code{[@dots{}]}), or the value being returned +from an evaluation or procedure call (@code{=>@dots{}}). +@end itemize + +@noindent +You can customize @code{(ice-9 debugging trace)} to show different +information in each trace line using the @code{set-trace-layout} +procedure. The next example shows how to get the source location in +each trace line instead of the stack depth. + +@lisp +guile> (set-trace-layout "|~16@@a: ~a\n" trace/source trace/info) +guile> (do-main 4) +| matrix.scm:7:2: [mkmatrix] +| : (letrec ((yy 23)) (let* ((x 1)) (quote this-is-a-matric))) +| matrix.scm:3:2: (let* ((x 1)) (quote this-is-a-matric)) +| matrix.scm:4:4: (quote this-is-a-matric) +| matrix.scm:4:4: =>this-is-a-matric +this-is-a-matric +guile> +@end lisp + +(For anyone wondering why the first @code{(do-main 4)} call above +generates lots more trace lines than the subsequent calls: these +examples also demonstrate how the Guile evaluator ``memoizes'' code. +When Guile evaluates a source code expression for the first time, it +changes some parts of the expression so that they will be quicker to +evaluate when that expression is evaluated again; this is called +memoization. The trace output from the first @code{(do-main 4)} call +shows memoization steps, such as an internal define being transformed to +a letrec.) + + @c Local Variables: @c TeX-master: "guile.texi" @c End: diff --git a/doc/ref/api-modules.texi b/doc/ref/api-modules.texi index 415c9cba6..9aeb08a44 100644 --- a/doc/ref/api-modules.texi +++ b/doc/ref/api-modules.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2008 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -329,12 +329,12 @@ Signal error if module name is not resolvable. @c FIXME::martin: Is this correct, and is there more to say? -@c FIXME::martin: Define term and concept `system transformer' somewhere. +@c FIXME::martin: Define term and concept `syntax transformer' somewhere. @deffn syntax use-syntax module-name -Load the module @code{module-name} and use its system -transformer as the system transformer for the currently defined module, -as well as installing it as the current system transformer. +Load the module @code{module-name} and use its syntax +transformer as the syntax transformer for the currently defined module, +as well as installing it as the current syntax transformer. @end deffn @deffn syntax @@ module-name binding-name @@ -679,7 +679,7 @@ Guile starts up. @item (ice-9 debug) Mikael Djurfeldt's source-level debugging support for Guile -(@pxref{Debugging Features}). +(@pxref{Tracing}). @item (ice-9 expect) Actions based on matching input from a port (@pxref{Expect}). diff --git a/doc/ref/api-options.texi b/doc/ref/api-options.texi index 493e2385d..c6ce34623 100644 --- a/doc/ref/api-options.texi +++ b/doc/ref/api-options.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2008 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -491,7 +491,7 @@ Here is the list of reader options generated by typing values. @smalllisp -keywords #f Style of keyword recognition: #f or 'prefix +keywords #f Style of keyword recognition: #f, 'prefix or 'postfix case-insensitive no Convert symbols to lower case. positions yes Record positions of source code expressions. copy no Copy source code expressions. @@ -613,7 +613,6 @@ way. @var{retval} is the return value. @end deffn - @deffn memoize-symbol-handler key cont expression env Called when the evaluator memoizes the value of a procedure symbol @@ -626,6 +625,16 @@ way. @var{retval} is the return value. @end deffn +@deffn {Scheme Procedure} with-traps thunk +@deffnx {C Function} scm_with_traps (thunk) +Call @var{thunk} with traps enabled. +@end deffn + +@deffn {Scheme Procedure} debug-object? obj +@deffnx {C Function} scm_debug_object_p (obj) +Return @code{#t} if @var{obj} is a debug object. +@end deffn + @node Debugger options @subsubsection Debugger options @@ -720,7 +729,7 @@ ABORT: (misc-error) Type "(backtrace)" to get more information. guile> (read-options 'help) -keywords #f Style of keyword recognition: #f or 'prefix +keywords #f Style of keyword recognition: #f, 'prefix or 'postfix case-insensitive no Convert symbols to lower case. positions yes Record positions of source code expressions. copy no Copy source code expressions. diff --git a/doc/ref/api-scheduling.texi b/doc/ref/api-scheduling.texi index 1eaafc48d..3b622868c 100644 --- a/doc/ref/api-scheduling.texi +++ b/doc/ref/api-scheduling.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -90,8 +90,8 @@ execution and triggering this execution. They will not be executed automatically. @menu -* System asyncs:: -* User asyncs:: +* System asyncs:: +* User asyncs:: @end menu @node System asyncs @@ -267,11 +267,24 @@ Once @var{body} or @var{handler} returns, the return value is made the @emph{exit value} of the thread and the thread is terminated. @end deftypefn +@deffn {Scheme Procedure} thread? obj +@deffnx {C Function} scm_thread_p (obj) +Return @code{#t} iff @var{obj} is a thread; otherwise, return +@code{#f}. +@end deffn + @c begin (texi-doc-string "guile" "join-thread") -@deffn {Scheme Procedure} join-thread thread +@deffn {Scheme Procedure} join-thread thread [timeout [timeoutval]] +@deffnx {C Function} scm_join_thread (thread) +@deffnx {C Function} scm_join_thread_timed (thread, timeout, timeoutval) Wait for @var{thread} to terminate and return its exit value. Threads that have not been created with @code{call-with-new-thread} or -@code{scm_spawn_thread} have an exit value of @code{#f}. +@code{scm_spawn_thread} have an exit value of @code{#f}. When +@var{timeout} is given, it specifies a point in time where the waiting +should be aborted. It can be either an integer as returned by +@code{current-time} or a pair as returned by @code{gettimeofday}. +When the waiting is aborted, @var{timeoutval} is returned (if it is +specified; @code{#f} is returned otherwise). @end deffn @deffn {Scheme Procedure} thread-exited? thread @@ -285,6 +298,42 @@ If one or more threads are waiting to execute, calling yield forces an immediate context switch to one of them. Otherwise, yield has no effect. @end deffn +@deffn {Scheme Procedure} cancel-thread thread +@deffnx {C Function} scm_cancel_thread (thread) +Asynchronously notify @var{thread} to exit. Immediately after +receiving this notification, @var{thread} will call its cleanup handler +(if one has been set) and then terminate, aborting any evaluation that +is in progress. + +Because Guile threads are isomorphic with POSIX threads, @var{thread} +will not receive its cancellation signal until it reaches a cancellation +point. See your operating system's POSIX threading documentation for +more information on cancellation points; note that in Guile, unlike +native POSIX threads, a thread can receive a cancellation notification +while attempting to lock a mutex. +@end deffn + +@deffn {Scheme Procedure} set-thread-cleanup! thread proc +@deffnx {C Function} scm_set_thread_cleanup_x (thread, proc) +Set @var{proc} as the cleanup handler for the thread @var{thread}. +@var{proc}, which must be a thunk, will be called when @var{thread} +exits, either normally or by being canceled. Thread cleanup handlers +can be used to perform useful tasks like releasing resources, such as +locked mutexes, when thread exit cannot be predicted. + +The return value of @var{proc} will be set as the @emph{exit value} of +@var{thread}. + +To remove a cleanup handler, pass @code{#f} for @var{proc}. +@end deffn + +@deffn {Scheme Procedure} thread-cleanup thread +@deffnx {C Function} scm_thread_cleanup (thread) +Return the cleanup handler currently installed for the thread +@var{thread}. If no cleanup handler is currently installed, +thread-cleanup returns @code{#f}. +@end deffn + Higher level thread procedures are available by loading the @code{(ice-9 threads)} module. These provide standardized thread creation. @@ -326,20 +375,54 @@ Acquiring requisite mutexes in a fixed order (like always A before B) in all threads is one way to avoid such problems. @sp 1 -@deffn {Scheme Procedure} make-mutex +@deffn {Scheme Procedure} make-mutex . flags @deffnx {C Function} scm_make_mutex () -Return a new standard mutex. It is initially unlocked. +@deffnx {C Function} scm_make_mutex_with_flags (SCM flags) +Return a new mutex. It is initially unlocked. If @var{flags} is +specified, it must be a list of symbols specifying configuration flags +for the newly-created mutex. The supported flags are: +@table @code +@item unchecked-unlock +Unless this flag is present, a call to `unlock-mutex' on the returned +mutex when it is already unlocked will cause an error to be signalled. + +@item allow-external-unlock +Allow the returned mutex to be unlocked by the calling thread even if +it was originally locked by a different thread. + +@item recursive +The returned mutex will be recursive. + +@end table +@end deffn + +@deffn {Scheme Procedure} mutex? obj +@deffnx {C Function} scm_mutex_p (obj) +Return @code{#t} iff @var{obj} is a mutex; otherwise, return +@code{#f}. @end deffn @deffn {Scheme Procedure} make-recursive-mutex @deffnx {C Function} scm_make_recursive_mutex () -Create a new recursive mutex. It is initialloy unlocked. +Create a new recursive mutex. It is initially unlocked. Calling this +function is equivalent to calling `make-mutex' and specifying the +@code{recursive} flag. @end deffn -@deffn {Scheme Procedure} lock-mutex mutex +@deffn {Scheme Procedure} lock-mutex mutex [timeout [owner]] @deffnx {C Function} scm_lock_mutex (mutex) -Lock @var{mutex}. If the mutex is already locked by another thread -then block and return only when @var{mutex} has been acquired. +@deffnx {C Function} scm_lock_mutex_timed (mutex, timeout, owner) +Lock @var{mutex}. If the mutex is already locked, then block and +return only when @var{mutex} has been acquired. + +When @var{timeout} is given, it specifies a point in time where the +waiting should be aborted. It can be either an integer as returned +by @code{current-time} or a pair as returned by @code{gettimeofday}. +When the waiting is aborted, @code{#f} is returned. + +When @var{owner} is given, it specifies an owner for @var{mutex} other +than the calling thread. @var{owner} may also be @code{#f}, +indicating that the mutex should be locked but left unowned. For standard mutexes (@code{make-mutex}), and error is signalled if the thread has itself already locked @var{mutex}. @@ -349,6 +432,10 @@ itself already locked @var{mutex}, then a further @code{lock-mutex} call increments the lock count. An additional @code{unlock-mutex} will be required to finally release. +If @var{mutex} was locked by a thread that exited before unlocking it, +the next attempt to lock @var{mutex} will succeed, but +@code{abandoned-mutex-error} will be signalled. + When a system async (@pxref{System asyncs}) is activated for a thread blocked in @code{lock-mutex}, the wait is interrupted and the async is executed. When the async returns, the wait resumes. @@ -367,10 +454,46 @@ If @var{mutex} is locked by some other thread then nothing is done and the return is @code{#f}. @end deffn -@deffn {Scheme Procedure} unlock-mutex mutex +@deffn {Scheme Procedure} unlock-mutex mutex [condvar [timeout]] @deffnx {C Function} scm_unlock_mutex (mutex) -Unlock @var{mutex}. An error is signalled if @var{mutex} is not -locked by the calling thread. +@deffnx {C Function} scm_unlock_mutex_timed (mutex, condvar, timeout) +Unlock @var{mutex}. An error is signalled if @var{mutex} is not locked +and was not created with the @code{unchecked-unlock} flag set, or if +@var{mutex} is locked by a thread other than the calling thread and was +not created with the @code{allow-external-unlock} flag set. + +If @var{condvar} is given, it specifies a condition variable upon +which the calling thread will wait to be signalled before returning. +(This behavior is very similar to that of +@code{wait-condition-variable}, except that the mutex is left in an +unlocked state when the function returns.) + +When @var{timeout} is also given, it specifies a point in time where +the waiting should be aborted. It can be either an integer as +returned by @code{current-time} or a pair as returned by +@code{gettimeofday}. When the waiting is aborted, @code{#f} is +returned. Otherwise the function returns @code{#t}. +@end deffn + +@deffn {Scheme Procedure} mutex-owner mutex +@deffnx {C Function} scm_mutex_owner (mutex) +Return the current owner of @var{mutex}, in the form of a thread or +@code{#f} (indicating no owner). Note that a mutex may be unowned but +still locked. +@end deffn + +@deffn {Scheme Procedure} mutex-level mutex +@deffnx {C Function} scm_mutex_level (mutex) +Return the current lock level of @var{mutex}. If @var{mutex} is +currently unlocked, this value will be 0; otherwise, it will be the +number of times @var{mutex} has been recursively locked by its current +owner. +@end deffn + +@deffn {Scheme Procedure} mutex-locked? mutex +@deffnx {C Function} scm_mutex_locked_p (mutex) +Return @code{#t} if @var{mutex} is locked, regardless of ownership; +otherwise, return @code{#f}. @end deffn @deffn {Scheme Procedure} make-condition-variable @@ -378,6 +501,12 @@ locked by the calling thread. Return a new condition variable. @end deffn +@deffn {Scheme Procedure} condition-variable? obj +@deffnx {C Function} scm_condition_variable_p (obj) +Return @code{#t} iff @var{obj} is a condition variable; otherwise, +return @code{#f}. +@end deffn + @deffn {Scheme Procedure} wait-condition-variable condvar mutex [time] @deffnx {C Function} scm_wait_condition_variable (condvar, mutex, time) Wait until @var{condvar} has been signalled. While waiting, diff --git a/doc/ref/autoconf.texi b/doc/ref/autoconf.texi index 828155c3d..83686dada 100644 --- a/doc/ref/autoconf.texi +++ b/doc/ref/autoconf.texi @@ -8,10 +8,10 @@ @node Autoconf Support @chapter Autoconf Support -When Guile is installed, a set of autoconf macros is also installed as -PREFIX/share/aclocal/guile.m4. This chapter documents the macros provided in -that file, as well as the high-level guile-tool Autofrisk. @xref{Top,The GNU -Autoconf Manual,,autoconf}, for more info. +When Guile is installed, a pkg-config description file and a set of +Autoconf macros is installed. This chapter documents pkg-config and +Autoconf support, as well as the high-level guile-tool Autofrisk. +@xref{Top,The GNU Autoconf Manual,,autoconf}, for more info. @menu * Autoconf Background:: Why use autoconf? @@ -45,7 +45,38 @@ checks. @node Autoconf Macros @section Autoconf Macros -The macro names all begin with "GUILE_". +@cindex pkg-config +@cindex autoconf + +GNU Guile provides a @dfn{pkg-config} description file, installed as +@file{@var{prefix}/lib/pkgconfig/guile-1.8.pc}, which contains all the +information necessary to compile and link C applications that use Guile. +The @code{pkg-config} program is able to read this file and provide this +information to application programmers; it can be obtained at +@url{http://pkg-config.freedesktop.org/}. + +The following command lines give respectively the C compilation and link +flags needed to build Guile-using programs: + +@example +pkg-config guile-1.8 --cflags +pkg-config guile-1.8 --libs +@end example + +To ease use of pkg-config with Autoconf, pkg-config comes with a +convenient Autoconf macro. The following example looks for Guile and +sets the @code{GUILE_CFLAGS} and @code{GUILE_LIBS} variables +accordingly, or prints an error and exits if Guile was not found: + +@findex PKG_CHECK_MODULES + +@example +PKG_CHECK_MODULES([GUILE], [guile-1.8]) +@end example + +Guile comes with additional Autoconf macros providing more information, +installed as @file{@var{prefix}/share/aclocal/guile.m4}. Their names +all begin with @code{GUILE_}. @c see Makefile.am @include autoconf-macros.texi diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi index 109a50b7f..a56f95cf8 100644 --- a/doc/ref/guile.texi +++ b/doc/ref/guile.texi @@ -138,7 +138,7 @@ x @comment The title is printed in a large font. @title Guile Reference Manual @subtitle Edition @value{MANUAL-EDITION}, for use with Guile @value{VERSION} -@c @subtitle $Id: guile.texi,v 1.48 2006-11-18 18:14:55 civodul Exp $ +@c @subtitle $Id: guile.texi,v 1.49 2008-03-19 22:51:23 ossau Exp $ @c See preface.texi for the list of authors @author The Guile Developers @@ -177,6 +177,8 @@ x * Guile Modules:: +* Autoconf Support:: + Appendices * Data Representation:: All the details. @@ -222,7 +224,6 @@ etc. that make up Guile's application programming interface (API), * Guile Scripting:: How to write Guile scripts. * Using Guile Interactively:: Guile's REPL features. * Using Guile in Emacs:: Guile and Emacs. -* Debugging Features:: Features for finding errors. * Further Reading:: Where to find out more about Scheme. @end menu @@ -230,7 +231,6 @@ etc. that make up Guile's application programming interface (API), @include scheme-intro.texi @include scheme-scripts.texi @include scheme-using.texi -@include scheme-debugging.texi @include scheme-reading.texi @node Programming in C @@ -351,6 +351,7 @@ available through both Scheme and C interfaces. * Buffered Input:: Ports made from a reader function. * Expect:: Controlling interactive programs with Guile. * The Scheme shell (scsh):: Using scsh interfaces in Guile. +* Tracing:: Tracing program execution. @end menu @include slib.texi @@ -361,6 +362,9 @@ available through both Scheme and C interfaces. @include misc-modules.texi @include expect.texi @include scsh.texi +@include scheme-debugging.texi + +@include autoconf.texi @include data-rep.texi @include fdl.texi diff --git a/doc/ref/libguile-concepts.texi b/doc/ref/libguile-concepts.texi index 6fef7a79a..20c0f72ca 100644 --- a/doc/ref/libguile-concepts.texi +++ b/doc/ref/libguile-concepts.texi @@ -474,7 +474,7 @@ multiple threads using them concurrently. This means that there is no risk of the internal data structures of libguile becoming corrupted in such a way that the process crashes. -A program might still produce non-sensical results, though. Taking +A program might still produce nonsensical results, though. Taking hashtables as an example, Guile guarantees that you can use them from multiple threads concurrently and a hashtable will always remain a valid hashtable and Guile will not crash when you access it. It does not diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index f81abbc6b..a91bdb969 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -956,6 +956,11 @@ If @var{suffix} is provided, and is equal to the end of @end lisp @end deffn +@deffn {Scheme Procedure} file-exists? filename +Return @code{#t} if the file named @var{filename} exists, @code{#f} if +not. +@end deffn + @node User Information @subsection User Information @@ -1259,27 +1264,8 @@ formatting. If @code{setlocale} has been called (@pxref{Locales}), month and day names are from the current locale and in the locale character set. -Note that @samp{%Z} might print the @code{tm:zone} in @var{tm} or it -might print just the current zone (@code{tzset} above). A GNU system -prints @code{tm:zone}, a strict C99 system like NetBSD prints the -current zone. Perhaps in the future Guile will try to get -@code{tm:zone} used always. -@c -@c The issue in the above is not just whether tm_zone exists in -@c struct tm, but whether libc feels it should read it. Being a -@c non-C99 field, a strict C99 program won't know to set it, quite -@c likely leaving garbage there. NetBSD, which has the field, -@c therefore takes the view that it mustn't read it. See the PR -@c about this at -@c -@c http://www.netbsd.org/cgi-bin/query-pr-single.pl?number=21722 -@c -@c Uniformly making tm:zone used on all systems (all those which have -@c %Z at all of course) might be nice (either mung TZ and tzset, or -@c mung tzname[]). On the other hand it would make us do more than -@c C99 says, and we really don't want to get intimate with the gory -@c details of libc time funcs, no more than can be helped. -@c +Note that @samp{%Z} always ignores the @code{tm:zone} in @var{tm}; +instead it prints just the current zone (@code{tzset} above). @end deffn @deffn {Scheme Procedure} strptime format string diff --git a/doc/ref/scheme-debugging.texi b/doc/ref/scheme-debugging.texi index 32a6a46bd..07511263b 100644 --- a/doc/ref/scheme-debugging.texi +++ b/doc/ref/scheme-debugging.texi @@ -5,280 +5,8 @@ @c See the file guile.texi for copying conditions. @page -@node Debugging Features -@section Debugging Features - -Guile includes debugging tools to help you work out what is going wrong -when a program signals an error or behaves differently to how you would -expect. This chapter describes how to use these tools. - -Broadly speaking, Guile's debugging support allows you to do two things: - -@itemize @bullet -@item -specify @dfn{breakpoints} --- points in the execution of a program where -execution should pause so you can see what is going on - -@item -examine in detail the ``scene of the crime'' --- in other words, the -execution context at a breakpoint, or when the last error occurred. -@end itemize - -@noindent -The details are more complex and more powerful @dots{} - -@menu -* Examples:: -* Intro to Breakpoints:: Setting and manipulating them. -* Tracing:: Tracing program execution. -@end menu - - -@node Examples -@subsection Examples - -Before we dive into the details and reference documentation of -guile-debugging's features, this chapter sets the scene by presenting a -few examples of what you can do with guile-debugging. - -@menu -* Single Stepping through a Procedure's Code:: -* Profiling or Tracing a Procedure's Code:: -@end menu - - -@node Single Stepping through a Procedure's Code -@subsubsection Single Stepping through a Procedure's Code - -A good way to explore in detail what a Scheme procedure does is to set a -breakpoint on it and then single step through what it does. To do this, -use the @code{break-in} procedure from the @code{(ice-9 debugging -breakpoints)} module with the @code{debug-trap} behaviour from -@code{(ice-9 debugging ice-9-debugger-extensions)}. The following -sample session illustrates this. It assumes that the file -@file{matrix.scm} defines a procedure @code{mkmatrix}, which is the one -we want to explore, and another procedure @code{do-main} which calls -@code{mkmatrix}. - -@lisp -$ /usr/bin/guile -q -guile> (use-modules (ice-9 debugger) - (ice-9 debugging ice-9-debugger-extensions) - (ice-9 debugging breakpoints)) -guile> (load "matrix.scm") -guile> (break-in 'mkmatrix #:behaviour debug-trap) -#<<break-in> 808cb70> -guile> (do-main 4) -This is the Guile debugger -- for help, type `help'. -There are 3 frames on the stack. - -Frame 2 at matrix.scm:8:3 - [mkmatrix] -debug> next -Frame 3 at matrix.scm:4:3 - (let ((x 1)) (quote this-is-a-matric)) -debug> info frame -Stack frame: 3 -This frame is an evaluation. -The expression being evaluated is: -matrix.scm:4:3: - (let ((x 1)) (quote this-is-a-matric)) -debug> next -Frame 3 at matrix.scm:5:21 - (quote this-is-a-matric) -debug> bt -In unknown file: - ?: 0* [primitive-eval (do-main 4)] -In standard input: - 4: 1* [do-main 4] -In matrix.scm: - 8: 2 [mkmatrix] - ... - 5: 3 (quote this-is-a-matric) -debug> quit -this-is-a-matric -guile> -@end lisp - -Or you can use guile-debugging's Emacs interface (GDS), by using the -module @code{(ice-9 gds-client)} instead of @code{(ice-9 debugger)} and -@code{(ice-9 debugging ice-9-debugger-extensions)}, and changing -@code{debug-trap} to @code{gds-debug-trap}. Then the stack and -corresponding source locations are displayed in Emacs instead of on the -Guile command line. - - -@node Profiling or Tracing a Procedure's Code -@subsubsection Profiling or Tracing a Procedure's Code - -What if you wanted to get a trace of everything that the Guile evaluator -does within a given procedure, but without Guile stopping and waiting -for your input at every step? In this case you set a breakpoint on the -procedure using @code{break-in} (the same as in the previous example), -but use the @code{trace-trap} and @code{trace-until-exit} behaviours -provided by the @code{(ice-9 debugging trace)} module. - -@lisp -guile> (use-modules (ice-9 debugging breakpoints) (ice-9 debugging trace)) -guile> (load "matrix.scm") -guile> (break-in 'mkmatrix #:behaviour (list trace-trap trace-until-exit)) -#<<break-in> 808b430> -guile> (do-main 4) -| 2: [mkmatrix] -| 3: [define (define yy 23) ((()) #<eval-closure 4028db30>)] -| 3: [define (define yy 23) ((()) #<eval-closure 4028db30>)] -| 3: =>(#@@define yy 23) -| 3: [let (let # #) (# #)] -| 3: [let (let # #) (# #)] -| 3: =>(#@@let* (x 1) #@@let (quote this-is-a-matric)) -| 2: (letrec ((yy 23)) (let ((x 1)) (quote this-is-a-matric))) -| 3: [let (let # #) (# # #)] -| 3: [let (let # #) (# # #)] -| 3: =>(#@@let* (x 1) #@@let (quote this-is-a-matric)) -| 2: (let ((x 1)) (quote this-is-a-matric)) -| 3: [quote (quote this-is-a-matric) ((x . 1) ((yy) 23) (()) ...)] -| 3: [quote (quote this-is-a-matric) ((x . 1) ((yy) 23) (()) ...)] -| 3: =>(#@@quote this-is-a-matric) -| 2: (quote this-is-a-matric) -| 2: =>this-is-a-matric -this-is-a-matric -guile> (do-main 4) -| 2: [mkmatrix] -| 2: (letrec ((yy 23)) (let ((x 1)) (quote this-is-a-matric))) -| 2: (let ((x 1)) (quote this-is-a-matric)) -| 2: (quote this-is-a-matric) -| 2: =>this-is-a-matric -this-is-a-matric -guile> -@end lisp - -This example shows the default configuration for how each line of trace -output is formatted, which is: - -@itemize -@item -the character @code{|}, a visual clue that the line is a line of trace -output, followed by - -@item -a number indicating the real evaluator stack depth (where ``real'' means -not counting tail-calls), followed by - -@item -a summary of the expression being evaluated (@code{(@dots{})}), the -procedure being called (@code{[@dots{}]}), or the value being returned -from an evaluation or procedure call (@code{=>@dots{}}). -@end itemize - -@noindent -You can customize @code{(ice-9 debugging trace)} to show different -information in each trace line using the @code{set-trace-layout} -procedure. The next example shows how to get the source location in -each trace line instead of the stack depth. - -@lisp -guile> (set-trace-layout "|~16@@a: ~a\n" trace/source trace/info) -guile> (do-main 4) -| matrix.scm:7:2: [mkmatrix] -| : (letrec ((yy 23)) (let ((x 1)) (quote this-is-a-matric))) -| matrix.scm:3:2: (let ((x 1)) (quote this-is-a-matric)) -| matrix.scm:4:20: (quote this-is-a-matric) -| matrix.scm:4:20: =>this-is-a-matric -this-is-a-matric -guile> -@end lisp - -(For anyone wondering why the first @code{(do-main 4)} call above -generates lots more trace lines than the subsequent calls: these -examples also demonstrate how the Guile evaluator ``memoizes'' code. -When Guile evaluates a source code expression for the first time, it -changes some parts of the expression so that they will be quicker to -evaluate when that expression is evaluated again; this is called -memoization. The trace output from the first @code{(do-main 4)} call -shows memoization steps, such as an internal define being transformed to -a letrec.) - - -@node Intro to Breakpoints -@subsection Intro to Breakpoints - -Sometimes a piece of Scheme code isn't working and you'd like to go -through it step by step. You can do this in Guile by setting a -breakpoint at the start of the relevant code, and then using the command -line or Emacs interface to step through it. - -A breakpoint can be specified by procedure name or by location -- the -relevant code's file name, line number and column number. For details -please see the full documentation for @code{break-in} and -@code{break-at} in @ref{Intro to Breakpoints}. - -When you set a breakpoint, you can specify any ``behaviour'' you like -for what should happen when the breakpoint is hit; a breakpoint -``behaviour'' is just a Scheme procedure with the right signature. - -@menu -* Breakpoints Overview:: -@end menu - - -@node Breakpoints Overview -@subsubsection How Breakpoints Work and Why They Are Useful - -Often, debugging the last error is not enough to tell you what went -wrong. For example, the root cause of the error may have arisen a long -time before the error was signalled, in which case the execution context -of the error is too late to be useful. Or your program might not signal -an error at all, just return an unexpected result or have some incorrect -side effect. - -In many such cases, it's useful to pause the program at or before the -point where you suspect the problem arises. Then you can explore the -stack, display the values of key variables, and generally check that the -state of the program is as you expect. If all is well, you can let the -program continue running normally, or step more slowly through each -expression that the Scheme interpreter evaluates. Single-stepping may -reveal that the program is going through blocks of code that you didn't -intend --- a useful data point for understanding what the underlying -problem is. - -Telling Guile where or when to pause a program is called @dfn{setting a -breakpoint}. When a breakpoint is hit, Guile's default behaviour is to -enter the interactive debugger, where there are now two sets of commands -available: - -@itemize @bullet -@item -all the commands as described for last error debugging -(@pxref{Interactive Debugger}), which allow you to explore the stack and -so on - -@item -additional commands for continuing program execution in various ways: -@code{next}, @code{step}, @code{finish}, @code{trace-finish} and -@code{continue}. -@end itemize - -Use of the interactive debugger is described in @ref{Interactive -Debugger}. - - @node Tracing -@subsection Tracing - -Tracing has already been described as a breakpoint behaviour, but we -mention it again here because it is so useful, and because Guile -actually now has @emph{two} mechanisms for tracing, and its worth -clarifying the differences between them. - -@menu -* Old Tracing:: Tracing provided by (ice-9 debug). -* New Tracing:: Breakpoint-based tracing. -* Tracing Compared:: Differences between old and new. -@end menu - - -@node Old Tracing -@subsubsection Tracing Provided by @code{(ice-9 debug)} +@section Tracing The @code{(ice-9 debug)} module implements tracing of procedure applications. When a procedure is @dfn{traced}, it means that every @@ -391,128 +119,6 @@ there is no need for Guile to create a new stack frame for each iteration. Tracing reveals this optimization in operation. -@node New Tracing -@subsubsection Breakpoint-based Tracing - -Guile's newer mechanism implements tracing as an optional behaviour for -any kind of breakpoint. - -To trace a procedure (in the same kind of way as the older tracing), use -the @code{trace!} procedure to set a procedure breakpoint with -@code{trace-here} behaviour: - -@lisp -(trace! fact1) -@print{} -Set breakpoint 1: [fact1] -@result{} -#<<procedure-breakpoint> 40337bf0> - -(fact1 4) -@print{} -| [fact1 4] -| | [fact1 3] -| | | [fact1 2] -| | | | [fact1 1] -| | | | | [fact1 0] -| | | | | 1 -| | | | 2 -| | | 6 -| | 24 -| 24 -@result{} -24 -@end lisp - -To trace evaluation of a source expression, evaluate code containing a -breakpoint marker @code{##} in the appropriate place, then use -@code{set-breakpoint} to change the behaviour of the new breakpoint to -@code{trace-here}: - -@lisp -(define (fact1 n) - (if ##(= n 0) - 1 - (* n (fact1 (- n 1))))) -@print{} -Set breakpoint 4: standard input:13:9: (= n 0) - -(use-modules (ice-9 debugger behaviour)) -(set-breakpoint! trace-here 4) -@print{} -Breakpoint 4: standard input:13:9: (= n 0) - enabled? = #t - behaviour = #<procedure trace-here ()> - -(fact1 4) -@print{} -| (= n 0) -| #f -| (= n 0) -| #f -| (= n 0) -| #f -| (= n 0) -| #f -| (= n 0) -| #t -@result{} -24 -@end lisp - -@noindent -(Note --- this example reveals a bug: each occurrence of @code{(= n 0)} -should be shown indented with respect to the one before it, as -@code{fact1} does not call itself tail-recursively.) - -You can also give a breakpoint the @code{trace-subtree} behaviour, which -means to trace the breakpoint location itself plus any evaluations and -applications that occur below it in the call stack. In the following -example, this allows us to see the evaluated arguments that are being -compared by the @code{=} procedure: - -@lisp -(set-breakpoint! trace-subtree 4) -@print{} -Breakpoint 4: standard input:13:9: (= n 0) - enabled? = #t - behaviour = #<procedure trace-subtree ()> - -(fact1 4) -@print{} -| (= n 0) -| [= 4 0] -| #f -| (= n 0) -| [= 3 0] -| #f -| (= n 0) -| [= 2 0] -| #f -| (= n 0) -| [= 1 0] -| #f -| (= n 0) -| [= 0 0] -| #t -@result{} -24 -@end lisp - - -@node Tracing Compared -@subsubsection Differences Between Old and New Tracing Mechanisms - -The newer tracing mechanism is more general and so more powerful than -the older one: it works for expressions as well as procedure -applications, and it implements the useful @code{trace-subtree} -behaviour as well as the more traditional @code{trace-here}. - -The older mechanism will probably become obsolete eventually, but it's -worth keeping it around for a while until we are sure that the new -mechanism is correct and does what programmers need. - - @c Local Variables: @c TeX-master: "guile.texi" @c End: diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi index 93d0949f8..96273b7d0 100644 --- a/doc/ref/scheme-using.texi +++ b/doc/ref/scheme-using.texi @@ -163,10 +163,10 @@ The interactive debugger is documented further in the following section. @node Interactive Debugger @subsection Using the Interactive Debugger -Guile's interactive debugger is a command line application that accepts -commands from you for examining the stack and, if at a breakpoint, for -continuing program execution in various ways. Unlike in the normal -Guile REPL, commands are typed mostly without parentheses. +Guile's interactive debugger is a command line application that +accepts commands from you for examining the stack and, if stopped at a +trap, for continuing program execution in various ways. Unlike in the +normal Guile REPL, commands are typed mostly without parentheses. When you first enter the debugger, it introduces itself with a message like this: @@ -359,15 +359,17 @@ debugger to continue.) @node Using Guile in Emacs @section Using Guile in Emacs -There are quite a few options for working on Guile Scheme code in -Emacs. The simplest options are to use Emacs's standard -@code{scheme-mode} for editing code, and to run the interpreter when you -need it by typing ``guile'' at the prompt of a @code{*shell*} buffer, -but there are Emacs libraries available which add various bells and -whistles to this. The following diagram shows these libraries and how -they relate to each other, with the arrows indicating ``builds on'' or -``extends''. For example, the Quack library builds on cmuscheme, which -in turn builds on the standard scheme mode. +@cindex GDS +@cindex Emacs +There are several options for working on Guile Scheme code in Emacs. +The simplest are to use Emacs's standard @code{scheme-mode} for +editing code, and to run the interpreter when you need it by typing +``guile'' at the prompt of a @code{*shell*} buffer, but there are +Emacs libraries available which add various bells and whistles to +this. The following diagram shows these libraries and how they relate +to each other, with the arrows indicating ``builds on'' or +``extends''. For example, the Quack library builds on cmuscheme, +which in turn builds on the standard scheme mode. @example scheme @@ -408,25 +410,24 @@ interpreters and remembers which one you used last time; and so on. Quack is available from @uref{http://www.neilvandyke.org/quack}. @dfn{GDS}, written by Neil Jerram, also builds on the scheme/cmuscheme -combination, but with a fundamental change to the way that Scheme code -fragments are sent to the interpreter for evaluation. cmuscheme and -Quack send code fragments to the interpreter's standard input, on the -assumption that the interpreter is expecting to read Scheme expressions -there, and then monitor the interpreter's standard output to infer what -the result of the evaluation is. GDS doesn't use standard input and +combination, but with a change to the way that Scheme code fragments +are sent to the interpreter for evaluation. cmuscheme and Quack send +code fragments to the interpreter's standard input, on the assumption +that the interpreter is expecting to read Scheme expressions there, +and then monitor the interpreter's standard output to infer what the +result of the evaluation is. GDS doesn't use standard input and output like this. Instead, it sets up a socket connection between the Scheme interpreter and Emacs, and sends and receives messages using a simple protocol through this socket. The messages include requests to evaluate Scheme code, and responses conveying the results of an -evaluation, thus providing similar function to cmuscheme or Quack. They -also include requests for setting breakpoints, stack exploration and -debugging, which go beyond what cmuscheme or Quack can do. The price of -this extra power, however, is that GDS is Guile-specific. GDS requires -the Scheme interpreter, or any program that GDS is debugging, to run -some GDS-specific library code; currently this code is written as a -Guile module and uses a lot of debugging-related features that are +evaluation, thus providing similar function to cmuscheme or Quack. +They also include requests for stack exploration and debugging, which +go beyond what cmuscheme or Quack can do. The price of this extra +power, however, is that GDS is Guile-specific. GDS requires the +Scheme interpreter to run some GDS-specific library code; currently +this code is written as a Guile module and uses features that are specific to Guile. GDS is now included in the Guile distribution; for -previous Guile releases (1.8.x and earlier) it can be obtained as part +previous Guile releases (1.8.4 and earlier) it can be obtained as part of the @code{guile-debugging} package from @uref{http://www.ossau.uklinux.net/guile}. @@ -540,7 +541,7 @@ Emacs. This code, consisting of the installed files @file{gds.el} and @file{gds-server.el}, is responsible for displaying information from Guile in Emacs windows, and for responding to Emacs commands and keystrokes by sending instructions back to the Guile program being -debugged. +worked on. @item The GDS @dfn{server} code is written in Scheme and runs as an Emacs @@ -584,12 +585,12 @@ The data exchanged between client and server components, and between server and interface, is a sequence of sexps (parenthesised expressions) that are designed so as to be directly readable by both Scheme and Emacs Lisp. The use of a TCP connection means that the server and Emacs -interface can theoretically be on a different computer from the programs -being debugged, but in practice there are currently two problems with +interface can theoretically be on a different computer from the client +programs, but in practice there are currently two problems with this. Firstly the GDS API doesn't provide any way of specifying a non-local server to connect to, and secondly there is no security or authentication mechanism in the GDS protocol. These are issues that -should be addressed in the near future. +should be addressed in the future. @node GDS Getting Started @@ -620,7 +621,7 @@ and the @code{gds-debug} buffer will contain a Scheme backtrace ending with the message: @lisp -no code for module (ossau gds-server) +no code for module (ice-9 gds-server) @end lisp @noindent @@ -645,10 +646,10 @@ Emacs to open the file @file{gds-tutorial.txt} (which should have been installed as part of Guile, perhaps under @file{/usr/share/doc/guile}), and then follow the steps in that file. -When you want to use GDS to explore or debug an independent Guile +When you want to use GDS to work on an independent Guile application, you need to add something to that application's Scheme code to cause it to connect to and interact with GDS at the right times. The -following subsections describe the various ways of doing this. +following subsections describe the ways of doing this. @subsubsection Setting Specific Breakpoints @@ -667,10 +668,10 @@ the following. @end lisp @noindent -The @code{#:behaviour gds-debug-trap} clauses mean to use GDS to display -the stack when one of these breakpoints is hit. For more on -breakpoints, @code{break-in} and @code{break-at}, see @ref{Intro to -Breakpoints}. +The @code{#:behaviour gds-debug-trap} clauses mean to use GDS to +display the stack when one of these breakpoints is hit. For more on +breakpoints, @code{break-in} and @code{break-at}, see +@ref{Breakpoints}. @subsubsection Setting GDS-managed Breakpoints @@ -723,7 +724,7 @@ is pre-1.8) around the code of interest like this: (gds-debug-trap (throw->trap-context key args)))) @end lisp -In all cases you will need to use the @code{(ice-9 gds-client)} and +Either way, you will need to use the @code{(ice-9 gds-client)} and @code{(ice-9 debugging traps)} modules. Two special cases of this are the lazy-catch that the Guile REPL code @@ -738,7 +739,6 @@ procedure as follows. @lisp (use-modules (ice-9 gds-client) (ice-9 debugging traps)) - (on-lazy-handler-dispatch gds-debug-trap) @end lisp @@ -787,16 +787,12 @@ This approach is not yet implemented, though. @subsubsection Utility Guile Implementation -We conclude this subsection with an aside, by noting that the -``utility'' Guile client described above is nothing more than a -combination of the previous options. - -To be precise, the code for the utility Guile client is essentially just -this: +The ``utility'' Guile client mentioned above is a simple combination +of the mechanisms that we have just described. In fact the code for +the utility Guile client is essentially just this: @lisp (use-modules (ice-9 gds-client)) - (set-gds-breakpoints) (named-module-use! '(guile-user) '(ice-9 session)) (gds-accept-input #f)) @@ -805,17 +801,22 @@ this: @code{set-gds-breakpoints} works as already described. The @code{named-module-use!} line ensures that the client can process @code{help} and @code{apropos} expressions, to implement lookups in -Guile's online help. The @code{#f} parameter to @code{gds-accept-input} -means that the @code{continue} instruction will not cause the -instruction loop to exit, which makes sense here because the utility -client has nothing to do except to process GDS instructions. - -(The utility client does not use @code{on-lazy-handler-dispatch}, -because it has its own mechanism for catching and reporting exceptions -in the code that it is asked to evaluate. This mechanism summarizes the -exception and gives the user a button they can click to see the full -stack, so the end result is very similar to what -@code{on-lazy-handler-dispatch} provides.) +Guile's online help. The @code{#f} parameter to +@code{gds-accept-input} means that the @code{continue} instruction +will not cause the instruction loop to exit, which makes sense here +because the utility client has nothing to do except to process GDS +instructions. + +The utility client does not use @code{on-lazy-handler-dispatch} at its +top level, because it has its own mechanism for catching and reporting +exceptions in the code that it is asked to evaluate. This mechanism +summarizes the exception and gives the user a button they can click to +see the full stack, so the end result is very similar to what +@code{on-lazy-handler-dispatch} provides. Deep inside +@code{gds-accept-input}, in the part that handles evaluating +expressions from Emacs, the GDS client code uses +@code{throw->trap-context} and @code{gds-debug-trap} to implement +this. @node Working with GDS in Scheme Buffers @@ -850,7 +851,7 @@ or before the cursor but can also be entered or edited in the minibuffer. The available help is popped up in a temporary Emacs window. -@item C-h C-g +@item C-h G @findex gds-apropos List all accessible Guile symbols matching a given regular expression, with the same results as if you had typed @code{(apropos REGEXP)} into @@ -987,6 +988,14 @@ region contains a balanced expression, or try to expand the region so that it does; it uses the region exactly as it is. @end table +If you type @kbd{C-u} before one of these commands, GDS will +immediately pop up a Scheme stack buffer, showing the requested +evaluation, so that you can single step through it. (This is achieved +by setting a @code{<source-trap>} trap at the start of the requested +evaluation; see @ref{Source Traps} for more on how those work.) The +Scheme stack display, and the options for continuing through the code, +are described in the next two sections. + @node Displaying the Scheme Stack @subsection Displaying the Scheme Stack @@ -1211,35 +1220,9 @@ display in action. To do this add @noindent to your @file{testgds.scm} buffer and type @kbd{C-x C-e} (which -evaluates the expression that the cursor is just after the end of). The -result is: - -@lisp -(fact1 4) - -;;; Evaluating in current module (guile-user) - @result{} 24 - ---:** *Guile Evaluation* (Scheme:ready)--All------------ -@end lisp - -@noindent -which is correct, but indicates that we forgot the step needed to enable -the trap mechanism. To do this, type @kbd{C-c C-e} and then enter - -@lisp -(trap-enable 'traps) -@end lisp - -@noindent -into the minibuffer. (You could equally have typed this into your test -file and evaluated it from there; we use @kbd{C-c C-e} here to -demonstrate the minibuffer option and because you typically wouldn't -want to leave this kind of global setting in the source code that you -are working on.) - -If you now type @kbd{C-x C-e} to evaluate @code{(fact1 4)} again, a GDS -stack window like the following appears: +evaluates the expression that the cursor is just after the end of). +The result should be that a GDS stack window like the following +appears: @lisp Calling procedure: @@ -1250,19 +1233,10 @@ Calling procedure: --:** PID 28729 (Guile-Debug)--All------------ @end lisp -GDS's most compelling feature is its single-stepping. To get an -immediate feel for what this is like, make sure your Emacs is prepared -as described in @ref{GDS Getting Started}, then type the following code -into an interactive Guile session. - -@lisp -(fact1 4) -@end lisp - -@noindent -This will cause the GDS Guile-Debug window to pop up in Emacs, where -you can then press @kbd{i} once and @kbd{@key{SPC}} repeatedly to -single-step through the code from the point of the initial trap. +This stack tells you that Guile is about to call the @code{fact1} +procedure, with argument 4, and you can step through this call in +detail by pressing @kbd{i} once and then @kbd{@key{SPC}} +(@pxref{Continuing Execution}). (@kbd{i} is needed as the first keystroke rather than @kbd{@key{SPC}}, because the aim here is to step through code in the @code{(ice-9 diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index cacd769c2..b1fdde1c3 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -34,6 +34,7 @@ get the relevant SRFI documents from the SRFI home page * SRFI-14:: Character-set library. * SRFI-16:: case-lambda * SRFI-17:: Generalized set! +* SRFI-18:: Multithreading support * SRFI-19:: Time/Date library. * SRFI-26:: Specializing parameters * SRFI-31:: A special form `rec' for recursive evaluation @@ -44,6 +45,8 @@ get the relevant SRFI documents from the SRFI home page * SRFI-55:: Requiring Features. * SRFI-60:: Integers as bits. * SRFI-61:: A more general `cond' clause +* SRFI-69:: Basic hash tables. +* SRFI-88:: Keyword objects. @end menu @@ -1676,6 +1679,344 @@ The same as the Guile core @code{make-procedure-with-setter} @end defun +@node SRFI-18 +@subsection SRFI-18 - Multithreading support +@cindex SRFI-18 + +This is an implementation of the SRFI-18 threading and synchronization +library. The functions and variables described here are provided by + +@example +(use-modules (srfi srfi-18)) +@end example + +As a general rule, the data types and functions in this SRFI-18 +implementation are compatible with the types and functions in Guile's +core threading code. For example, mutexes created with the SRFI-18 +@code{make-mutex} function can be passed to the built-in Guile +function @code{lock-mutex} (@pxref{Mutexes and Condition Variables}), +and mutexes created with the built-in Guile function @code{make-mutex} +can be passed to the SRFI-18 function @code{mutex-lock!}. Cases in +which this does not hold true are noted in the following sections. + +@menu +* SRFI-18 Threads:: Executing code +* SRFI-18 Mutexes:: Mutual exclusion devices +* SRFI-18 Condition variables:: Synchronizing of groups of threads +* SRFI-18 Time:: Representation of times and durations +* SRFI-18 Exceptions:: Signalling and handling errors +@end menu + +@node SRFI-18 Threads +@subsubsection SRFI-18 Threads + +Threads created by SRFI-18 differ in two ways from threads created by +Guile's built-in thread functions. First, a thread created by SRFI-18 +@code{make-thread} begins in a blocked state and will not start +execution until @code{thread-start!} is called on it. Second, SRFI-18 +threads are constructed with a top-level exception handler that +captures any exceptions that are thrown on thread exit. In all other +regards, SRFI-18 threads are identical to normal Guile threads. + +@defun current-thread +Returns the thread that called this function. This is the same +procedure as the same-named built-in procedure @code{current-thread} +(@pxref{Threads}). +@end defun + +@defun thread? obj +Returns @code{#t} if @var{obj} is a thread, @code{#f} otherwise. This +is the same procedure as the same-named built-in procedure +@code{thread?} (@pxref{Threads}). +@end defun + +@defun make-thread thunk [name] +Call @code{thunk} in a new thread and with a new dynamic state, +returning the new thread and optionally assigning it the object name +@var{name}, which may be any Scheme object. + +Note that the name @code{make-thread} conflicts with the +@code{(ice-9 threads)} function @code{make-thread}. Applications +wanting to use both of these functions will need to refer to them by +different names. +@end defun + +@defun thread-name thread +Returns the name assigned to @var{thread} at the time of its creation, +or @code{#f} if it was not given a name. +@end defun + +@defun thread-specific thread +@defunx thread-specific-set! thread obj +Get or set the ``object-specific'' property of @var{thread}. In +Guile's implementation of SRFI-18, this value is stored as an object +property, and will be @code{#f} if not set. +@end defun + +@defun thread-start! thread +Unblocks @var{thread} and allows it to begin execution if it has not +done so already. +@end defun + +@defun thread-yield! +If one or more threads are waiting to execute, calling +@code{thread-yield!} forces an immediate context switch to one of them. +Otherwise, @code{thread-yield!} has no effect. @code{thread-yield!} +behaves identically to the Guile built-in function @code{yield}. +@end defun + +@defun thread-sleep! timeout +The current thread waits until the point specified by the time object +@var{timeout} is reached (@pxref{SRFI-18 Time}). This blocks the +thread only if @var{timeout} represents a point in the future. it is +an error for @var{timeout} to be @code{#f}. +@end defun + +@defun thread-terminate! thread +Causes an abnormal termination of @var{thread}. If @var{thread} is +not already terminated, all mutexes owned by @var{thread} become +unlocked/abandoned. If @var{thread} is the current thread, +@code{thread-terminate!} does not return. Otherwise +@code{thread-terminate!} returns an unspecified value; the termination +of @var{thread} will occur before @code{thread-terminate!} returns. +Subsequent attempts to join on @var{thread} will cause a ``terminated +thread exception'' to be raised. + +@code{thread-terminate!} is compatible with the thread cancellation +procedures in the core threads API (@pxref{Threads}) in that if a +cleanup handler has been installed for the target thread, it will be +called before the thread exits and its return value (or exception, if +any) will be stored for later retrieval via a call to +@code{thread-join!}. +@end defun + +@defun thread-join! thread [timeout [timeout-val]] +Wait for @var{thread} to terminate and return its exit value. When a +time value @var{timeout} is given, it specifies a point in time where +the waiting should be aborted. When the waiting is aborted, +@var{timeoutval} is returned if it is specified; otherwise, a +@code{join-timeout-exception} exception is raised +(@pxref{SRFI-18 Exceptions}). Exceptions may also be raised if the +thread was terminated by a call to @code{thread-terminate!} +(@code{terminated-thread-exception} will be raised) or if the thread +exited by raising an exception that was handled by the top-level +exception handler (@code{uncaught-exception} will be raised; the +original exception can be retrieved using +@code{uncaught-exception-reason}). +@end defun + + +@node SRFI-18 Mutexes +@subsubsection SRFI-18 Mutexes + +The behavior of Guile's built-in mutexes is parameterized via a set of +flags passed to the @code{make-mutex} procedure in the core +(@pxref{Mutexes and Condition Variables}). To satisfy the requirements +for mutexes specified by SRFI-18, the @code{make-mutex} procedure +described below sets the following flags: +@itemize @bullet +@item +@code{recursive}: the mutex can be locked recursively +@item +@code{unchecked-unlock}: attempts to unlock a mutex that is already +unlocked will not raise an exception +@item +@code{allow-external-unlock}: the mutex can be unlocked by any thread, +not just the thread that locked it originally +@end itemize + +@defun make-mutex [name] +Returns a new mutex, optionally assigning it the object name +@var{name}, which may be any Scheme object. The returned mutex will be +created with the configuration described above. Note that the name +@code{make-mutex} conflicts with Guile core function @code{make-mutex}. +Applications wanting to use both of these functions will need to refer +to them by different names. +@end defun + +@defun mutex-name mutex +Returns the name assigned to @var{mutex} at the time of its creation, +or @code{#f} if it was not given a name. +@end defun + +@defun mutex-specific mutex +@defunx mutex-specific-set! mutex obj +Get or set the ``object-specific'' property of @var{mutex}. In Guile's +implementation of SRFI-18, this value is stored as an object property, +and will be @code{#f} if not set. +@end defun + +@defun mutex-state mutex +Returns information about the state of @var{mutex}. Possible values +are: +@itemize @bullet +@item +thread @code{T}: the mutex is in the locked/owned state and thread T +is the owner of the mutex +@item +symbol @code{not-owned}: the mutex is in the locked/not-owned state +@item +symbol @code{abandoned}: the mutex is in the unlocked/abandoned state +@item +symbol @code{not-abandoned}: the mutex is in the +unlocked/not-abandoned state +@end itemize +@end defun + +@defun mutex-lock! mutex [timeout [thread]] +Lock @var{mutex}, optionally specifying a time object @var{timeout} +after which to abort the lock attempt and a thread @var{thread} giving +a new owner for @var{mutex} different than the current thread. This +procedure has the same behavior as the @code{lock-mutex} procedure in +the core library. +@end defun + +@defun mutex-unlock! mutex [condition-variable [timeout]] +Unlock @var{mutex}, optionally specifying a condition variable +@var{condition-variable} on which to wait, either indefinitely or, +optionally, until the time object @var{timeout} has passed, to be +signalled. This procedure has the same behavior as the +@code{unlock-mutex} procedure in the core library. +@end defun + + +@node SRFI-18 Condition variables +@subsubsection SRFI-18 Condition variables + +SRFI-18 does not specify a ``wait'' function for condition variables. +Waiting on a condition variable can be simulated using the SRFI-18 +@code{mutex-unlock!} function described in the previous section, or +Guile's built-in @code{wait-condition-variable} procedure can be used. + +@defun condition-variable? obj +Returns @code{#t} if @var{obj} is a condition variable, @code{#f} +otherwise. This is the same procedure as the same-named built-in +procedure +(@pxref{Mutexes and Condition Variables, @code{condition-variable?}}). +@end defun + +@defun make-condition-variable [name] +Returns a new condition variable, optionally assigning it the object +name @var{name}, which may be any Scheme object. This procedure +replaces a procedure of the same name in the core library. +@end defun + +@defun condition-variable-name condition-variable +Returns the name assigned to @var{thread} at the time of its creation, +or @code{#f} if it was not given a name. +@end defun + +@defun condition-variable-specific condition-variable +@defunx condition-variable-specific-set! condition-variable obj +Get or set the ``object-specific'' property of +@var{condition-variable}. In Guile's implementation of SRFI-18, this +value is stored as an object property, and will be @code{#f} if not +set. +@end defun + +@defun condition-variable-signal! condition-variable +@defunx condition-variable-broadcast! condition-variable +Wake up one thread that is waiting for @var{condition-variable}, in +the case of @code{condition-variable-signal!}, or all threads waiting +for it, in the case of @code{condition-variable-broadcast!}. The +behavior of these procedures is equivalent to that of the procedures +@code{signal-condition-variable} and +@code{broadcast-condition-variable} in the core library. +@end defun + + +@node SRFI-18 Time +@subsubsection SRFI-18 Time + +The SRFI-18 time functions manipulate time in two formats: a +``time object'' type that represents an absolute point in time in some +implementation-specific way; and the number of seconds since some +unspecified ``epoch''. In Guile's implementation, the epoch is the +Unix epoch, 00:00:00 UTC, January 1, 1970. + +@defun current-time +Return the current time as a time object. This procedure replaces +the procedure of the same name in the core library, which returns the +current time in seconds since the epoch. +@end defun + +@defun time? obj +Returns @code{#t} if @var{obj} is a time object, @code{#f} otherwise. +@end defun + +@defun time->seconds time +@defunx seconds->time seconds +Convert between time objects and numerical values representing the +number of seconds since the epoch. When converting from a time object +to seconds, the return value is the number of seconds between +@var{time} and the epoch. When converting from seconds to a time +object, the return value is a time object that represents a time +@var{seconds} seconds after the epoch. +@end defun + + +@node SRFI-18 Exceptions +@subsubsection SRFI-18 Exceptions + +SRFI-18 exceptions are identical to the exceptions provided by +Guile's implementation of SRFI-34. The behavior of exception +handlers invoked to handle exceptions thrown from SRFI-18 functions, +however, differs from the conventional behavior of SRFI-34 in that +the continuation of the handler is the same as that of the call to +the function. Handlers are called in a tail-recursive manner; the +exceptions do not ``bubble up''. + +@defun current-exception-handler +Returns the current exception handler. +@end defun + +@defun with-exception-handler handler thunk +Installs @var{handler} as the current exception handler and calls the +procedure @var{thunk} with no arguments, returning its value as the +value of the exception. @var{handler} must be a procedure that accepts +a single argument. The current exception handler at the time this +procedure is called will be restored after the call returns. +@end defun + +@defun raise obj +Raise @var{obj} as an exception. This is the same procedure as the +same-named procedure defined in SRFI 34. +@end defun + +@defun join-timeout-exception? obj +Returns @code{#t} if @var{obj} is an exception raised as the result of +performing a timed join on a thread that does not exit within the +specified timeout, @code{#f} otherwise. +@end defun + +@defun abandoned-mutex-exception? obj +Returns @code{#t} if @var{obj} is an exception raised as the result of +attempting to lock a mutex that has been abandoned by its owner thread, +@code{#f} otherwise. +@end defun + +@defun terminated-thread-exception? obj +Returns @code{#t} if @var{obj} is an exception raised as the result of +joining on a thread that exited as the result of a call to +@code{thread-terminate!}. +@end defun + +@defun uncaught-exception? obj +@defunx uncaught-exception-reason exc +@code{uncaught-exception?} returns @code{#t} if @var{obj} is an +exception thrown as the result of joining a thread that exited by +raising an exception that was handled by the top-level exception +handler installed by @code{make-thread}. When this occurs, the +original exception is preserved as part of the exception thrown by +@code{thread-join!} and can be accessed by calling +@code{uncaught-exception-reason} on that exception. Note that +because this exception-preservation mechanism is a side-effect of +@code{make-thread}, joining on threads that exited as described above +but were created by other means will not raise this +@code{uncaught-exception} error. +@end defun + + @node SRFI-19 @subsection SRFI-19 - Time/Date Library @cindex SRFI-19 @@ -1843,8 +2184,10 @@ Return the current time of the given @var{type}. The default @var{type} is @code{time-utc}. Note that the name @code{current-time} conflicts with the Guile core -@code{current-time} function (@pxref{Time}). Applications wanting to -use both will need to use a different name for one of them. +@code{current-time} function (@pxref{Time}) as well as the SRFI-18 +@code{current-time} function (@pxref{SRFI-18 Time}). Applications +wanting to use more than one of these functions will need to refer to +them by different names. @end defun @defun time-resolution [type] @@ -2470,7 +2813,7 @@ specified by @var{field+value}, a sequence of field names (symbols) and values as in the following example: @lisp -(let* ((&ct (make-condition-type 'foo &condition '(a b c)))) +(let ((&ct (make-condition-type 'foo &condition '(a b c)))) (make-condition &ct 'a 1 'b 2 'c 3)) @end lisp @@ -3027,6 +3370,245 @@ needed to get SRFI-61 itself. Extended @code{cond} is documented in @ref{if cond case,, Simple Conditional Evaluation}. +@node SRFI-69 +@subsection SRFI-69 - Basic hash tables +@cindex SRFI-69 + +This is a portable wrapper around Guile's built-in hash table and weak +table support. @xref{Hash Tables}, for information on that built-in +support. Above that, this hash-table interface provides association +of equality and hash functions with tables at creation time, so +variants of each function are not required, as well as a procedure +that takes care of most uses for Guile hash table handles, which this +SRFI does not provide as such. + +Access it with: + +@lisp +(use-modules (srfi srfi-69)) +@end lisp + +@menu +* SRFI-69 Creating hash tables:: +* SRFI-69 Accessing table items:: +* SRFI-69 Table properties:: +* SRFI-69 Hash table algorithms:: +@end menu + +@node SRFI-69 Creating hash tables +@subsubsection Creating hash tables + +@deffn {Scheme Procedure} make-hash-table [equal-proc hash-proc #:weak weakness start-size] +Create and answer a new hash table with @var{equal-proc} as the +equality function and @var{hash-proc} as the hashing function. + +By default, @var{equal-proc} is @code{equal?}. It can be any +two-argument procedure, and should answer whether two keys are the +same for this table's purposes. + +My default @var{hash-proc} assumes that @code{equal-proc} is no +coarser than @code{equal?} unless it is literally @code{string-ci=?}. +If provided, @var{hash-proc} should be a two-argument procedure that +takes a key and the current table size, and answers a reasonably good +hash integer between 0 (inclusive) and the size (exclusive). + +@var{weakness} should be @code{#f} or a symbol indicating how ``weak'' +the hash table is: + +@table @code +@item #f +An ordinary non-weak hash table. This is the default. + +@item key +When the key has no more non-weak references at GC, remove that entry. + +@item value +When the value has no more non-weak references at GC, remove that +entry. + +@item key-or-value +When either has no more non-weak references at GC, remove the +association. +@end table + +As a legacy of the time when Guile couldn't grow hash tables, +@var{start-size} is an optional integer argument that specifies the +approximate starting size for the hash table, which will be rounded to +an algorithmically-sounder number. +@end deffn + +By @dfn{coarser} than @code{equal?}, we mean that for all @var{x} and +@var{y} values where @code{(@var{equal-proc} @var{x} @var{y})}, +@code{(equal? @var{x} @var{y})} as well. If that does not hold for +your @var{equal-proc}, you must provide a @var{hash-proc}. + +In the case of weak tables, remember that @dfn{references} above +always refers to @code{eq?}-wise references. Just because you have a +reference to some string @code{"foo"} doesn't mean that an association +with key @code{"foo"} in a weak-key table @emph{won't} be collected; +it only counts as a reference if the two @code{"foo"}s are @code{eq?}, +regardless of @var{equal-proc}. As such, it is usually only sensible +to use @code{eq?} and @code{hashq} as the equivalence and hash +functions for a weak table. @xref{Weak References}, for more +information on Guile's built-in weak table support. + +@deffn {Scheme Procedure} alist->hash-table alist [equal-proc hash-proc #:weak weakness start-size] +As with @code{make-hash-table}, but initialize it with the +associations in @var{alist}. Where keys are repeated in @var{alist}, +the leftmost association takes precedence. +@end deffn + +@node SRFI-69 Accessing table items +@subsubsection Accessing table items + +@deffn {Scheme Procedure} hash-table-ref table key [default-thunk] +@deffnx {Scheme Procedure} hash-table-ref/default table key default +Answer the value associated with @var{key} in @var{table}. If +@var{key} is not present, answer the result of invoking the thunk +@var{default-thunk}, which signals an error instead by default. + +@code{hash-table-ref/default} is a variant that requires a third +argument, @var{default}, and answers @var{default} itself instead of +invoking it. +@end deffn + +@deffn {Scheme Procedure} hash-table-set! table key new-value +Set @var{key} to @var{new-value} in @var{table}. +@end deffn + +@deffn {Scheme Procedure} hash-table-delete! table key +Remove the association of @var{key} in @var{table}, if present. If +absent, do nothing. +@end deffn + +@deffn {Scheme Procedure} hash-table-exists? table key +Answer whether @var{key} has an association in @var{table}. +@end deffn + +@deffn {Scheme Procedure} hash-table-update! table key modifier [default-thunk] +@deffnx {Scheme Procedure} hash-table-update!/default table key modifier default +Replace @var{key}'s associated value in @var{table} by invoking +@var{modifier} with one argument, the old value. + +If @var{key} is not present, and @var{default-thunk} is provided, +invoke it with no arguments to get the ``old value'' to be passed to +@var{modifier} as above. If @var{default-thunk} is not provided in +such a case, signal an error. + +@code{hash-table-update!/default} is a variant that requires the +fourth argument, which is used directly as the ``old value'' rather +than as a thunk to be invoked to retrieve the ``old value''. +@end deffn + +@node SRFI-69 Table properties +@subsubsection Table properties + +@deffn {Scheme Procedure} hash-table-size table +Answer the number of associations in @var{table}. This is guaranteed +to run in constant time for non-weak tables. +@end deffn + +@deffn {Scheme Procedure} hash-table-keys table +Answer an unordered list of the keys in @var{table}. +@end deffn + +@deffn {Scheme Procedure} hash-table-values table +Answer an unordered list of the values in @var{table}. +@end deffn + +@deffn {Scheme Procedure} hash-table-walk table proc +Invoke @var{proc} once for each association in @var{table}, passing +the key and value as arguments. +@end deffn + +@deffn {Scheme Procedure} hash-table-fold table proc init +Invoke @code{(@var{proc} @var{key} @var{value} @var{previous})} for +each @var{key} and @var{value} in @var{table}, where @var{previous} is +the result of the previous invocation, using @var{init} as the first +@var{previous} value. Answer the final @var{proc} result. +@end deffn + +@deffn {Scheme Procedure} hash-table->alist table +Answer an alist where each association in @var{table} is an +association in the result. +@end deffn + +@node SRFI-69 Hash table algorithms +@subsubsection Hash table algorithms + +Each hash table carries an @dfn{equivalence function} and a @dfn{hash +function}, used to implement key lookups. Beginning users should +follow the rules for consistency of the default @var{hash-proc} +specified above. Advanced users can use these to implement their own +equivalence and hash functions for specialized lookup semantics. + +@deffn {Scheme Procedure} hash-table-equivalence-function hash-table +@deffnx {Scheme Procedure} hash-table-hash-function hash-table +Answer the equivalence and hash function of @var{hash-table}, respectively. +@end deffn + +@deffn {Scheme Procedure} hash obj [size] +@deffnx {Scheme Procedure} string-hash obj [size] +@deffnx {Scheme Procedure} string-ci-hash obj [size] +@deffnx {Scheme Procedure} hash-by-identity obj [size] +Answer a hash value appropriate for equality predicate @code{equal?}, +@code{string=?}, @code{string-ci=?}, and @code{eq?}, respectively. +@end deffn + +@code{hash} is a backwards-compatible replacement for Guile's built-in +@code{hash}. + +@node SRFI-88 +@subsection SRFI-88 Keyword Objects +@cindex SRFI-88 +@cindex keyword objects + +@uref{http://srfi.schemers.org/srfi-88/srfi-88.html, SRFI-88} provides +@dfn{keyword objects}, which are equivalent to Guile's keywords +(@pxref{Keywords}). SRFI-88 keywords can be entered using the +@dfn{postfix keyword syntax}, which consists of an identifier followed +by @code{:} (@pxref{Reader options, @code{postfix} keyword syntax}). +SRFI-88 can be made available with: + +@example +(use-modules (srfi srfi-88)) +@end example + +Doing so installs the right reader option for keyword syntax, using +@code{(read-set! keywords 'postfix)}. It also provides the procedures +described below. + +@deffn {Scheme Procedure} keyword? obj +Return @code{#t} if @var{obj} is a keyword. This is the same procedure +as the same-named built-in procedure (@pxref{Keyword Procedures, +@code{keyword?}}). + +@example +(keyword? foo:) @result{} #t +(keyword? 'foo:) @result{} #t +(keyword? "foo") @result{} #f +@end example +@end deffn + +@deffn {Scheme Procedure} keyword->string kw +Return the name of @var{kw} as a string, i.e., without the trailing +colon. The returned string may not be modified, e.g., with +@code{string-set!}. + +@example +(keyword->string foo:) @result{} "foo" +@end example +@end deffn + +@deffn {Scheme Procedure} string->keyword str +Return the keyword object whose name is @var{str}. + +@example +(keyword->string (string->keyword "a b c")) @result{} "a b c" +@end example +@end deffn + + @c srfi-modules.texi ends here @c Local Variables: diff --git a/emacs/ChangeLog b/emacs/ChangeLog index 5a4365ff5..fb9d78999 100644 --- a/emacs/ChangeLog +++ b/emacs/ChangeLog @@ -1,3 +1,9 @@ +2008-07-17 Neil Jerram <neil@ossau.uklinux.net> + + * gds-scheme.el (gds-eval-region, gds-eval-expression) + (gds-eval-defun, gds-eval-last-sexp): Support `C-u' prefix, + meaning that user wants to single step through the code. + 2007-02-06 Clinton Ebadi <clinton@unknownlamer.org> * gds-scheme.el (gds-display-results): Use save-selected-window diff --git a/emacs/gds-scheme.el b/emacs/gds-scheme.el index a03a07ba5..db0e6cd41 100755 --- a/emacs/gds-scheme.el +++ b/emacs/gds-scheme.el @@ -279,9 +279,12 @@ region's code." (setq line (count-lines (point-min) (point)))) (cons line column))) -(defun gds-eval-region (start end) - "Evaluate the current region." - (interactive "r") +(defun gds-eval-region (start end &optional debugp) + "Evaluate the current region. If invoked with `C-u' prefix (or, in +a program, with optional DEBUGP arg non-nil), pause and pop up the +stack at the start of the evaluation, so that the user can single-step +through the code." + (interactive "r\nP") (or gds-client (gds-auto-associate-buffer) (call-interactively 'gds-associate-buffer)) @@ -289,24 +292,29 @@ region's code." (port-name (gds-port-name start end)) (lc (gds-line-and-column start))) (let ((code (buffer-substring-no-properties start end))) - (gds-send (format "eval (region . %S) %s %S %d %d %S" + (gds-send (format "eval (region . %S) %s %S %d %d %S %s" (gds-abbreviated code) (if module (prin1-to-string module) "#f") port-name (car lc) (cdr lc) - code) + code + (if debugp '(debug) '(none))) gds-client)))) -(defun gds-eval-expression (expr &optional correlator) - "Evaluate the supplied EXPR (a string)." - (interactive "sEvaluate expression: \nP") +(defun gds-eval-expression (expr &optional correlator debugp) + "Evaluate the supplied EXPR (a string). If invoked with `C-u' +prefix (or, in a program, with optional DEBUGP arg non-nil), pause and +pop up the stack at the start of the evaluation, so that the user can +single-step through the code." + (interactive "sEvaluate expression: \ni\nP") (or gds-client (gds-auto-associate-buffer) (call-interactively 'gds-associate-buffer)) (set-text-properties 0 (length expr) nil expr) - (gds-send (format "eval (%S . %S) #f \"Emacs expression\" 0 0 %S" + (gds-send (format "eval (%S . %S) #f \"Emacs expression\" 0 0 %S %s" (or correlator 'expression) (gds-abbreviated expr) - expr) + expr + (if debugp '(debug) '(none))) gds-client)) (defconst gds-abbreviated-length 35) @@ -325,19 +333,25 @@ region's code." (concat (substring code 0 (- gds-abbreviated-length 3)) "...") code)) -(defun gds-eval-defun () - "Evaluate the defun (top-level form) at point." - (interactive) +(defun gds-eval-defun (&optional debugp) + "Evaluate the defun (top-level form) at point. If invoked with +`C-u' prefix (or, in a program, with optional DEBUGP arg non-nil), +pause and pop up the stack at the start of the evaluation, so that the +user can single-step through the code." + (interactive "P") (save-excursion (end-of-defun) (let ((end (point))) (beginning-of-defun) - (gds-eval-region (point) end)))) - -(defun gds-eval-last-sexp () - "Evaluate the sexp before point." - (interactive) - (gds-eval-region (save-excursion (backward-sexp) (point)) (point))) + (gds-eval-region (point) end debugp)))) + +(defun gds-eval-last-sexp (&optional debugp) + "Evaluate the sexp before point. If invoked with `C-u' prefix (or, +in a program, with optional DEBUGP arg non-nil), pause and pop up the +stack at the start of the evaluation, so that the user can single-step +through the code." + (interactive "P") + (gds-eval-region (save-excursion (backward-sexp) (point)) (point) debugp)) ;;;; Help. diff --git a/examples/ChangeLog b/examples/ChangeLog index db8e0ec2f..0dd9620d0 100644 --- a/examples/ChangeLog +++ b/examples/ChangeLog @@ -1,3 +1,7 @@ +2008-01-22 Neil Jerram <neil@ossau.uklinux.net> + + * compat/compat.h: Update copyright statement to LGPL. + 2002-11-17 Mikael Djurfeldt <mdj@linnaeus> * README: Added description of compat. diff --git a/examples/compat/compat.h b/examples/compat/compat.h index 7c6d2aa71..5ed11eff9 100644 --- a/examples/compat/compat.h +++ b/examples/compat/compat.h @@ -2,46 +2,22 @@ #ifndef COMPATH #define COMPATH -/* Copyright (C) 2001, 2002, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2002, 2006, 2008 Free Software Foundation, Inc. * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301 USA - * - * As a special exception, the Free Software Foundation gives permission - * for additional uses of the text contained in its release of GUILE. + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. * - * The exception is that, if you link the GUILE library with other files - * to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the GUILE library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the - * Free Software Foundation under the name GUILE. If you copy - * code from other Free Software Foundation releases into a copy of - * GUILE, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. * - * If you write modifications of your own for GUILE, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. */ + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + */ #ifndef SCM_GC8MARKP diff --git a/guile-1.8.pc.in b/guile-1.8.pc.in new file mode 100644 index 000000000..15c83d84b --- /dev/null +++ b/guile-1.8.pc.in @@ -0,0 +1,15 @@ +prefix=@prefix@ +exec_prefix=@exec_prefix@ +libdir=@libdir@ +includedir=@includedir@ +datarootdir=@datarootdir@ +datadir=@datadir@ + +sitedir=@sitedir@ +libguileinterface=@LIBGUILE_INTERFACE@ + +Name: GNU Guile +Description: GNU's Ubiquitous Intelligent Language for Extension +Version: @GUILE_VERSION@ +Libs: -L${libdir} -lguile @GUILE_LIBS@ +Cflags: -I${includedir} @GUILE_CFLAGS@ diff --git a/guile-config/COPYING b/guile-config/COPYING deleted file mode 100644 index e69de29bb..000000000 --- a/guile-config/COPYING +++ /dev/null diff --git a/guile-config/ChangeLog b/guile-config/ChangeLog index 6156dc812..d450f2536 100644 --- a/guile-config/ChangeLog +++ b/guile-config/ChangeLog @@ -1,3 +1,16 @@ +2008-06-02 Ludovic Courtès <ludo@gnu.org> + + * guile-config.in (build-link): Show `-L' before `-lguile'. + Reported by Peter O'Gorman <pogma@thewrittenword.com>. + +2008-01-22 Neil Jerram <neil@ossau.uklinux.net> + + * COPYING: Removed. + +2007-12-30 Mike Gran <spk121@yahoo.com> + + * guile.m4: add serial number to m4 + 2007-01-04 Kevin Ryde <user42@zip.com.au> * Makefile.am (guile-config): Use "|" as the sed delimiter, for the diff --git a/guile-config/guile-config.in b/guile-config/guile-config.in index e5687da46..b782292d8 100644 --- a/guile-config/guile-config.in +++ b/guile-config/guile-config.in @@ -4,7 +4,7 @@ ;;;; guile-config --- utility for linking programs with Guile ;;;; Jim Blandy <jim@red-bean.com> --- September 1997 ;;;; -;;;; Copyright (C) 1998, 2001, 2004, 2005, 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 1998, 2001, 2004, 2005, 2006, 2008 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 @@ -151,11 +151,11 @@ (display (string-join (list (get-build-info 'CFLAGS) - "-lguile -lltdl" (if (or (string=? libdir "/usr/lib") (string=? libdir "/usr/lib/")) "" (string-append "-L" (get-build-info 'libdir))) + "-lguile -lltdl" (string-join other-flags) ))) diff --git a/guile-config/guile.m4 b/guile-config/guile.m4 index fc248843d..bcded2bdc 100644 --- a/guile-config/guile.m4 +++ b/guile-config/guile.m4 @@ -16,6 +16,8 @@ ## License along with this library; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA +# serial 9 + ## Index ## ----- ## diff --git a/guile-config/qthreads.m4 b/guile-config/qthreads.m4 deleted file mode 100644 index 8aeba1748..000000000 --- a/guile-config/qthreads.m4 +++ /dev/null @@ -1,165 +0,0 @@ -dnl Autoconf macros for configuring the QuickThreads package -dnl Jim Blandy <jimb@red-bean.com> --- July 1998 -dnl -dnl Copyright (C) 1998, 1999, 2006 Free Software Foundation, Inc. -dnl -dnl This file is part of GUILE. -dnl -dnl GUILE is free software; you can redistribute it and/or modify -dnl it under the terms of the GNU General Public License as -dnl published by the Free Software Foundation; either version 2, or -dnl (at your option) any later version. -dnl -dnl GUILE is distributed in the hope that it will be useful, but -dnl WITHOUT ANY WARRANTY; without even the implied warranty of -dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -dnl GNU General Public License for more details. -dnl -dnl You should have received a copy of the GNU General Public -dnl License along with GUILE; see the file COPYING. If not, write -dnl to the Free Software Foundation, Inc., 51 Franklin Street, Fifth -dnl Floor, Boston, MA 02110-1301 USA - - - -dnl QTHREADS_CONFIGURE configures the QuickThreads package. The QT -dnl sources should be in $srcdir/qt. If configuration succeeds, this -dnl macro creates the appropriate symlinks in the qt object directory, -dnl and sets the following variables, used in building libqthreads.a: -dnl QTHREAD_LTLIBS --- set to libqthreads.la if configuration -dnl succeeds, or the empty string if configuration fails. -dnl qtmd_h, qtmds_s, qtmdc_c, qtdmdb_s --- the names of the machine- -dnl dependent source files. -dnl qthread_asflags --- flags to pass to the compiler when processing -dnl assembly-language files. -dnl -dnl It also sets the following variables, which describe how clients -dnl can link against libqthreads.a: -dnl THREAD_PACKAGE --- set to "QT" if configuration succeeds, or -dnl the empty string if configuration fails. -dnl THREAD_LIBS_LOCAL --- linker options for use in this source tree -dnl THREAD_LIBS_INSTALLED --- linker options for use after this package -dnl is installed -dnl It would be nice if all thread configuration packages for Guile -dnl followed the same conventions. -dnl -dnl All of the above variables will be substituted into Makefiles in -dnl the usual autoconf fashion. -dnl -dnl We distinguish between THREAD_LIBS_LOCAL and -dnl THREAD_LIBS_INSTALLED because the thread library might be in -dnl this tree, and be built using libtool. This means that: -dnl 1) when building other executables in this tree, one must -dnl pass the relative path to the ../libfoo.la file, but -dnl 2) once the whole package has been installed, users should -dnl link using -lfoo. -dnl Normally, we only care about the first case, but since the -dnl guile-config script needs to give users all the flags they need -dnl to link programs against guile, the GUILE_WITH_THREADS macro -dnl needs to supply the second piece of information as well. -dnl -dnl This whole thing is a little confused about what ought to be -dnl done in the top-level configure script, and what ought to be -dnl taken care of in the subdirectory. For example, qtmds_s and -dnl friends really ought not to be even mentioned in the top-level -dnl configure script, but here they are. - -AC_DEFUN([QTHREADS_CONFIGURE],[ - AC_REQUIRE([AC_PROG_LN_S]) - - AC_MSG_CHECKING(QuickThreads configuration) - - changequote(,)dnl We use [ and ] in a regexp in the case - - THREAD_PACKAGE=QT - qthread_asflags='' - case "$host" in - i[3456]86-*-*) - port_name=i386 - qtmd_h=md/i386.h - qtmds_s=md/i386.s - qtmdc_c=md/null.c - qtdmdb_s= - case "$host" in - *-*-netbsd* ) - ## NetBSD needs to be told to pass the assembly code through - ## the C preprocessor. Other GCC installations seem to do - ## this by default, but NetBSD's doesn't. We could get the - ## same effect by giving the file a name ending with .S - ## instead of .s, but I don't see how to tell automake to do - ## that. - qthread_asflags='-x assembler-with-cpp' - ;; - esac - ;; - mips-sgi-irix[56]*) - port_name=irix - qtmd_h=md/mips.h - qtmds_s=md/mips-irix5.s - qtmdc_c=md/null.c - qtdmdb_s=md/mips_b.s - ;; - mips-*-*) - port_name=mips - qtmd_h=md/mips.h - qtmds_s=md/mips.s - qtmdc_c=md/null.c - qtdmdb_s=md/mips_b.s - ;; - sparc-*-sunos*) - port_name=sparc-sunos - qtmd_h=md/sparc.h - qtmds_s=md/_sparc.s - qtmdc_c=md/null.c - qtdmdb_s=md/_sparc_b.s - ;; - sparc*-*-*) - port_name=sparc - qtmd_h=md/sparc.h - qtmds_s=md/sparc.s - qtmdc_c=md/null.c - qtdmdb_s=md/sparc_b.s - ;; - alpha*-*-*) - port_name=alpha - qtmd_h=md/axp.h - qtmds_s=md/axp.s - qtmdc_c=md/null.c - qtdmdb_s=md/axp_b.s - ;; - arm*-*-*) - port_name=arm - qtmd_h=md/arm.h - qtmds_s=md/arm.s - qtmdc_c=md/null.c - qtdmdb_s= - ;; - *) - echo "Unknown configuration; threads package disabled" - THREAD_PACKAGE="" - ;; - esac - changequote([, ]) - - # Did configuration succeed? - if test -n "$THREAD_PACKAGE"; then - AC_MSG_RESULT($port_name) - QTHREAD_LTLIBS=libqthreads.la - THREAD_LIBS_LOCAL="../qt/libqthreads.la" - THREAD_LIBS_INSTALLED="-lqthreads" - else - AC_MSG_RESULT(none; disabled) - fi - - AC_SUBST(QTHREAD_LTLIBS) - AC_SUBST(qtmd_h) - AC_SUBST(qtmds_s) - AC_SUBST(qtmdc_c) - AC_SUBST(qtdmdb_s) - AC_SUBST(qthread_asflags) - AC_SUBST(THREAD_PACKAGE) - AC_SUBST(THREAD_LIBS_LOCAL) - AC_SUBST(THREAD_LIBS_INSTALLED) -]) - -dnl qthreads.m4 ends here diff --git a/guile-readline/ChangeLog b/guile-readline/ChangeLog index a599a6699..2188b78e1 100644 --- a/guile-readline/ChangeLog +++ b/guile-readline/ChangeLog @@ -1,3 +1,28 @@ +2008-05-07 Ludovic Courtès <ludo@gnu.org> + + * ice-9/Makefile.am (guile_pdd): Don't use `patsubst': it's GNU + Make and broke BSD Make as found on FreeBSD 6.2. + +2008-04-16 Ludovic Courtès <ludo@gnu.org> + + * configure.in (AC_INIT): Don't use "echo -n", which is not + available on MacOS X; use `patsubst' instead to remove the + newline. Reported by Steven Wu <wus@qwest.net>. + +2008-02-16 Ludovic Courtès <ludo@gnu.org> + + * LIBGUILEREADLINE-VERSION + (LIBGUILEREADLINE_INTERFACE_REVISION): Increment for release. + +2008-01-29 Neil Jerram <neil@ossau.uklinux.net> + + * readline.c (scm_init_readline): Only do init_bouncing_parens () + if HAVE_RL_GET_KEYMAP. + (init_bouncing_parens, find_matching_paren, match_paren): Compile + out if ! HAVE_RL_GET_KEYMAP. + + * configure.in: Add check for rl_get_keymap. + 2007-07-29 Ludovic Courtès <ludo@gnu.org> * Makefile.am (INCLUDES): Add Gnulib includes. diff --git a/guile-readline/configure.in b/guile-readline/configure.in index b58b46b87..9098a31e6 100644 --- a/guile-readline/configure.in +++ b/guile-readline/configure.in @@ -1,7 +1,12 @@ AC_PREREQ(2.50) +dnl Don't use "echo -n", which is not portable (e.g., not available on +dnl MacOS X). Instead, use `patsubst' to remove the newline. AC_INIT(guile-readline, - m4_esyscmd(. ../GUILE-VERSION && echo -n ${GUILE_VERSION})) + patsubst(m4_esyscmd(. ../GUILE-VERSION && echo ${GUILE_VERSION}), [ +]), + [bug-guile@gnu.org]) + AC_CONFIG_AUX_DIR([.]) AC_CONFIG_SRCDIR(readline.c) AM_CONFIG_HEADER([guile-readline-config.h]) @@ -43,6 +48,11 @@ AC_CHECK_FUNCS(siginterrupt rl_clear_signals rl_cleanup_after_signal) dnl Check for modern readline naming AC_CHECK_FUNCS(rl_filename_completion_function) +dnl Check for rl_get_keymap. We only use this for deciding whether to +dnl install paren matching on the Guile command line (when using +dnl readline for input), so it's completely optional. +AC_CHECK_FUNCS(rl_get_keymap) + dnl Check for rl_pre_input_hook. This is more complicated because on dnl some systems (HP/UX), the linker wont let us treat dnl rl_pre_input_hook as a function when it really is a function diff --git a/guile-readline/ice-9/Makefile.am b/guile-readline/ice-9/Makefile.am index 1917c76fc..d1e7c8270 100644 --- a/guile-readline/ice-9/Makefile.am +++ b/guile-readline/ice-9/Makefile.am @@ -1,7 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 1998, 1999, 2000, 2001, 2006 Free Software Foundation, Inc. -## Copyright (C) 2002, 2003, 2004, 2006 Free Software Foundation, Inc. +## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2008 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -20,7 +19,9 @@ ## to the Free Software Foundation, Inc., 51 Franklin Street, Fifth ## Floor, Boston, MA 02110-1301 USA -guile_pdd = $(patsubst %/guile-readline,%/guile,$(pkgdatadir)) +# Guile's `pkgdatadir'. +guile_pdd = $(datadir)/guile + ice9dir = $(guile_pdd)/$(GUILE_EFFECTIVE_VERSION)/ice-9 ice9_DATA = readline.scm ETAGS_ARGS = $(ice9_DATA) diff --git a/guile-readline/readline.c b/guile-readline/readline.c index 5a8ced64a..9178ebdd2 100644 --- a/guile-readline/readline.c +++ b/guile-readline/readline.c @@ -1,6 +1,6 @@ /* readline.c --- line editing support for Guile */ -/* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006, 2007, 2008 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 @@ -425,6 +425,7 @@ completion_function (char *text, int continuep) } } +#if HAVE_RL_GET_KEYMAP /*Bouncing parenthesis (reimplemented by GH, 11/23/98, since readline is strict gpl)*/ static int match_paren (int x, int k); @@ -528,6 +529,7 @@ match_paren (int x, int k) } return 0; } +#endif /* HAVE_RL_GET_KEYMAP */ #if defined (HAVE_RL_PRE_INPUT_HOOK) && defined (GUILE_SIGWINCH_SA_RESTART_CLEARED) /* Readline disables SA_RESTART on SIGWINCH. @@ -575,7 +577,9 @@ scm_init_readline () reentry_barrier_mutex = scm_permanent_object (scm_make_mutex ()); scm_init_opts (scm_readline_options, scm_readline_opts); +#if HAVE_RL_GET_KEYMAP init_bouncing_parens(); +#endif scm_add_feature ("readline"); #endif /* HAVE_RL_GETC_FUNCTION */ } diff --git a/ice-9/COPYING b/ice-9/COPYING deleted file mode 100644 index e69de29bb..000000000 --- a/ice-9/COPYING +++ /dev/null diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index b761091c0..9007c0044 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,28 @@ +2008-07-17 Neil Jerram <neil@ossau.uklinux.net> + + * gds-client.scm (handle-nondebug-protocol): Add support for + setting a trap on code that is about to be evaluated. + +2008-04-14 Neil Jerram <neil@ossau.uklinux.net> + + * gds-client.scm (gds-debug-trap): Ensure that frame index passed + to Emacs is always positive. + +2008-03-19 Neil Jerram <neil@ossau.uklinux.net> + + * debugging/ice-9-debugger-extensions.scm (command-loop): Use + needed modules. + +2008-02-22 Ludovic Courtès <ludo@gnu.org> + + * match.scm: Export `match:andmap'. This fixes evaluation of + expressions like `(match expr (((_ ...) ...) #t))' where a list + of lists is to be matched. + +2008-01-22 Neil Jerram <neil@ossau.uklinux.net> + + * COPYING: Removed. + 2007-10-02 Ludovic Courtès <ludo@gnu.org> * slib.scm: Let SLIB's `guile.init' do most of the job. See the diff --git a/ice-9/Makefile.am b/ice-9/Makefile.am index 454b117cc..72c2655e5 100644 --- a/ice-9/Makefile.am +++ b/ice-9/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 1998,1999,2000,2001,2003, 2004, 2006 Free Software Foundation, Inc. +## Copyright (C) 1998,1999,2000,2001,2003, 2004, 2006, 2008 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -46,7 +46,6 @@ TAGS_FILES = $(subpkgdata_DATA) ## test.scm is not currently installed. EXTRA_DIST = $(ice9_sources) test.scm compile-psyntax.scm -if MAINTAINER_MODE # We expect this to never be invoked when there is not already # ice-9/psyntax.pp in %load-path, since compile-psyntax.scm depends # on ice-9/syncase.scm, which does `(load-from-path "ice-9/psyntax.pp")'. @@ -56,4 +55,4 @@ include $(top_srcdir)/am/pre-inst-guile psyntax.pp: psyntax.ss $(preinstguile) -s $(srcdir)/compile-psyntax.scm \ $(srcdir)/psyntax.ss $(srcdir)/psyntax.pp -endif + diff --git a/ice-9/debugging/ice-9-debugger-extensions.scm b/ice-9/debugging/ice-9-debugger-extensions.scm index 2770c1f73..a8b8c970e 100644 --- a/ice-9/debugging/ice-9-debugger-extensions.scm +++ b/ice-9/debugging/ice-9-debugger-extensions.scm @@ -28,7 +28,10 @@ (cond ((string>=? (version) "1.7") (use-modules (ice-9 debugger command-loop)) - (define-module (ice-9 debugger command-loop)) + (define-module (ice-9 debugger command-loop) + #:use-module (ice-9 debugger) + #:use-module (ice-9 debugger state) + #:use-module (ice-9 debugging traps)) (define new-define-command define-command) (set! define-command (lambda (name argument-template documentation procedure) diff --git a/ice-9/gds-client.scm b/ice-9/gds-client.scm index 7e6e524e5..d3d6146e9 100755 --- a/ice-9/gds-client.scm +++ b/ice-9/gds-client.scm @@ -73,7 +73,9 @@ (slot-ref (car fired-traps) 'depth))))) ;; Write current stack to the frontend. (write-form (list 'stack - (or special-index 0) + (if (and special-index (> special-index 0)) + special-index + 0) (stack->emacs-readable stack) (append (flags->emacs-readable flags) (slot-ref trap-context @@ -352,7 +354,7 @@ Thanks!\n\n" ((eval) (set! last-lazy-trap-context #f) - (apply (lambda (correlator module port-name line column code) + (apply (lambda (correlator module port-name line column code flags) (with-input-from-string code (lambda () (set-port-filename! (current-input-port) port-name) @@ -382,6 +384,11 @@ Thanks!\n\n" ;; it to the list. (begin (for-each-breakpoint setup-after-read x) + (if (and (pair? x) + (memq 'debug flags)) + (install-trap (make <source-trap> + #:expression x + #:behaviour gds-debug-trap))) (loop (cons x exprs) (read)))))) (lambda (key . args) (write-form `(eval-results diff --git a/ice-9/match.scm b/ice-9/match.scm index 2e10c3923..e6fe56063 100644 --- a/ice-9/match.scm +++ b/ice-9/match.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2006, 2008 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 @@ -22,6 +22,7 @@ :export (match match-lambda match-lambda* match-define match-let match-let* match-letrec define-structure define-const-structure + match:andmap match:error match:set-error match:error-control match:set-error-control match:structure-control match:set-structure-control diff --git a/lang/elisp/ChangeLog b/lang/elisp/ChangeLog index 1114618d0..a2c3bc84b 100644 --- a/lang/elisp/ChangeLog +++ b/lang/elisp/ChangeLog @@ -1,3 +1,12 @@ +2008-04-14 Neil Jerram <neil@ossau.uklinux.net> + + * primitives/symprop.scm (get): Use lambda->nil. + + * primitives/strings.scm (aset): New primitive. + + * internals/load.scm (load): Use in-vicinity (instead of + string-append) to add a slash if needed. + 2004-02-08 Mikael Djurfeldt <djurfeldt@nada.kth.se> * primitives/Makefile.am (TAGS_FILES), internals/Makefile.am diff --git a/lang/elisp/internals/load.scm b/lang/elisp/internals/load.scm index e55c8b50f..2b6cac36f 100644 --- a/lang/elisp/internals/load.scm +++ b/lang/elisp/internals/load.scm @@ -15,9 +15,8 @@ '("") load-path))) (cond ((null? dirs) #f) - ((file-exists? (string-append (car dirs) - filename)) - (string-append (car dirs) filename)) + ((file-exists? (in-vicinity (car dirs) filename)) + (in-vicinity (car dirs) filename)) (else (loop (cdr dirs))))))) (if pathname (begin diff --git a/lang/elisp/primitives/strings.scm b/lang/elisp/primitives/strings.scm index 85a1c10a9..85e462f8b 100644 --- a/lang/elisp/primitives/strings.scm +++ b/lang/elisp/primitives/strings.scm @@ -29,6 +29,12 @@ ((string? array) (char->integer (string-ref array idx))) (else (wta 'arrayp array 1))))) +(fset 'aset + (lambda (array idx newelt) + (cond ((vector? array) (vector-set! array idx newelt)) + ((string? array) (string-set! array idx (integer->char newelt))) + (else (wta 'arrayp array 1))))) + (fset 'stringp (lambda->nil string?)) (fset 'vector vector) diff --git a/lang/elisp/primitives/symprop.scm b/lang/elisp/primitives/symprop.scm index a520a4b81..8f10fd8cd 100644 --- a/lang/elisp/primitives/symprop.scm +++ b/lang/elisp/primitives/symprop.scm @@ -9,7 +9,7 @@ (fset 'put set-symbol-property!) -(fset 'get symbol-property) +(fset 'get (lambda->nil symbol-property)) (fset 'set set) diff --git a/lib/Makefile.am b/lib/Makefile.am new file mode 100644 index 000000000..272da8f1e --- /dev/null +++ b/lib/Makefile.am @@ -0,0 +1,222 @@ +## DO NOT EDIT! GENERATED AUTOMATICALLY! +## Process this file with automake to produce Makefile.in. +# Copyright (C) 2002-2008 Free Software Foundation, Inc. +# +# This file is free software, distributed under the terms of the GNU +# General Public License. As a special exception to the GNU General +# Public License, this file may be distributed as part of a program +# that contains a configuration script generated by Autoconf, under +# the same distribution terms as the rest of that program. +# +# Generated by gnulib-tool. +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --aux-dir=build-aux --lgpl --libtool --macro-prefix=gl alloca count-one-bits extensions strcase strftime + +AUTOMAKE_OPTIONS = 1.5 gnits + +noinst_HEADERS = +noinst_LIBRARIES = +noinst_LTLIBRARIES = +EXTRA_DIST = +BUILT_SOURCES = +SUFFIXES = +MOSTLYCLEANFILES = core *.stackdump +MOSTLYCLEANDIRS = +CLEANFILES = +DISTCLEANFILES = +MAINTAINERCLEANFILES = + +AM_CPPFLAGS = + +noinst_LTLIBRARIES += libgnu.la + +libgnu_la_SOURCES = +libgnu_la_LIBADD = $(gl_LTLIBOBJS) +libgnu_la_DEPENDENCIES = $(gl_LTLIBOBJS) +EXTRA_libgnu_la_SOURCES = +libgnu_la_LDFLAGS = $(AM_LDFLAGS) + +## begin gnulib module alloca + + +EXTRA_DIST += alloca.c + +EXTRA_libgnu_la_SOURCES += alloca.c + +libgnu_la_LIBADD += @LTALLOCA@ +libgnu_la_DEPENDENCIES += @LTALLOCA@ +## end gnulib module alloca + +## begin gnulib module alloca-opt + +BUILT_SOURCES += $(ALLOCA_H) + +# We need the following in order to create <alloca.h> when the system +# doesn't have one that works with the given compiler. +alloca.h: alloca.in.h + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + cat $(srcdir)/alloca.in.h; \ + } > $@-t + mv -f $@-t $@ +MOSTLYCLEANFILES += alloca.h alloca.h-t + +EXTRA_DIST += alloca.in.h + +## end gnulib module alloca-opt + +## begin gnulib module count-one-bits + + +EXTRA_DIST += count-one-bits.h + +## end gnulib module count-one-bits + +## begin gnulib module link-warning + +LINK_WARNING_H=$(top_srcdir)/build-aux/link-warning.h + +EXTRA_DIST += $(top_srcdir)/build-aux/link-warning.h + +## end gnulib module link-warning + +## begin gnulib module stdbool + +BUILT_SOURCES += $(STDBOOL_H) + +# We need the following in order to create <stdbool.h> when the system +# doesn't have one that works. +stdbool.h: stdbool.in.h + rm -f $@-t $@ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + sed -e 's/@''HAVE__BOOL''@/$(HAVE__BOOL)/g' < $(srcdir)/stdbool.in.h; \ + } > $@-t + mv $@-t $@ +MOSTLYCLEANFILES += stdbool.h stdbool.h-t + +EXTRA_DIST += stdbool.in.h + +## end gnulib module stdbool + +## begin gnulib module strcase + + +EXTRA_DIST += strcasecmp.c strncasecmp.c + +EXTRA_libgnu_la_SOURCES += strcasecmp.c strncasecmp.c + +## end gnulib module strcase + +## begin gnulib module strftime + + +EXTRA_DIST += strftime.c strftime.h + +EXTRA_libgnu_la_SOURCES += strftime.c + +## end gnulib module strftime + +## begin gnulib module strings + +BUILT_SOURCES += strings.h + +# We need the following in order to create <strings.h> when the system +# doesn't have one that works with the given compiler. +strings.h: strings.in.h + rm -f $@-t $@ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ + sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''NEXT_STRINGS_H''@|$(NEXT_STRINGS_H)|g' \ + -e 's|@''HAVE_STRCASECMP''@|$(HAVE_STRCASECMP)|g' \ + -e 's|@''HAVE_DECL_STRNCASECMP''@|$(HAVE_DECL_STRNCASECMP)|g' \ + -e '/definition of GL_LINK_WARNING/r $(LINK_WARNING_H)' \ + < $(srcdir)/strings.in.h; \ + } > $@-t + mv $@-t $@ +MOSTLYCLEANFILES += strings.h strings.h-t + +EXTRA_DIST += strings.in.h + +## end gnulib module strings + +## begin gnulib module time + +BUILT_SOURCES += time.h + +# We need the following in order to create <time.h> when the system +# doesn't have one that works with the given compiler. +time.h: time.in.h + rm -f $@-t $@ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ + sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@NEXT_TIME_H''@|$(NEXT_TIME_H)|g' \ + -e 's|@REPLACE_LOCALTIME_R''@|$(REPLACE_LOCALTIME_R)|g' \ + -e 's|@REPLACE_NANOSLEEP''@|$(REPLACE_NANOSLEEP)|g' \ + -e 's|@REPLACE_STRPTIME''@|$(REPLACE_STRPTIME)|g' \ + -e 's|@REPLACE_TIMEGM''@|$(REPLACE_TIMEGM)|g' \ + -e 's|@SYS_TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(SYS_TIME_H_DEFINES_STRUCT_TIMESPEC)|g' \ + -e 's|@TIME_H_DEFINES_STRUCT_TIMESPEC''@|$(TIME_H_DEFINES_STRUCT_TIMESPEC)|g' \ + < $(srcdir)/time.in.h; \ + } > $@-t + mv $@-t $@ +MOSTLYCLEANFILES += time.h time.h-t + +EXTRA_DIST += time.in.h + +## end gnulib module time + +## begin gnulib module time_r + + +EXTRA_DIST += time_r.c + +EXTRA_libgnu_la_SOURCES += time_r.c + +## end gnulib module time_r + +## begin gnulib module verify + +libgnu_la_SOURCES += verify.h + +## end gnulib module verify + +## begin gnulib module wchar + +BUILT_SOURCES += $(WCHAR_H) + +# We need the following in order to create <wchar.h> when the system +# version does not work standalone. +wchar.h: wchar.in.h + rm -f $@-t $@ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''NEXT_WCHAR_H''@|$(NEXT_WCHAR_H)|g' \ + -e 's/@''HAVE_WCHAR_H''@/$(HAVE_WCHAR_H)/g' \ + -e 's|@''GNULIB_WCWIDTH''@|$(GNULIB_WCWIDTH)|g' \ + -e 's|@''HAVE_DECL_WCWIDTH''@|$(HAVE_DECL_WCWIDTH)|g' \ + -e 's|@''REPLACE_WCWIDTH''@|$(REPLACE_WCWIDTH)|g' \ + -e '/definition of GL_LINK_WARNING/r $(LINK_WARNING_H)' \ + < $(srcdir)/wchar.in.h; \ + } > $@-t + mv $@-t $@ +MOSTLYCLEANFILES += wchar.h wchar.h-t + +EXTRA_DIST += wchar.in.h + +## end gnulib module wchar + +## begin gnulib module dummy + +libgnu_la_SOURCES += dummy.c + +## end gnulib module dummy + + +mostlyclean-local: mostlyclean-generic + @for dir in '' $(MOSTLYCLEANDIRS); do \ + if test -n "$$dir" && test -d $$dir; then \ + echo "rmdir $$dir"; rmdir $$dir; \ + fi; \ + done; \ + : diff --git a/lib/alloca.c b/lib/alloca.c new file mode 100644 index 000000000..3a1f4e273 --- /dev/null +++ b/lib/alloca.c @@ -0,0 +1,489 @@ +/* alloca.c -- allocate automatically reclaimed memory + (Mostly) portable public-domain implementation -- D A Gwyn + + This implementation of the PWB library alloca function, + which is used to allocate space off the run-time stack so + that it is automatically reclaimed upon procedure exit, + was inspired by discussions with J. Q. Johnson of Cornell. + J.Otto Tennant <jot@cray.com> contributed the Cray support. + + There are some preprocessor constants that can + be defined when compiling for your specific system, for + improved efficiency; however, the defaults should be okay. + + The general concept of this implementation is to keep + track of all alloca-allocated blocks, and reclaim any + that are found to be deeper in the stack than the current + invocation. This heuristic does not reclaim storage as + soon as it becomes invalid, but it will do so eventually. + + As a special case, alloca(0) reclaims storage without + allocating any. It is a good idea to use alloca(0) in + your main control loop, etc. to force garbage collection. */ + +#include <config.h> + +#include <alloca.h> + +#include <string.h> +#include <stdlib.h> + +#ifdef emacs +# include "lisp.h" +# include "blockinput.h" +# ifdef EMACS_FREE +# undef free +# define free EMACS_FREE +# endif +#else +# define memory_full() abort () +#endif + +/* If compiling with GCC 2, this file's not needed. */ +#if !defined (__GNUC__) || __GNUC__ < 2 + +/* If someone has defined alloca as a macro, + there must be some other way alloca is supposed to work. */ +# ifndef alloca + +# ifdef emacs +# ifdef static +/* actually, only want this if static is defined as "" + -- this is for usg, in which emacs must undefine static + in order to make unexec workable + */ +# ifndef STACK_DIRECTION +you +lose +-- must know STACK_DIRECTION at compile-time +/* Using #error here is not wise since this file should work for + old and obscure compilers. */ +# endif /* STACK_DIRECTION undefined */ +# endif /* static */ +# endif /* emacs */ + +/* If your stack is a linked list of frames, you have to + provide an "address metric" ADDRESS_FUNCTION macro. */ + +# if defined (CRAY) && defined (CRAY_STACKSEG_END) +long i00afunc (); +# define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg)) +# else +# define ADDRESS_FUNCTION(arg) &(arg) +# endif + +/* Define STACK_DIRECTION if you know the direction of stack + growth for your system; otherwise it will be automatically + deduced at run-time. + + STACK_DIRECTION > 0 => grows toward higher addresses + STACK_DIRECTION < 0 => grows toward lower addresses + STACK_DIRECTION = 0 => direction of growth unknown */ + +# ifndef STACK_DIRECTION +# define STACK_DIRECTION 0 /* Direction unknown. */ +# endif + +# if STACK_DIRECTION != 0 + +# define STACK_DIR STACK_DIRECTION /* Known at compile-time. */ + +# else /* STACK_DIRECTION == 0; need run-time code. */ + +static int stack_dir; /* 1 or -1 once known. */ +# define STACK_DIR stack_dir + +static void +find_stack_direction (void) +{ + static char *addr = NULL; /* Address of first `dummy', once known. */ + auto char dummy; /* To get stack address. */ + + if (addr == NULL) + { /* Initial entry. */ + addr = ADDRESS_FUNCTION (dummy); + + find_stack_direction (); /* Recurse once. */ + } + else + { + /* Second entry. */ + if (ADDRESS_FUNCTION (dummy) > addr) + stack_dir = 1; /* Stack grew upward. */ + else + stack_dir = -1; /* Stack grew downward. */ + } +} + +# endif /* STACK_DIRECTION == 0 */ + +/* An "alloca header" is used to: + (a) chain together all alloca'ed blocks; + (b) keep track of stack depth. + + It is very important that sizeof(header) agree with malloc + alignment chunk size. The following default should work okay. */ + +# ifndef ALIGN_SIZE +# define ALIGN_SIZE sizeof(double) +# endif + +typedef union hdr +{ + char align[ALIGN_SIZE]; /* To force sizeof(header). */ + struct + { + union hdr *next; /* For chaining headers. */ + char *deep; /* For stack depth measure. */ + } h; +} header; + +static header *last_alloca_header = NULL; /* -> last alloca header. */ + +/* Return a pointer to at least SIZE bytes of storage, + which will be automatically reclaimed upon exit from + the procedure that called alloca. Originally, this space + was supposed to be taken from the current stack frame of the + caller, but that method cannot be made to work for some + implementations of C, for example under Gould's UTX/32. */ + +void * +alloca (size_t size) +{ + auto char probe; /* Probes stack depth: */ + register char *depth = ADDRESS_FUNCTION (probe); + +# if STACK_DIRECTION == 0 + if (STACK_DIR == 0) /* Unknown growth direction. */ + find_stack_direction (); +# endif + + /* Reclaim garbage, defined as all alloca'd storage that + was allocated from deeper in the stack than currently. */ + + { + register header *hp; /* Traverses linked list. */ + +# ifdef emacs + BLOCK_INPUT; +# endif + + for (hp = last_alloca_header; hp != NULL;) + if ((STACK_DIR > 0 && hp->h.deep > depth) + || (STACK_DIR < 0 && hp->h.deep < depth)) + { + register header *np = hp->h.next; + + free (hp); /* Collect garbage. */ + + hp = np; /* -> next header. */ + } + else + break; /* Rest are not deeper. */ + + last_alloca_header = hp; /* -> last valid storage. */ + +# ifdef emacs + UNBLOCK_INPUT; +# endif + } + + if (size == 0) + return NULL; /* No allocation required. */ + + /* Allocate combined header + user data storage. */ + + { + /* Address of header. */ + register header *new; + + size_t combined_size = sizeof (header) + size; + if (combined_size < sizeof (header)) + memory_full (); + + new = malloc (combined_size); + + if (! new) + memory_full (); + + new->h.next = last_alloca_header; + new->h.deep = depth; + + last_alloca_header = new; + + /* User storage begins just after header. */ + + return (void *) (new + 1); + } +} + +# if defined (CRAY) && defined (CRAY_STACKSEG_END) + +# ifdef DEBUG_I00AFUNC +# include <stdio.h> +# endif + +# ifndef CRAY_STACK +# define CRAY_STACK +# ifndef CRAY2 +/* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */ +struct stack_control_header + { + long shgrow:32; /* Number of times stack has grown. */ + long shaseg:32; /* Size of increments to stack. */ + long shhwm:32; /* High water mark of stack. */ + long shsize:32; /* Current size of stack (all segments). */ + }; + +/* The stack segment linkage control information occurs at + the high-address end of a stack segment. (The stack + grows from low addresses to high addresses.) The initial + part of the stack segment linkage control information is + 0200 (octal) words. This provides for register storage + for the routine which overflows the stack. */ + +struct stack_segment_linkage + { + long ss[0200]; /* 0200 overflow words. */ + long sssize:32; /* Number of words in this segment. */ + long ssbase:32; /* Offset to stack base. */ + long:32; + long sspseg:32; /* Offset to linkage control of previous + segment of stack. */ + long:32; + long sstcpt:32; /* Pointer to task common address block. */ + long sscsnm; /* Private control structure number for + microtasking. */ + long ssusr1; /* Reserved for user. */ + long ssusr2; /* Reserved for user. */ + long sstpid; /* Process ID for pid based multi-tasking. */ + long ssgvup; /* Pointer to multitasking thread giveup. */ + long sscray[7]; /* Reserved for Cray Research. */ + long ssa0; + long ssa1; + long ssa2; + long ssa3; + long ssa4; + long ssa5; + long ssa6; + long ssa7; + long sss0; + long sss1; + long sss2; + long sss3; + long sss4; + long sss5; + long sss6; + long sss7; + }; + +# else /* CRAY2 */ +/* The following structure defines the vector of words + returned by the STKSTAT library routine. */ +struct stk_stat + { + long now; /* Current total stack size. */ + long maxc; /* Amount of contiguous space which would + be required to satisfy the maximum + stack demand to date. */ + long high_water; /* Stack high-water mark. */ + long overflows; /* Number of stack overflow ($STKOFEN) calls. */ + long hits; /* Number of internal buffer hits. */ + long extends; /* Number of block extensions. */ + long stko_mallocs; /* Block allocations by $STKOFEN. */ + long underflows; /* Number of stack underflow calls ($STKRETN). */ + long stko_free; /* Number of deallocations by $STKRETN. */ + long stkm_free; /* Number of deallocations by $STKMRET. */ + long segments; /* Current number of stack segments. */ + long maxs; /* Maximum number of stack segments so far. */ + long pad_size; /* Stack pad size. */ + long current_address; /* Current stack segment address. */ + long current_size; /* Current stack segment size. This + number is actually corrupted by STKSTAT to + include the fifteen word trailer area. */ + long initial_address; /* Address of initial segment. */ + long initial_size; /* Size of initial segment. */ + }; + +/* The following structure describes the data structure which trails + any stack segment. I think that the description in 'asdef' is + out of date. I only describe the parts that I am sure about. */ + +struct stk_trailer + { + long this_address; /* Address of this block. */ + long this_size; /* Size of this block (does not include + this trailer). */ + long unknown2; + long unknown3; + long link; /* Address of trailer block of previous + segment. */ + long unknown5; + long unknown6; + long unknown7; + long unknown8; + long unknown9; + long unknown10; + long unknown11; + long unknown12; + long unknown13; + long unknown14; + }; + +# endif /* CRAY2 */ +# endif /* not CRAY_STACK */ + +# ifdef CRAY2 +/* Determine a "stack measure" for an arbitrary ADDRESS. + I doubt that "lint" will like this much. */ + +static long +i00afunc (long *address) +{ + struct stk_stat status; + struct stk_trailer *trailer; + long *block, size; + long result = 0; + + /* We want to iterate through all of the segments. The first + step is to get the stack status structure. We could do this + more quickly and more directly, perhaps, by referencing the + $LM00 common block, but I know that this works. */ + + STKSTAT (&status); + + /* Set up the iteration. */ + + trailer = (struct stk_trailer *) (status.current_address + + status.current_size + - 15); + + /* There must be at least one stack segment. Therefore it is + a fatal error if "trailer" is null. */ + + if (trailer == 0) + abort (); + + /* Discard segments that do not contain our argument address. */ + + while (trailer != 0) + { + block = (long *) trailer->this_address; + size = trailer->this_size; + if (block == 0 || size == 0) + abort (); + trailer = (struct stk_trailer *) trailer->link; + if ((block <= address) && (address < (block + size))) + break; + } + + /* Set the result to the offset in this segment and add the sizes + of all predecessor segments. */ + + result = address - block; + + if (trailer == 0) + { + return result; + } + + do + { + if (trailer->this_size <= 0) + abort (); + result += trailer->this_size; + trailer = (struct stk_trailer *) trailer->link; + } + while (trailer != 0); + + /* We are done. Note that if you present a bogus address (one + not in any segment), you will get a different number back, formed + from subtracting the address of the first block. This is probably + not what you want. */ + + return (result); +} + +# else /* not CRAY2 */ +/* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP. + Determine the number of the cell within the stack, + given the address of the cell. The purpose of this + routine is to linearize, in some sense, stack addresses + for alloca. */ + +static long +i00afunc (long address) +{ + long stkl = 0; + + long size, pseg, this_segment, stack; + long result = 0; + + struct stack_segment_linkage *ssptr; + + /* Register B67 contains the address of the end of the + current stack segment. If you (as a subprogram) store + your registers on the stack and find that you are past + the contents of B67, you have overflowed the segment. + + B67 also points to the stack segment linkage control + area, which is what we are really interested in. */ + + stkl = CRAY_STACKSEG_END (); + ssptr = (struct stack_segment_linkage *) stkl; + + /* If one subtracts 'size' from the end of the segment, + one has the address of the first word of the segment. + + If this is not the first segment, 'pseg' will be + nonzero. */ + + pseg = ssptr->sspseg; + size = ssptr->sssize; + + this_segment = stkl - size; + + /* It is possible that calling this routine itself caused + a stack overflow. Discard stack segments which do not + contain the target address. */ + + while (!(this_segment <= address && address <= stkl)) + { +# ifdef DEBUG_I00AFUNC + fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl); +# endif + if (pseg == 0) + break; + stkl = stkl - pseg; + ssptr = (struct stack_segment_linkage *) stkl; + size = ssptr->sssize; + pseg = ssptr->sspseg; + this_segment = stkl - size; + } + + result = address - this_segment; + + /* If you subtract pseg from the current end of the stack, + you get the address of the previous stack segment's end. + This seems a little convoluted to me, but I'll bet you save + a cycle somewhere. */ + + while (pseg != 0) + { +# ifdef DEBUG_I00AFUNC + fprintf (stderr, "%011o %011o\n", pseg, size); +# endif + stkl = stkl - pseg; + ssptr = (struct stack_segment_linkage *) stkl; + size = ssptr->sssize; + pseg = ssptr->sspseg; + result += size; + } + return (result); +} + +# endif /* not CRAY2 */ +# endif /* CRAY */ + +# endif /* no alloca */ +#endif /* not GCC version 2 */ diff --git a/lib/alloca.in.h b/lib/alloca.in.h new file mode 100644 index 000000000..3d4f88b35 --- /dev/null +++ b/lib/alloca.in.h @@ -0,0 +1,56 @@ +/* Memory allocation on the stack. + + Copyright (C) 1995, 1999, 2001-2004, 2006-2008 Free Software + Foundation, Inc. + + This program is free software; you can redistribute it and/or modify it + under the terms of the GNU Lesser General Public License as published + by the Free Software Foundation; either version 2, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, + USA. */ + +/* Avoid using the symbol _ALLOCA_H here, as Bison assumes _ALLOCA_H + means there is a real alloca function. */ +#ifndef _GL_ALLOCA_H +#define _GL_ALLOCA_H + +/* alloca (N) returns a pointer to N bytes of memory + allocated on the stack, which will last until the function returns. + Use of alloca should be avoided: + - inside arguments of function calls - undefined behaviour, + - in inline functions - the allocation may actually last until the + calling function returns, + - for huge N (say, N >= 65536) - you never know how large (or small) + the stack is, and when the stack cannot fulfill the memory allocation + request, the program just crashes. + */ + +#ifndef alloca +# ifdef __GNUC__ +# define alloca __builtin_alloca +# elif defined _AIX +# define alloca __alloca +# elif defined _MSC_VER +# include <malloc.h> +# define alloca _alloca +# elif defined __DECC && defined __VMS +# define alloca __ALLOCA +# else +# include <stddef.h> +# ifdef __cplusplus +extern "C" +# endif +void *alloca (size_t); +# endif +#endif + +#endif /* _GL_ALLOCA_H */ diff --git a/lib/count-one-bits.h b/lib/count-one-bits.h new file mode 100644 index 000000000..7ecae84f0 --- /dev/null +++ b/lib/count-one-bits.h @@ -0,0 +1,77 @@ +/* count-one-bits.h -- counts the number of 1-bits in a word. + Copyright (C) 2007-2008 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program. If not, see <http://www.gnu.org/licenses/>. */ + +/* Written by Ben Pfaff. */ + +#ifndef COUNT_ONE_BITS_H +# define COUNT_ONE_BITS_H 1 + +#include <stdlib.h> +#include "verify.h" + +/* Expand the code which computes the number of 1-bits of the local + variable 'x' of type TYPE (an unsigned integer type) and returns it + from the current function. */ +#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) +#define COUNT_ONE_BITS(BUILTIN, TYPE) \ + return BUILTIN (x); +#else +#define COUNT_ONE_BITS(BUILTIN, TYPE) \ + /* This condition is written so as to avoid shifting by more than \ + 31 bits at once, and also avoids a random HP-UX cc bug. */ \ + verify (((TYPE) -1 >> 31 >> 31 >> 2) == 0); /* TYPE has at most 64 bits */ \ + int count = count_one_bits_32 (x); \ + if (1 < (TYPE) -1 >> 31) /* TYPE has more than 32 bits? */ \ + count += count_one_bits_32 (x >> 31 >> 1); \ + return count; + +/* Compute and return the the number of 1-bits set in the least + significant 32 bits of X. */ +static inline int +count_one_bits_32 (unsigned int x) +{ + x = ((x & 0xaaaaaaaaU) >> 1) + (x & 0x55555555U); + x = ((x & 0xccccccccU) >> 2) + (x & 0x33333333U); + x = (x >> 16) + (x & 0xffff); + x = ((x & 0xf0f0) >> 4) + (x & 0x0f0f); + return (x >> 8) + (x & 0x00ff); +} +#endif + +/* Compute and return the number of 1-bits set in X. */ +static inline int +count_one_bits (unsigned int x) +{ + COUNT_ONE_BITS (__builtin_popcount, unsigned int); +} + +/* Compute and return the number of 1-bits set in X. */ +static inline int +count_one_bits_l (unsigned long int x) +{ + COUNT_ONE_BITS (__builtin_popcountl, unsigned long int); +} + +#if HAVE_UNSIGNED_LONG_LONG_INT +/* Compute and return the number of 1-bits set in X. */ +static inline int +count_one_bits_ll (unsigned long long int x) +{ + COUNT_ONE_BITS (__builtin_popcountll, unsigned long long int); +} +#endif + +#endif /* COUNT_ONE_BITS_H */ diff --git a/lib/dummy.c b/lib/dummy.c new file mode 100644 index 000000000..37fff11da --- /dev/null +++ b/lib/dummy.c @@ -0,0 +1,42 @@ +/* A dummy file, to prevent empty libraries from breaking builds. + Copyright (C) 2004, 2007 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program. If not, see <http://www.gnu.org/licenses/>. */ + +/* Some systems, reportedly OpenBSD and Mac OS X, refuse to create + libraries without any object files. You might get an error like: + + > ar cru .libs/libgl.a + > ar: no archive members specified + + Compiling this file, and adding its object file to the library, will + prevent the library from being empty. */ + +/* Some systems, such as Solaris with cc 5.0, refuse to work with libraries + that don't export any symbol. You might get an error like: + + > cc ... libgnu.a + > ild: (bad file) garbled symbol table in archive ../gllib/libgnu.a + + Compiling this file, and adding its object file to the library, will + prevent the library from exporting no symbols. */ + +#ifdef __sun +/* This declaration ensures that the library will export at least 1 symbol. */ +int gl_dummy_symbol; +#else +/* This declaration is solely to ensure that after preprocessing + this file is never empty. */ +typedef int dummy; +#endif diff --git a/lib/stdbool.in.h b/lib/stdbool.in.h new file mode 100644 index 000000000..3390484f9 --- /dev/null +++ b/lib/stdbool.in.h @@ -0,0 +1,119 @@ +/* Copyright (C) 2001-2003, 2006-2008 Free Software Foundation, Inc. + Written by Bruno Haible <haible@clisp.cons.org>, 2001. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 2, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +#ifndef _GL_STDBOOL_H +#define _GL_STDBOOL_H + +/* ISO C 99 <stdbool.h> for platforms that lack it. */ + +/* Usage suggestions: + + Programs that use <stdbool.h> should be aware of some limitations + and standards compliance issues. + + Standards compliance: + + - <stdbool.h> must be #included before 'bool', 'false', 'true' + can be used. + + - You cannot assume that sizeof (bool) == 1. + + - Programs should not undefine the macros bool, true, and false, + as C99 lists that as an "obsolescent feature". + + Limitations of this substitute, when used in a C89 environment: + + - <stdbool.h> must be #included before the '_Bool' type can be used. + + - You cannot assume that _Bool is a typedef; it might be a macro. + + - Bit-fields of type 'bool' are not supported. Portable code + should use 'unsigned int foo : 1;' rather than 'bool foo : 1;'. + + - In C99, casts and automatic conversions to '_Bool' or 'bool' are + performed in such a way that every nonzero value gets converted + to 'true', and zero gets converted to 'false'. This doesn't work + with this substitute. With this substitute, only the values 0 and 1 + give the expected result when converted to _Bool' or 'bool'. + + Also, it is suggested that programs use 'bool' rather than '_Bool'; + this isn't required, but 'bool' is more common. */ + + +/* 7.16. Boolean type and values */ + +/* BeOS <sys/socket.h> already #defines false 0, true 1. We use the same + definitions below, but temporarily we have to #undef them. */ +#if defined __BEOS__ && !defined __HAIKU__ +# include <OS.h> /* defines bool but not _Bool */ +# undef false +# undef true +#endif + +/* For the sake of symbolic names in gdb, we define true and false as + enum constants, not only as macros. + It is tempting to write + typedef enum { false = 0, true = 1 } _Bool; + so that gdb prints values of type 'bool' symbolically. But if we do + this, values of type '_Bool' may promote to 'int' or 'unsigned int' + (see ISO C 99 6.7.2.2.(4)); however, '_Bool' must promote to 'int' + (see ISO C 99 6.3.1.1.(2)). So we add a negative value to the + enum; this ensures that '_Bool' promotes to 'int'. */ +#if defined __cplusplus || (defined __BEOS__ && !defined __HAIKU__) + /* A compiler known to have 'bool'. */ + /* If the compiler already has both 'bool' and '_Bool', we can assume they + are the same types. */ +# if !@HAVE__BOOL@ +typedef bool _Bool; +# endif +#else +# if !defined __GNUC__ + /* If @HAVE__BOOL@: + Some HP-UX cc and AIX IBM C compiler versions have compiler bugs when + the built-in _Bool type is used. See + http://gcc.gnu.org/ml/gcc-patches/2003-12/msg02303.html + http://lists.gnu.org/archive/html/bug-coreutils/2005-11/msg00161.html + http://lists.gnu.org/archive/html/bug-coreutils/2005-10/msg00086.html + Similar bugs are likely with other compilers as well; this file + wouldn't be used if <stdbool.h> was working. + So we override the _Bool type. + If !@HAVE__BOOL@: + Need to define _Bool ourselves. As 'signed char' or as an enum type? + Use of a typedef, with SunPRO C, leads to a stupid + "warning: _Bool is a keyword in ISO C99". + Use of an enum type, with IRIX cc, leads to a stupid + "warning(1185): enumerated type mixed with another type". + Even the existence of an enum type, without a typedef, + "Invalid enumerator. (badenum)" with HP-UX cc on Tru64. + The only benefit of the enum, debuggability, is not important + with these compilers. So use 'signed char' and no enum. */ +# define _Bool signed char +# else + /* With this compiler, trust the _Bool type if the compiler has it. */ +# if !@HAVE__BOOL@ +typedef enum { _Bool_must_promote_to_int = -1, false = 0, true = 1 } _Bool; +# endif +# endif +#endif +#define bool _Bool + +/* The other macros must be usable in preprocessor directives. */ +#define false 0 +#define true 1 +#define __bool_true_false_are_defined 1 + +#endif /* _GL_STDBOOL_H */ diff --git a/lib/strcasecmp.c b/lib/strcasecmp.c new file mode 100644 index 000000000..708132507 --- /dev/null +++ b/lib/strcasecmp.c @@ -0,0 +1,63 @@ +/* Case-insensitive string comparison function. + Copyright (C) 1998-1999, 2005-2007 Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 2, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +#include <config.h> + +/* Specification. */ +#include <string.h> + +#include <ctype.h> +#include <limits.h> + +#define TOLOWER(Ch) (isupper (Ch) ? tolower (Ch) : (Ch)) + +/* Compare strings S1 and S2, ignoring case, returning less than, equal to or + greater than zero if S1 is lexicographically less than, equal to or greater + than S2. + Note: This function does not work with multibyte strings! */ + +int +strcasecmp (const char *s1, const char *s2) +{ + const unsigned char *p1 = (const unsigned char *) s1; + const unsigned char *p2 = (const unsigned char *) s2; + unsigned char c1, c2; + + if (p1 == p2) + return 0; + + do + { + c1 = TOLOWER (*p1); + c2 = TOLOWER (*p2); + + if (c1 == '\0') + break; + + ++p1; + ++p2; + } + while (c1 == c2); + + if (UCHAR_MAX <= INT_MAX) + return c1 - c2; + else + /* On machines where 'char' and 'int' are types of the same size, the + difference of two 'unsigned char' values - including the sign bit - + doesn't fit in an 'int'. */ + return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0); +} diff --git a/lib/strftime.c b/lib/strftime.c new file mode 100644 index 000000000..b7b7c1f1b --- /dev/null +++ b/lib/strftime.c @@ -0,0 +1,1461 @@ +/* Copyright (C) 1991-1999, 2000, 2001, 2003, 2004, 2005, 2006, 2007 Free Software + Foundation, Inc. + + NOTE: The canonical source of this file is maintained with the GNU C Library. + Bugs can be reported to bug-glibc@prep.ai.mit.edu. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program. If not, see <http://www.gnu.org/licenses/>. */ + +#ifdef _LIBC +# define HAVE_MBLEN 1 +# define HAVE_MBRLEN 1 +# define HAVE_STRUCT_ERA_ENTRY 1 +# define HAVE_TM_GMTOFF 1 +# define HAVE_TM_ZONE 1 +# define HAVE_TZNAME 1 +# define HAVE_TZSET 1 +# define MULTIBYTE_IS_FORMAT_SAFE 1 +# include "../locale/localeinfo.h" +#else +# include <config.h> +# if FPRINTFTIME +# include "fprintftime.h" +# endif +#endif + +#include <ctype.h> +#include <time.h> + +#if HAVE_TZNAME && !HAVE_DECL_TZNAME +extern char *tzname[]; +#endif + +/* Do multibyte processing if multibytes are supported, unless + multibyte sequences are safe in formats. Multibyte sequences are + safe if they cannot contain byte sequences that look like format + conversion specifications. The GNU C Library uses UTF8 multibyte + encoding, which is safe for formats, but strftime.c can be used + with other C libraries that use unsafe encodings. */ +#define DO_MULTIBYTE (HAVE_MBLEN && ! MULTIBYTE_IS_FORMAT_SAFE) + +#if DO_MULTIBYTE +# if HAVE_MBRLEN +# include <wchar.h> +# else + /* Simulate mbrlen with mblen as best we can. */ +# define mbstate_t int +# define mbrlen(s, n, ps) mblen (s, n) +# define mbsinit(ps) (*(ps) == 0) +# endif + static const mbstate_t mbstate_zero; +#endif + +#include <limits.h> +#include <stdbool.h> +#include <stddef.h> +#include <stdlib.h> +#include <string.h> + +#ifdef COMPILE_WIDE +# include <endian.h> +# define CHAR_T wchar_t +# define UCHAR_T unsigned int +# define L_(Str) L##Str +# define NLW(Sym) _NL_W##Sym + +# define MEMCPY(d, s, n) __wmemcpy (d, s, n) +# define STRLEN(s) __wcslen (s) + +#else +# define CHAR_T char +# define UCHAR_T unsigned char +# define L_(Str) Str +# define NLW(Sym) Sym + +# define MEMCPY(d, s, n) memcpy (d, s, n) +# define STRLEN(s) strlen (s) + +# ifdef _LIBC +# define MEMPCPY(d, s, n) __mempcpy (d, s, n) +# else +# ifndef HAVE_MEMPCPY +# define MEMPCPY(d, s, n) ((void *) ((char *) memcpy (d, s, n) + (n))) +# endif +# endif +#endif + +/* Shift A right by B bits portably, by dividing A by 2**B and + truncating towards minus infinity. A and B should be free of side + effects, and B should be in the range 0 <= B <= INT_BITS - 2, where + INT_BITS is the number of useful bits in an int. GNU code can + assume that INT_BITS is at least 32. + + ISO C99 says that A >> B is implementation-defined if A < 0. Some + implementations (e.g., UNICOS 9.0 on a Cray Y-MP EL) don't shift + right in the usual way when A < 0, so SHR falls back on division if + ordinary A >> B doesn't seem to be the usual signed shift. */ +#define SHR(a, b) \ + (-1 >> 1 == -1 \ + ? (a) >> (b) \ + : (a) / (1 << (b)) - ((a) % (1 << (b)) < 0)) + +/* Bound on length of the string representing an integer type or expression T. + Subtract 1 for the sign bit if t is signed; log10 (2.0) < 146/485; + add 1 for integer division truncation; add 1 more for a minus sign + if needed. */ +#define INT_STRLEN_BOUND(t) \ + ((sizeof (t) * CHAR_BIT - 1) * 146 / 485 + 2) + +#define TM_YEAR_BASE 1900 + +#ifndef __isleap +/* Nonzero if YEAR is a leap year (every 4 years, + except every 100th isn't, and every 400th is). */ +# define __isleap(year) \ + ((year) % 4 == 0 && ((year) % 100 != 0 || (year) % 400 == 0)) +#endif + + +#ifdef _LIBC +# define tzname __tzname +# define tzset __tzset +#endif + +#if !HAVE_TM_GMTOFF +/* Portable standalone applications should supply a "time.h" that + declares a POSIX-compliant localtime_r, for the benefit of older + implementations that lack localtime_r or have a nonstandard one. + See the gnulib time_r module for one way to implement this. */ +# undef __gmtime_r +# undef __localtime_r +# define __gmtime_r gmtime_r +# define __localtime_r localtime_r +#endif + + +#ifndef FPRINTFTIME +# define FPRINTFTIME 0 +#endif + +#if FPRINTFTIME +# define STREAM_OR_CHAR_T FILE +# define STRFTIME_ARG(x) /* empty */ +#else +# define STREAM_OR_CHAR_T CHAR_T +# define STRFTIME_ARG(x) x, +#endif + +#if FPRINTFTIME +# define memset_byte(P, Len, Byte) \ + do { size_t _i; for (_i = 0; _i < Len; _i++) fputc (Byte, P); } while (0) +# define memset_space(P, Len) memset_byte (P, Len, ' ') +# define memset_zero(P, Len) memset_byte (P, Len, '0') +#elif defined COMPILE_WIDE +# define memset_space(P, Len) (wmemset (P, L' ', Len), (P) += (Len)) +# define memset_zero(P, Len) (wmemset (P, L'0', Len), (P) += (Len)) +#else +# define memset_space(P, Len) (memset (P, ' ', Len), (P) += (Len)) +# define memset_zero(P, Len) (memset (P, '0', Len), (P) += (Len)) +#endif + +#if FPRINTFTIME +# define advance(P, N) +#else +# define advance(P, N) ((P) += (N)) +#endif + +#define add(n, f) \ + do \ + { \ + int _n = (n); \ + int _delta = width - _n; \ + int _incr = _n + (_delta > 0 ? _delta : 0); \ + if ((size_t) _incr >= maxsize - i) \ + return 0; \ + if (p) \ + { \ + if (digits == 0 && _delta > 0) \ + { \ + if (pad == L_('0')) \ + memset_zero (p, _delta); \ + else \ + memset_space (p, _delta); \ + } \ + f; \ + advance (p, _n); \ + } \ + i += _incr; \ + } while (0) + +#if FPRINTFTIME +# define add1(C) add (1, fputc (C, p)) +#else +# define add1(C) add (1, *p = C) +#endif + +#if FPRINTFTIME +# define cpy(n, s) \ + add ((n), \ + if (to_lowcase) \ + fwrite_lowcase (p, (s), _n); \ + else if (to_uppcase) \ + fwrite_uppcase (p, (s), _n); \ + else \ + fwrite ((s), _n, 1, p)) +#else +# define cpy(n, s) \ + add ((n), \ + if (to_lowcase) \ + memcpy_lowcase (p, (s), _n LOCALE_ARG); \ + else if (to_uppcase) \ + memcpy_uppcase (p, (s), _n LOCALE_ARG); \ + else \ + MEMCPY ((void *) p, (void const *) (s), _n)) +#endif + +#ifdef COMPILE_WIDE +# ifndef USE_IN_EXTENDED_LOCALE_MODEL +# undef __mbsrtowcs_l +# define __mbsrtowcs_l(d, s, l, st, loc) __mbsrtowcs (d, s, l, st) +# endif +# define widen(os, ws, l) \ + { \ + mbstate_t __st; \ + const char *__s = os; \ + memset (&__st, '\0', sizeof (__st)); \ + l = __mbsrtowcs_l (NULL, &__s, 0, &__st, loc); \ + ws = (wchar_t *) alloca ((l + 1) * sizeof (wchar_t)); \ + (void) __mbsrtowcs_l (ws, &__s, l, &__st, loc); \ + } +#endif + + +#if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL +/* We use this code also for the extended locale handling where the + function gets as an additional argument the locale which has to be + used. To access the values we have to redefine the _NL_CURRENT + macro. */ +# define strftime __strftime_l +# define wcsftime __wcsftime_l +# undef _NL_CURRENT +# define _NL_CURRENT(category, item) \ + (current->values[_NL_ITEM_INDEX (item)].string) +# define LOCALE_ARG , loc +# define LOCALE_PARAM_PROTO , __locale_t loc +# define HELPER_LOCALE_ARG , current +#else +# define LOCALE_PARAM_PROTO +# define LOCALE_ARG +# ifdef _LIBC +# define HELPER_LOCALE_ARG , _NL_CURRENT_DATA (LC_TIME) +# else +# define HELPER_LOCALE_ARG +# endif +#endif + +#ifdef COMPILE_WIDE +# ifdef USE_IN_EXTENDED_LOCALE_MODEL +# define TOUPPER(Ch, L) __towupper_l (Ch, L) +# define TOLOWER(Ch, L) __towlower_l (Ch, L) +# else +# define TOUPPER(Ch, L) towupper (Ch) +# define TOLOWER(Ch, L) towlower (Ch) +# endif +#else +# ifdef USE_IN_EXTENDED_LOCALE_MODEL +# define TOUPPER(Ch, L) __toupper_l (Ch, L) +# define TOLOWER(Ch, L) __tolower_l (Ch, L) +# else +# define TOUPPER(Ch, L) toupper (Ch) +# define TOLOWER(Ch, L) tolower (Ch) +# endif +#endif +/* We don't use `isdigit' here since the locale dependent + interpretation is not what we want here. We only need to accept + the arabic digits in the ASCII range. One day there is perhaps a + more reliable way to accept other sets of digits. */ +#define ISDIGIT(Ch) ((unsigned int) (Ch) - L_('0') <= 9) + +#if FPRINTFTIME +static void +fwrite_lowcase (FILE *fp, const CHAR_T *src, size_t len) +{ + while (len-- > 0) + { + fputc (TOLOWER ((UCHAR_T) *src, loc), fp); + ++src; + } +} + +static void +fwrite_uppcase (FILE *fp, const CHAR_T *src, size_t len) +{ + while (len-- > 0) + { + fputc (TOUPPER ((UCHAR_T) *src, loc), fp); + ++src; + } +} +#else +static CHAR_T * +memcpy_lowcase (CHAR_T *dest, const CHAR_T *src, + size_t len LOCALE_PARAM_PROTO) +{ + while (len-- > 0) + dest[len] = TOLOWER ((UCHAR_T) src[len], loc); + return dest; +} + +static CHAR_T * +memcpy_uppcase (CHAR_T *dest, const CHAR_T *src, + size_t len LOCALE_PARAM_PROTO) +{ + while (len-- > 0) + dest[len] = TOUPPER ((UCHAR_T) src[len], loc); + return dest; +} +#endif + + +#if ! HAVE_TM_GMTOFF +/* Yield the difference between *A and *B, + measured in seconds, ignoring leap seconds. */ +# define tm_diff ftime_tm_diff +static int +tm_diff (const struct tm *a, const struct tm *b) +{ + /* Compute intervening leap days correctly even if year is negative. + Take care to avoid int overflow in leap day calculations, + but it's OK to assume that A and B are close to each other. */ + int a4 = SHR (a->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (a->tm_year & 3); + int b4 = SHR (b->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (b->tm_year & 3); + int a100 = a4 / 25 - (a4 % 25 < 0); + int b100 = b4 / 25 - (b4 % 25 < 0); + int a400 = SHR (a100, 2); + int b400 = SHR (b100, 2); + int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400); + int years = a->tm_year - b->tm_year; + int days = (365 * years + intervening_leap_days + + (a->tm_yday - b->tm_yday)); + return (60 * (60 * (24 * days + (a->tm_hour - b->tm_hour)) + + (a->tm_min - b->tm_min)) + + (a->tm_sec - b->tm_sec)); +} +#endif /* ! HAVE_TM_GMTOFF */ + + + +/* The number of days from the first day of the first ISO week of this + year to the year day YDAY with week day WDAY. ISO weeks start on + Monday; the first ISO week has the year's first Thursday. YDAY may + be as small as YDAY_MINIMUM. */ +#define ISO_WEEK_START_WDAY 1 /* Monday */ +#define ISO_WEEK1_WDAY 4 /* Thursday */ +#define YDAY_MINIMUM (-366) +#ifdef __GNUC__ +__inline__ +#endif +static int +iso_week_days (int yday, int wday) +{ + /* Add enough to the first operand of % to make it nonnegative. */ + int big_enough_multiple_of_7 = (-YDAY_MINIMUM / 7 + 2) * 7; + return (yday + - (yday - wday + ISO_WEEK1_WDAY + big_enough_multiple_of_7) % 7 + + ISO_WEEK1_WDAY - ISO_WEEK_START_WDAY); +} + + +/* When compiling this file, GNU applications can #define my_strftime + to a symbol (typically nstrftime) to get an extended strftime with + extra arguments UT and NS. Emacs is a special case for now, but + this Emacs-specific code can be removed once Emacs's config.h + defines my_strftime. */ +#if defined emacs && !defined my_strftime +# define my_strftime nstrftime +#endif + +#if FPRINTFTIME +# undef my_strftime +# define my_strftime fprintftime +#endif + +#ifdef my_strftime +# define extra_args , ut, ns +# define extra_args_spec , int ut, int ns +#else +# if defined COMPILE_WIDE +# define my_strftime wcsftime +# define nl_get_alt_digit _nl_get_walt_digit +# else +# define my_strftime strftime +# define nl_get_alt_digit _nl_get_alt_digit +# endif +# define extra_args +# define extra_args_spec +/* We don't have this information in general. */ +# define ut 0 +# define ns 0 +#endif + + +/* Just like my_strftime, below, but with one more parameter, UPCASE, + to indicate that the result should be converted to upper case. */ +static size_t +strftime_case_ (bool upcase, STREAM_OR_CHAR_T *s, + STRFTIME_ARG (size_t maxsize) + const CHAR_T *format, + const struct tm *tp extra_args_spec LOCALE_PARAM_PROTO) +{ +#if defined _LIBC && defined USE_IN_EXTENDED_LOCALE_MODEL + struct locale_data *const current = loc->__locales[LC_TIME]; +#endif +#if FPRINTFTIME + size_t maxsize = (size_t) -1; +#endif + + int hour12 = tp->tm_hour; +#ifdef _NL_CURRENT + /* We cannot make the following values variables since we must delay + the evaluation of these values until really needed since some + expressions might not be valid in every situation. The `struct tm' + might be generated by a strptime() call that initialized + only a few elements. Dereference the pointers only if the format + requires this. Then it is ok to fail if the pointers are invalid. */ +# define a_wkday \ + ((const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ABDAY_1) + tp->tm_wday)) +# define f_wkday \ + ((const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(DAY_1) + tp->tm_wday)) +# define a_month \ + ((const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ABMON_1) + tp->tm_mon)) +# define f_month \ + ((const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(MON_1) + tp->tm_mon)) +# define ampm \ + ((const CHAR_T *) _NL_CURRENT (LC_TIME, tp->tm_hour > 11 \ + ? NLW(PM_STR) : NLW(AM_STR))) + +# define aw_len STRLEN (a_wkday) +# define am_len STRLEN (a_month) +# define ap_len STRLEN (ampm) +#endif + const char *zone; + size_t i = 0; + STREAM_OR_CHAR_T *p = s; + const CHAR_T *f; +#if DO_MULTIBYTE && !defined COMPILE_WIDE + const char *format_end = NULL; +#endif + +#if ! defined _LIBC && ! HAVE_RUN_TZSET_TEST + /* Solaris 2.5.x and 2.6 tzset sometimes modify the storage returned + by localtime. On such systems, we must either use the tzset and + localtime wrappers to work around the bug (which sets + HAVE_RUN_TZSET_TEST) or make a copy of the structure. */ + struct tm copy = *tp; + tp = © +#endif + + zone = NULL; +#if HAVE_TM_ZONE + /* The POSIX test suite assumes that setting + the environment variable TZ to a new value before calling strftime() + will influence the result (the %Z format) even if the information in + TP is computed with a totally different time zone. + This is bogus: though POSIX allows bad behavior like this, + POSIX does not require it. Do the right thing instead. */ + zone = (const char *) tp->tm_zone; +#endif +#if HAVE_TZNAME + if (ut) + { + if (! (zone && *zone)) + zone = "GMT"; + } + else + { + /* POSIX.1 requires that local time zone information be used as + though strftime called tzset. */ +# if HAVE_TZSET + tzset (); +# endif + } +#endif + + if (hour12 > 12) + hour12 -= 12; + else + if (hour12 == 0) + hour12 = 12; + + for (f = format; *f != '\0'; ++f) + { + int pad = 0; /* Padding for number ('-', '_', or 0). */ + int modifier; /* Field modifier ('E', 'O', or 0). */ + int digits = 0; /* Max digits for numeric format. */ + int number_value; /* Numeric value to be printed. */ + unsigned int u_number_value; /* (unsigned int) number_value. */ + bool negative_number; /* The number is negative. */ + bool always_output_a_sign; /* +/- should always be output. */ + int tz_colon_mask; /* Bitmask of where ':' should appear. */ + const CHAR_T *subfmt; + CHAR_T sign_char; + CHAR_T *bufp; + CHAR_T buf[1 + + 2 /* for the two colons in a %::z or %:::z time zone */ + + (sizeof (int) < sizeof (time_t) + ? INT_STRLEN_BOUND (time_t) + : INT_STRLEN_BOUND (int))]; + int width = -1; + bool to_lowcase = false; + bool to_uppcase = upcase; + size_t colons; + bool change_case = false; + int format_char; + +#if DO_MULTIBYTE && !defined COMPILE_WIDE + switch (*f) + { + case L_('%'): + break; + + case L_('\b'): case L_('\t'): case L_('\n'): + case L_('\v'): case L_('\f'): case L_('\r'): + case L_(' '): case L_('!'): case L_('"'): case L_('#'): case L_('&'): + case L_('\''): case L_('('): case L_(')'): case L_('*'): case L_('+'): + case L_(','): case L_('-'): case L_('.'): case L_('/'): case L_('0'): + case L_('1'): case L_('2'): case L_('3'): case L_('4'): case L_('5'): + case L_('6'): case L_('7'): case L_('8'): case L_('9'): case L_(':'): + case L_(';'): case L_('<'): case L_('='): case L_('>'): case L_('?'): + case L_('A'): case L_('B'): case L_('C'): case L_('D'): case L_('E'): + case L_('F'): case L_('G'): case L_('H'): case L_('I'): case L_('J'): + case L_('K'): case L_('L'): case L_('M'): case L_('N'): case L_('O'): + case L_('P'): case L_('Q'): case L_('R'): case L_('S'): case L_('T'): + case L_('U'): case L_('V'): case L_('W'): case L_('X'): case L_('Y'): + case L_('Z'): case L_('['): case L_('\\'): case L_(']'): case L_('^'): + case L_('_'): case L_('a'): case L_('b'): case L_('c'): case L_('d'): + case L_('e'): case L_('f'): case L_('g'): case L_('h'): case L_('i'): + case L_('j'): case L_('k'): case L_('l'): case L_('m'): case L_('n'): + case L_('o'): case L_('p'): case L_('q'): case L_('r'): case L_('s'): + case L_('t'): case L_('u'): case L_('v'): case L_('w'): case L_('x'): + case L_('y'): case L_('z'): case L_('{'): case L_('|'): case L_('}'): + case L_('~'): + /* The C Standard requires these 98 characters (plus '%') to + be in the basic execution character set. None of these + characters can start a multibyte sequence, so they need + not be analyzed further. */ + add1 (*f); + continue; + + default: + /* Copy this multibyte sequence until we reach its end, find + an error, or come back to the initial shift state. */ + { + mbstate_t mbstate = mbstate_zero; + size_t len = 0; + size_t fsize; + + if (! format_end) + format_end = f + strlen (f) + 1; + fsize = format_end - f; + + do + { + size_t bytes = mbrlen (f + len, fsize - len, &mbstate); + + if (bytes == 0) + break; + + if (bytes == (size_t) -2) + { + len += strlen (f + len); + break; + } + + if (bytes == (size_t) -1) + { + len++; + break; + } + + len += bytes; + } + while (! mbsinit (&mbstate)); + + cpy (len, f); + f += len - 1; + continue; + } + } + +#else /* ! DO_MULTIBYTE */ + + /* Either multibyte encodings are not supported, they are + safe for formats, so any non-'%' byte can be copied through, + or this is the wide character version. */ + if (*f != L_('%')) + { + add1 (*f); + continue; + } + +#endif /* ! DO_MULTIBYTE */ + + /* Check for flags that can modify a format. */ + while (1) + { + switch (*++f) + { + /* This influences the number formats. */ + case L_('_'): + case L_('-'): + case L_('0'): + pad = *f; + continue; + + /* This changes textual output. */ + case L_('^'): + to_uppcase = true; + continue; + case L_('#'): + change_case = true; + continue; + + default: + break; + } + break; + } + + /* As a GNU extension we allow to specify the field width. */ + if (ISDIGIT (*f)) + { + width = 0; + do + { + if (width > INT_MAX / 10 + || (width == INT_MAX / 10 && *f - L_('0') > INT_MAX % 10)) + /* Avoid overflow. */ + width = INT_MAX; + else + { + width *= 10; + width += *f - L_('0'); + } + ++f; + } + while (ISDIGIT (*f)); + } + + /* Check for modifiers. */ + switch (*f) + { + case L_('E'): + case L_('O'): + modifier = *f++; + break; + + default: + modifier = 0; + break; + } + + /* Now do the specified format. */ + format_char = *f; + switch (format_char) + { +#define DO_NUMBER(d, v) \ + digits = d; \ + number_value = v; goto do_number +#define DO_SIGNED_NUMBER(d, negative, v) \ + digits = d; \ + negative_number = negative; \ + u_number_value = v; goto do_signed_number + + /* The mask is not what you might think. + When the ordinal i'th bit is set, insert a colon + before the i'th digit of the time zone representation. */ +#define DO_TZ_OFFSET(d, negative, mask, v) \ + digits = d; \ + negative_number = negative; \ + tz_colon_mask = mask; \ + u_number_value = v; goto do_tz_offset +#define DO_NUMBER_SPACEPAD(d, v) \ + digits = d; \ + number_value = v; goto do_number_spacepad + + case L_('%'): + if (modifier != 0) + goto bad_format; + add1 (*f); + break; + + case L_('a'): + if (modifier != 0) + goto bad_format; + if (change_case) + { + to_uppcase = true; + to_lowcase = false; + } +#ifdef _NL_CURRENT + cpy (aw_len, a_wkday); + break; +#else + goto underlying_strftime; +#endif + + case 'A': + if (modifier != 0) + goto bad_format; + if (change_case) + { + to_uppcase = true; + to_lowcase = false; + } +#ifdef _NL_CURRENT + cpy (STRLEN (f_wkday), f_wkday); + break; +#else + goto underlying_strftime; +#endif + + case L_('b'): + case L_('h'): + if (change_case) + { + to_uppcase = true; + to_lowcase = false; + } + if (modifier != 0) + goto bad_format; +#ifdef _NL_CURRENT + cpy (am_len, a_month); + break; +#else + goto underlying_strftime; +#endif + + case L_('B'): + if (modifier != 0) + goto bad_format; + if (change_case) + { + to_uppcase = true; + to_lowcase = false; + } +#ifdef _NL_CURRENT + cpy (STRLEN (f_month), f_month); + break; +#else + goto underlying_strftime; +#endif + + case L_('c'): + if (modifier == L_('O')) + goto bad_format; +#ifdef _NL_CURRENT + if (! (modifier == 'E' + && (*(subfmt = + (const CHAR_T *) _NL_CURRENT (LC_TIME, + NLW(ERA_D_T_FMT))) + != '\0'))) + subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_T_FMT)); +#else + goto underlying_strftime; +#endif + + subformat: + { + size_t len = strftime_case_ (to_uppcase, + NULL, STRFTIME_ARG ((size_t) -1) + subfmt, + tp extra_args LOCALE_ARG); + add (len, strftime_case_ (to_uppcase, p, + STRFTIME_ARG (maxsize - i) + subfmt, + tp extra_args LOCALE_ARG)); + } + break; + +#if !(defined _NL_CURRENT && HAVE_STRUCT_ERA_ENTRY) + underlying_strftime: + { + /* The relevant information is available only via the + underlying strftime implementation, so use that. */ + char ufmt[5]; + char *u = ufmt; + char ubuf[1024]; /* enough for any single format in practice */ + size_t len; + /* Make sure we're calling the actual underlying strftime. + In some cases, config.h contains something like + "#define strftime rpl_strftime". */ +# ifdef strftime +# undef strftime + size_t strftime (); +# endif + + /* The space helps distinguish strftime failure from empty + output. */ + *u++ = ' '; + *u++ = '%'; + if (modifier != 0) + *u++ = modifier; + *u++ = format_char; + *u = '\0'; + len = strftime (ubuf, sizeof ubuf, ufmt, tp); + if (len != 0) + cpy (len - 1, ubuf + 1); + } + break; +#endif + + case L_('C'): + if (modifier == L_('O')) + goto bad_format; + if (modifier == L_('E')) + { +#if HAVE_STRUCT_ERA_ENTRY + struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); + if (era) + { +# ifdef COMPILE_WIDE + size_t len = __wcslen (era->era_wname); + cpy (len, era->era_wname); +# else + size_t len = strlen (era->era_name); + cpy (len, era->era_name); +# endif + break; + } +#else + goto underlying_strftime; +#endif + } + + { + int century = tp->tm_year / 100 + TM_YEAR_BASE / 100; + century -= tp->tm_year % 100 < 0 && 0 < century; + DO_SIGNED_NUMBER (2, tp->tm_year < - TM_YEAR_BASE, century); + } + + case L_('x'): + if (modifier == L_('O')) + goto bad_format; +#ifdef _NL_CURRENT + if (! (modifier == L_('E') + && (*(subfmt = + (const CHAR_T *)_NL_CURRENT (LC_TIME, NLW(ERA_D_FMT))) + != L_('\0')))) + subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(D_FMT)); + goto subformat; +#else + goto underlying_strftime; +#endif + case L_('D'): + if (modifier != 0) + goto bad_format; + subfmt = L_("%m/%d/%y"); + goto subformat; + + case L_('d'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, tp->tm_mday); + + case L_('e'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER_SPACEPAD (2, tp->tm_mday); + + /* All numeric formats set DIGITS and NUMBER_VALUE (or U_NUMBER_VALUE) + and then jump to one of these labels. */ + + do_tz_offset: + always_output_a_sign = true; + goto do_number_body; + + do_number_spacepad: + /* Force `_' flag unless overridden by `0' or `-' flag. */ + if (pad != L_('0') && pad != L_('-')) + pad = L_('_'); + + do_number: + /* Format NUMBER_VALUE according to the MODIFIER flag. */ + negative_number = number_value < 0; + u_number_value = number_value; + + do_signed_number: + always_output_a_sign = false; + tz_colon_mask = 0; + + do_number_body: + /* Format U_NUMBER_VALUE according to the MODIFIER flag. + NEGATIVE_NUMBER is nonzero if the original number was + negative; in this case it was converted directly to + unsigned int (i.e., modulo (UINT_MAX + 1)) without + negating it. */ + if (modifier == L_('O') && !negative_number) + { +#ifdef _NL_CURRENT + /* Get the locale specific alternate representation of + the number. If none exist NULL is returned. */ + const CHAR_T *cp = nl_get_alt_digit (u_number_value + HELPER_LOCALE_ARG); + + if (cp != NULL) + { + size_t digitlen = STRLEN (cp); + if (digitlen != 0) + { + cpy (digitlen, cp); + break; + } + } +#else + goto underlying_strftime; +#endif + } + + bufp = buf + sizeof (buf) / sizeof (buf[0]); + + if (negative_number) + u_number_value = - u_number_value; + + do + { + if (tz_colon_mask & 1) + *--bufp = ':'; + tz_colon_mask >>= 1; + *--bufp = u_number_value % 10 + L_('0'); + u_number_value /= 10; + } + while (u_number_value != 0 || tz_colon_mask != 0); + + do_number_sign_and_padding: + if (digits < width) + digits = width; + + sign_char = (negative_number ? L_('-') + : always_output_a_sign ? L_('+') + : 0); + + if (pad == L_('-')) + { + if (sign_char) + add1 (sign_char); + } + else + { + int padding = digits - (buf + (sizeof (buf) / sizeof (buf[0])) + - bufp) - !!sign_char; + + if (padding > 0) + { + if (pad == L_('_')) + { + if ((size_t) padding >= maxsize - i) + return 0; + + if (p) + memset_space (p, padding); + i += padding; + width = width > padding ? width - padding : 0; + if (sign_char) + add1 (sign_char); + } + else + { + if ((size_t) digits >= maxsize - i) + return 0; + + if (sign_char) + add1 (sign_char); + + if (p) + memset_zero (p, padding); + i += padding; + width = 0; + } + } + else + { + if (sign_char) + add1 (sign_char); + } + } + + cpy (buf + sizeof (buf) / sizeof (buf[0]) - bufp, bufp); + break; + + case L_('F'): + if (modifier != 0) + goto bad_format; + subfmt = L_("%Y-%m-%d"); + goto subformat; + + case L_('H'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, tp->tm_hour); + + case L_('I'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, hour12); + + case L_('k'): /* GNU extension. */ + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER_SPACEPAD (2, tp->tm_hour); + + case L_('l'): /* GNU extension. */ + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER_SPACEPAD (2, hour12); + + case L_('j'): + if (modifier == L_('E')) + goto bad_format; + + DO_SIGNED_NUMBER (3, tp->tm_yday < -1, tp->tm_yday + 1U); + + case L_('M'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, tp->tm_min); + + case L_('m'): + if (modifier == L_('E')) + goto bad_format; + + DO_SIGNED_NUMBER (2, tp->tm_mon < -1, tp->tm_mon + 1U); + +#ifndef _LIBC + case L_('N'): /* GNU extension. */ + if (modifier == L_('E')) + goto bad_format; + + number_value = ns; + if (width == -1) + width = 9; + else + { + /* Take an explicit width less than 9 as a precision. */ + int j; + for (j = width; j < 9; j++) + number_value /= 10; + } + + DO_NUMBER (width, number_value); +#endif + + case L_('n'): + add1 (L_('\n')); + break; + + case L_('P'): + to_lowcase = true; +#ifndef _NL_CURRENT + format_char = L_('p'); +#endif + /* FALLTHROUGH */ + + case L_('p'): + if (change_case) + { + to_uppcase = false; + to_lowcase = true; + } +#ifdef _NL_CURRENT + cpy (ap_len, ampm); + break; +#else + goto underlying_strftime; +#endif + + case L_('R'): + subfmt = L_("%H:%M"); + goto subformat; + + case L_('r'): +#ifdef _NL_CURRENT + if (*(subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, + NLW(T_FMT_AMPM))) + == L_('\0')) + subfmt = L_("%I:%M:%S %p"); + goto subformat; +#else + goto underlying_strftime; +#endif + + case L_('S'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, tp->tm_sec); + + case L_('s'): /* GNU extension. */ + { + struct tm ltm; + time_t t; + + ltm = *tp; + t = mktime (<m); + + /* Generate string value for T using time_t arithmetic; + this works even if sizeof (long) < sizeof (time_t). */ + + bufp = buf + sizeof (buf) / sizeof (buf[0]); + negative_number = t < 0; + + do + { + int d = t % 10; + t /= 10; + *--bufp = (negative_number ? -d : d) + L_('0'); + } + while (t != 0); + + digits = 1; + always_output_a_sign = false; + goto do_number_sign_and_padding; + } + + case L_('X'): + if (modifier == L_('O')) + goto bad_format; +#ifdef _NL_CURRENT + if (! (modifier == L_('E') + && (*(subfmt = + (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(ERA_T_FMT))) + != L_('\0')))) + subfmt = (const CHAR_T *) _NL_CURRENT (LC_TIME, NLW(T_FMT)); + goto subformat; +#else + goto underlying_strftime; +#endif + case L_('T'): + subfmt = L_("%H:%M:%S"); + goto subformat; + + case L_('t'): + add1 (L_('\t')); + break; + + case L_('u'): + DO_NUMBER (1, (tp->tm_wday - 1 + 7) % 7 + 1); + + case L_('U'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, (tp->tm_yday - tp->tm_wday + 7) / 7); + + case L_('V'): + case L_('g'): + case L_('G'): + if (modifier == L_('E')) + goto bad_format; + { + /* YEAR is a leap year if and only if (tp->tm_year + TM_YEAR_BASE) + is a leap year, except that YEAR and YEAR - 1 both work + correctly even when (tp->tm_year + TM_YEAR_BASE) would + overflow. */ + int year = (tp->tm_year + + (tp->tm_year < 0 + ? TM_YEAR_BASE % 400 + : TM_YEAR_BASE % 400 - 400)); + int year_adjust = 0; + int days = iso_week_days (tp->tm_yday, tp->tm_wday); + + if (days < 0) + { + /* This ISO week belongs to the previous year. */ + year_adjust = -1; + days = iso_week_days (tp->tm_yday + (365 + __isleap (year - 1)), + tp->tm_wday); + } + else + { + int d = iso_week_days (tp->tm_yday - (365 + __isleap (year)), + tp->tm_wday); + if (0 <= d) + { + /* This ISO week belongs to the next year. */ + year_adjust = 1; + days = d; + } + } + + switch (*f) + { + case L_('g'): + { + int yy = (tp->tm_year % 100 + year_adjust) % 100; + DO_NUMBER (2, (0 <= yy + ? yy + : tp->tm_year < -TM_YEAR_BASE - year_adjust + ? -yy + : yy + 100)); + } + + case L_('G'): + DO_SIGNED_NUMBER (4, tp->tm_year < -TM_YEAR_BASE - year_adjust, + (tp->tm_year + (unsigned int) TM_YEAR_BASE + + year_adjust)); + + default: + DO_NUMBER (2, days / 7 + 1); + } + } + + case L_('W'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (2, (tp->tm_yday - (tp->tm_wday - 1 + 7) % 7 + 7) / 7); + + case L_('w'): + if (modifier == L_('E')) + goto bad_format; + + DO_NUMBER (1, tp->tm_wday); + + case L_('Y'): + if (modifier == 'E') + { +#if HAVE_STRUCT_ERA_ENTRY + struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); + if (era) + { +# ifdef COMPILE_WIDE + subfmt = era->era_wformat; +# else + subfmt = era->era_format; +# endif + goto subformat; + } +#else + goto underlying_strftime; +#endif + } + if (modifier == L_('O')) + goto bad_format; + else + DO_SIGNED_NUMBER (4, tp->tm_year < -TM_YEAR_BASE, + tp->tm_year + (unsigned int) TM_YEAR_BASE); + + case L_('y'): + if (modifier == L_('E')) + { +#if HAVE_STRUCT_ERA_ENTRY + struct era_entry *era = _nl_get_era_entry (tp HELPER_LOCALE_ARG); + if (era) + { + int delta = tp->tm_year - era->start_date[0]; + DO_NUMBER (1, (era->offset + + delta * era->absolute_direction)); + } +#else + goto underlying_strftime; +#endif + } + + { + int yy = tp->tm_year % 100; + if (yy < 0) + yy = tp->tm_year < - TM_YEAR_BASE ? -yy : yy + 100; + DO_NUMBER (2, yy); + } + + case L_('Z'): + if (change_case) + { + to_uppcase = false; + to_lowcase = true; + } + +#if HAVE_TZNAME + /* The tzset() call might have changed the value. */ + if (!(zone && *zone) && tp->tm_isdst >= 0) + zone = tzname[tp->tm_isdst != 0]; +#endif + if (! zone) + zone = ""; + +#ifdef COMPILE_WIDE + { + /* The zone string is always given in multibyte form. We have + to transform it first. */ + wchar_t *wczone; + size_t len; + widen (zone, wczone, len); + cpy (len, wczone); + } +#else + cpy (strlen (zone), zone); +#endif + break; + + case L_(':'): + /* :, ::, and ::: are valid only just before 'z'. + :::: etc. are rejected later. */ + for (colons = 1; f[colons] == L_(':'); colons++) + continue; + if (f[colons] != L_('z')) + goto bad_format; + f += colons; + goto do_z_conversion; + + case L_('z'): + colons = 0; + + do_z_conversion: + if (tp->tm_isdst < 0) + break; + + { + int diff; + int hour_diff; + int min_diff; + int sec_diff; +#if HAVE_TM_GMTOFF + diff = tp->tm_gmtoff; +#else + if (ut) + diff = 0; + else + { + struct tm gtm; + struct tm ltm; + time_t lt; + + ltm = *tp; + lt = mktime (<m); + + if (lt == (time_t) -1) + { + /* mktime returns -1 for errors, but -1 is also a + valid time_t value. Check whether an error really + occurred. */ + struct tm tm; + + if (! __localtime_r (<, &tm) + || ((ltm.tm_sec ^ tm.tm_sec) + | (ltm.tm_min ^ tm.tm_min) + | (ltm.tm_hour ^ tm.tm_hour) + | (ltm.tm_mday ^ tm.tm_mday) + | (ltm.tm_mon ^ tm.tm_mon) + | (ltm.tm_year ^ tm.tm_year))) + break; + } + + if (! __gmtime_r (<, >m)) + break; + + diff = tm_diff (<m, >m); + } +#endif + + hour_diff = diff / 60 / 60; + min_diff = diff / 60 % 60; + sec_diff = diff % 60; + + switch (colons) + { + case 0: /* +hhmm */ + DO_TZ_OFFSET (5, diff < 0, 0, hour_diff * 100 + min_diff); + + case 1: tz_hh_mm: /* +hh:mm */ + DO_TZ_OFFSET (6, diff < 0, 04, hour_diff * 100 + min_diff); + + case 2: tz_hh_mm_ss: /* +hh:mm:ss */ + DO_TZ_OFFSET (9, diff < 0, 024, + hour_diff * 10000 + min_diff * 100 + sec_diff); + + case 3: /* +hh if possible, else +hh:mm, else +hh:mm:ss */ + if (sec_diff != 0) + goto tz_hh_mm_ss; + if (min_diff != 0) + goto tz_hh_mm; + DO_TZ_OFFSET (3, diff < 0, 0, hour_diff); + + default: + goto bad_format; + } + } + + case L_('\0'): /* GNU extension: % at end of format. */ + --f; + /* Fall through. */ + default: + /* Unknown format; output the format, including the '%', + since this is most likely the right thing to do if a + multibyte string has been misparsed. */ + bad_format: + { + int flen; + for (flen = 1; f[1 - flen] != L_('%'); flen++) + continue; + cpy (flen, &f[1 - flen]); + } + break; + } + } + +#if ! FPRINTFTIME + if (p && maxsize != 0) + *p = L_('\0'); +#endif + + return i; +} + +/* Write information from TP into S according to the format + string FORMAT, writing no more that MAXSIZE characters + (including the terminating '\0') and returning number of + characters written. If S is NULL, nothing will be written + anywhere, so to determine how many characters would be + written, use NULL for S and (size_t) -1 for MAXSIZE. */ +size_t +my_strftime (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) + const CHAR_T *format, + const struct tm *tp extra_args_spec LOCALE_PARAM_PROTO) +{ + return strftime_case_ (false, s, STRFTIME_ARG (maxsize) + format, tp extra_args LOCALE_ARG); +} + +#if defined _LIBC && ! FPRINTFTIME +libc_hidden_def (my_strftime) +#endif + + +#if defined emacs && ! FPRINTFTIME +/* For Emacs we have a separate interface which corresponds to the normal + strftime function plus the ut argument, but without the ns argument. */ +size_t +emacs_strftimeu (char *s, size_t maxsize, const char *format, + const struct tm *tp, int ut) +{ + return my_strftime (s, maxsize, format, tp, ut, 0); +} +#endif diff --git a/lib/strftime.h b/lib/strftime.h new file mode 100644 index 000000000..fded6d0dc --- /dev/null +++ b/lib/strftime.h @@ -0,0 +1,26 @@ +/* declarations for strftime.c + + Copyright (C) 2002, 2004, 2008 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program. If not, see <http://www.gnu.org/licenses/>. */ + +#include <time.h> + +/* Just like strftime, but with two more arguments: + POSIX requires that strftime use the local timezone information. + When __UTC is nonzero and tm->tm_zone is NULL or the empty string, + use UTC instead. Use __NS as the number of nanoseconds in the + %N directive. */ +size_t nstrftime (char *, size_t, char const *, struct tm const *, + int __utc, int __ns); diff --git a/lib/strings.in.h b/lib/strings.in.h new file mode 100644 index 000000000..7344d6008 --- /dev/null +++ b/lib/strings.in.h @@ -0,0 +1,88 @@ +/* A substitute <strings.h>. + + Copyright (C) 2007-2008 Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 2, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +#ifndef _GL_STRINGS_H + +@PRAGMA_SYSTEM_HEADER@ + +/* The include_next requires a split double-inclusion guard. */ +#@INCLUDE_NEXT@ @NEXT_STRINGS_H@ + +#ifndef _GL_STRINGS_H +#define _GL_STRINGS_H + + +/* The definition of GL_LINK_WARNING is copied here. */ + + +#ifdef __cplusplus +extern "C" { +#endif + + +/* Compare strings S1 and S2, ignoring case, returning less than, equal to or + greater than zero if S1 is lexicographically less than, equal to or greater + than S2. + Note: This function does not work in multibyte locales. */ +#if ! @HAVE_STRCASECMP@ +extern int strcasecmp (char const *s1, char const *s2); +#endif +#if defined GNULIB_POSIXCHECK +/* strcasecmp() does not work with multibyte strings: + POSIX says that it operates on "strings", and "string" in POSIX is defined + as a sequence of bytes, not of characters. */ +# undef strcasecmp +# define strcasecmp(a,b) \ + (GL_LINK_WARNING ("strcasecmp cannot work correctly on character strings " \ + "in multibyte locales - " \ + "use mbscasecmp if you care about " \ + "internationalization, or use c_strcasecmp (from " \ + "gnulib module c-strcase) if you want a locale " \ + "independent function"), \ + strcasecmp (a, b)) +#endif + +/* Compare no more than N bytes of strings S1 and S2, ignoring case, + returning less than, equal to or greater than zero if S1 is + lexicographically less than, equal to or greater than S2. + Note: This function cannot work correctly in multibyte locales. */ +#if ! @HAVE_DECL_STRNCASECMP@ +extern int strncasecmp (char const *s1, char const *s2, size_t n); +#endif +#if defined GNULIB_POSIXCHECK +/* strncasecmp() does not work with multibyte strings: + POSIX says that it operates on "strings", and "string" in POSIX is defined + as a sequence of bytes, not of characters. */ +# undef strncasecmp +# define strncasecmp(a,b,n) \ + (GL_LINK_WARNING ("strncasecmp cannot work correctly on character " \ + "strings in multibyte locales - " \ + "use mbsncasecmp or mbspcasecmp if you care about " \ + "internationalization, or use c_strncasecmp (from " \ + "gnulib module c-strcase) if you want a locale " \ + "independent function"), \ + strncasecmp (a, b, n)) +#endif + + +#ifdef __cplusplus +} +#endif + +#endif /* _GL_STRING_H */ +#endif /* _GL_STRING_H */ diff --git a/lib/strncasecmp.c b/lib/strncasecmp.c new file mode 100644 index 000000000..3386ce2a8 --- /dev/null +++ b/lib/strncasecmp.c @@ -0,0 +1,63 @@ +/* strncasecmp.c -- case insensitive string comparator + Copyright (C) 1998-1999, 2005-2007 Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 2, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +#include <config.h> + +/* Specification. */ +#include <string.h> + +#include <ctype.h> +#include <limits.h> + +#define TOLOWER(Ch) (isupper (Ch) ? tolower (Ch) : (Ch)) + +/* Compare no more than N bytes of strings S1 and S2, ignoring case, + returning less than, equal to or greater than zero if S1 is + lexicographically less than, equal to or greater than S2. + Note: This function cannot work correctly in multibyte locales. */ + +int +strncasecmp (const char *s1, const char *s2, size_t n) +{ + register const unsigned char *p1 = (const unsigned char *) s1; + register const unsigned char *p2 = (const unsigned char *) s2; + unsigned char c1, c2; + + if (p1 == p2 || n == 0) + return 0; + + do + { + c1 = TOLOWER (*p1); + c2 = TOLOWER (*p2); + + if (--n == 0 || c1 == '\0') + break; + + ++p1; + ++p2; + } + while (c1 == c2); + + if (UCHAR_MAX <= INT_MAX) + return c1 - c2; + else + /* On machines where 'char' and 'int' are types of the same size, the + difference of two 'unsigned char' values - including the sign bit - + doesn't fit in an 'int'. */ + return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0); +} diff --git a/lib/time.in.h b/lib/time.in.h new file mode 100644 index 000000000..fea9d40a8 --- /dev/null +++ b/lib/time.in.h @@ -0,0 +1,116 @@ +/* A more-standard <time.h>. + + Copyright (C) 2007-2008 Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 2, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +@PRAGMA_SYSTEM_HEADER@ + +/* Don't get in the way of glibc when it includes time.h merely to + declare a few standard symbols, rather than to declare all the + symbols. Also, Solaris 8 <time.h> eventually includes itself + recursively; if that is happening, just include the system <time.h> + without adding our own declarations. */ +#if (defined __need_time_t || defined __need_clock_t \ + || defined __need_timespec \ + || defined _GL_TIME_H) + +# @INCLUDE_NEXT@ @NEXT_TIME_H@ + +#else + +# define _GL_TIME_H + +# @INCLUDE_NEXT@ @NEXT_TIME_H@ + +# ifdef __cplusplus +extern "C" { +# endif + +/* Some systems don't define struct timespec (e.g., AIX 4.1, Ultrix 4.3). + Or they define it with the wrong member names or define it in <sys/time.h> + (e.g., FreeBSD circa 1997). */ +# if ! @TIME_H_DEFINES_STRUCT_TIMESPEC@ +# if @SYS_TIME_H_DEFINES_STRUCT_TIMESPEC@ +# include <sys/time.h> +# else +# undef timespec +# define timespec rpl_timespec +struct timespec +{ + time_t tv_sec; + long int tv_nsec; +}; +# endif +# endif + +/* Sleep for at least RQTP seconds unless interrupted, If interrupted, + return -1 and store the remaining time into RMTP. See + <http://www.opengroup.org/susv3xsh/nanosleep.html>. */ +# if @REPLACE_NANOSLEEP@ +# define nanosleep rpl_nanosleep +int nanosleep (struct timespec const *__rqtp, struct timespec *__rmtp); +# endif + +/* Convert TIMER to RESULT, assuming local time and UTC respectively. See + <http://www.opengroup.org/susv3xsh/localtime_r.html> and + <http://www.opengroup.org/susv3xsh/gmtime_r.html>. */ +# if @REPLACE_LOCALTIME_R@ +# undef localtime_r +# define localtime_r rpl_localtime_r +# undef gmtime_r +# define gmtime_r rpl_gmtime_r +struct tm *localtime_r (time_t const *restrict __timer, + struct tm *restrict __result); +struct tm *gmtime_r (time_t const *restrict __timer, + struct tm *restrict __result); +# endif + +/* Parse BUF as a time stamp, assuming FORMAT specifies its layout, and store + the resulting broken-down time into TM. See + <http://www.opengroup.org/susv3xsh/strptime.html>. */ +# if @REPLACE_STRPTIME@ +# undef strptime +# define strptime rpl_strptime +char *strptime (char const *restrict __buf, char const *restrict __format, + struct tm *restrict __tm); +# endif + +/* Convert TM to a time_t value, assuming UTC. */ +# if @REPLACE_TIMEGM@ +# undef timegm +# define timegm rpl_timegm +time_t timegm (struct tm *__tm); +# endif + +/* Encourage applications to avoid unsafe functions that can overrun + buffers when given outlandish struct tm values. Portable + applications should use strftime (or even sprintf) instead. */ +# if GNULIB_PORTCHECK +# undef asctime +# define asctime eschew_asctime +# undef asctime_r +# define asctime_r eschew_asctime_r +# undef ctime +# define ctime eschew_ctime +# undef ctime_r +# define ctime_r eschew_ctime_r +# endif + +# ifdef __cplusplus +} +# endif + +#endif diff --git a/lib/time_r.c b/lib/time_r.c new file mode 100644 index 000000000..90dcf00e0 --- /dev/null +++ b/lib/time_r.c @@ -0,0 +1,47 @@ +/* Reentrant time functions like localtime_r. + + Copyright (C) 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 Lesser General Public License as published by + the Free Software Foundation; either version 2, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License along + with this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +/* Written by Paul Eggert. */ + +#include <config.h> + +#include <time.h> + +#include <string.h> + +static struct tm * +copy_tm_result (struct tm *dest, struct tm const *src) +{ + if (! src) + return 0; + *dest = *src; + return dest; +} + + +struct tm * +gmtime_r (time_t const * restrict t, struct tm * restrict tp) +{ + return copy_tm_result (tp, gmtime (t)); +} + +struct tm * +localtime_r (time_t const * restrict t, struct tm * restrict tp) +{ + return copy_tm_result (tp, localtime (t)); +} diff --git a/lib/verify.h b/lib/verify.h new file mode 100644 index 000000000..e82fa02d9 --- /dev/null +++ b/lib/verify.h @@ -0,0 +1,140 @@ +/* Compile-time assert-like macros. + + Copyright (C) 2005, 2006 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program. If not, see <http://www.gnu.org/licenses/>. */ + +/* Written by Paul Eggert, Bruno Haible, and Jim Meyering. */ + +#ifndef VERIFY_H +# define VERIFY_H 1 + +/* Each of these macros verifies that its argument R is nonzero. To + be portable, R should be an integer constant expression. Unlike + assert (R), there is no run-time overhead. + + There are two macros, since no single macro can be used in all + contexts in C. verify_true (R) is for scalar contexts, including + integer constant expression contexts. verify (R) is for declaration + contexts, e.g., the top level. + + Symbols ending in "__" are private to this header. + + The code below uses several ideas. + + * The first step is ((R) ? 1 : -1). Given an expression R, of + integral or boolean or floating-point type, this yields an + expression of integral type, whose value is later verified to be + constant and nonnegative. + + * Next this expression W is wrapped in a type + struct verify_type__ { unsigned int verify_error_if_negative_size__: W; }. + If W is negative, this yields a compile-time error. No compiler can + deal with a bit-field of negative size. + + One might think that an array size check would have the same + effect, that is, that the type struct { unsigned int dummy[W]; } + would work as well. However, inside a function, some compilers + (such as C++ compilers and GNU C) allow local parameters and + variables inside array size expressions. With these compilers, + an array size check would not properly diagnose this misuse of + the verify macro: + + void function (int n) { verify (n < 0); } + + * For the verify macro, the struct verify_type__ will need to + somehow be embedded into a declaration. To be portable, this + declaration must declare an object, a constant, a function, or a + typedef name. If the declared entity uses the type directly, + such as in + + struct dummy {...}; + typedef struct {...} dummy; + extern struct {...} *dummy; + extern void dummy (struct {...} *); + extern struct {...} *dummy (void); + + two uses of the verify macro would yield colliding declarations + if the entity names are not disambiguated. A workaround is to + attach the current line number to the entity name: + + #define GL_CONCAT0(x, y) x##y + #define GL_CONCAT(x, y) GL_CONCAT0 (x, y) + extern struct {...} * GL_CONCAT(dummy,__LINE__); + + But this has the problem that two invocations of verify from + within the same macro would collide, since the __LINE__ value + would be the same for both invocations. + + A solution is to use the sizeof operator. It yields a number, + getting rid of the identity of the type. Declarations like + + extern int dummy [sizeof (struct {...})]; + extern void dummy (int [sizeof (struct {...})]); + extern int (*dummy (void)) [sizeof (struct {...})]; + + can be repeated. + + * Should the implementation use a named struct or an unnamed struct? + Which of the following alternatives can be used? + + extern int dummy [sizeof (struct {...})]; + extern int dummy [sizeof (struct verify_type__ {...})]; + extern void dummy (int [sizeof (struct {...})]); + extern void dummy (int [sizeof (struct verify_type__ {...})]); + extern int (*dummy (void)) [sizeof (struct {...})]; + extern int (*dummy (void)) [sizeof (struct verify_type__ {...})]; + + In the second and sixth case, the struct type is exported to the + outer scope; two such declarations therefore collide. GCC warns + about the first, third, and fourth cases. So the only remaining + possibility is the fifth case: + + extern int (*dummy (void)) [sizeof (struct {...})]; + + * This implementation exploits the fact that GCC does not warn about + the last declaration mentioned above. If a future version of GCC + introduces a warning for this, the problem could be worked around + by using code specialized to GCC, e.g.,: + + #if 4 <= __GNUC__ + # define verify(R) \ + extern int (* verify_function__ (void)) \ + [__builtin_constant_p (R) && (R) ? 1 : -1] + #endif + + * In C++, any struct definition inside sizeof is invalid. + Use a template type to work around the problem. */ + + +/* Verify requirement R at compile-time, as an integer constant expression. + Return 1. */ + +# ifdef __cplusplus +template <int w> + struct verify_type__ { unsigned int verify_error_if_negative_size__: w; }; +# define verify_true(R) \ + (!!sizeof (verify_type__<(R) ? 1 : -1>)) +# else +# define verify_true(R) \ + (!!sizeof \ + (struct { unsigned int verify_error_if_negative_size__: (R) ? 1 : -1; })) +# endif + +/* Verify requirement R at compile-time, as a declaration without a + trailing ';'. */ + +# define verify(R) extern int (* verify_function__ (void)) [verify_true (R)] + +#endif diff --git a/lib/wchar.in.h b/lib/wchar.in.h new file mode 100644 index 000000000..41584959c --- /dev/null +++ b/lib/wchar.in.h @@ -0,0 +1,93 @@ +/* A substitute for ISO C99 <wchar.h>, for platforms that have issues. + + Copyright (C) 2007-2008 Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 2, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +/* Written by Eric Blake. */ + +/* + * ISO C 99 <wchar.h> for platforms that have issues. + * <http://www.opengroup.org/susv3xbd/wchar.h.html> + * + * For now, this just ensures proper prerequisite inclusion order and + * the declaration of wcwidth(). + */ + +@PRAGMA_SYSTEM_HEADER@ + +#ifdef __need_mbstate_t +/* Special invocation convention inside uClibc header files. */ + +#@INCLUDE_NEXT@ @NEXT_WCHAR_H@ + +#else +/* Normal invocation convention. */ + +#ifndef _GL_WCHAR_H + +/* Tru64 with Desktop Toolkit C has a bug: <stdio.h> must be included before + <wchar.h>. + BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be + included before <wchar.h>. */ +#include <stddef.h> +#include <stdio.h> +#include <time.h> + +/* Include the original <wchar.h> if it exists. + Some builds of uClibc lack it. */ +/* The include_next requires a split double-inclusion guard. */ +#if @HAVE_WCHAR_H@ +# @INCLUDE_NEXT@ @NEXT_WCHAR_H@ +#endif + +#ifndef _GL_WCHAR_H +#define _GL_WCHAR_H + +/* The definition of GL_LINK_WARNING is copied here. */ + +#ifdef __cplusplus +extern "C" { +#endif + + +/* Return the number of screen columns needed for WC. */ +#if @GNULIB_WCWIDTH@ +# if @REPLACE_WCWIDTH@ +# undef wcwidth +# define wcwidth rpl_wcwidth +extern int wcwidth (wchar_t); +# else +# if !defined wcwidth && !@HAVE_DECL_WCWIDTH@ +/* wcwidth exists but is not declared. */ +extern int wcwidth (int /* actually wchar_t */); +# endif +# endif +#elif defined GNULIB_POSIXCHECK +# undef wcwidth +# define wcwidth(w) \ + (GL_LINK_WARNING ("wcwidth is unportable - " \ + "use gnulib module wcwidth for portability"), \ + wcwidth (w)) +#endif + + +#ifdef __cplusplus +} +#endif + +#endif /* _GL_WCHAR_H */ +#endif /* _GL_WCHAR_H */ +#endif diff --git a/libguile.h b/libguile.h index 48f69fbb9..40122dfa2 100644 --- a/libguile.h +++ b/libguile.h @@ -1,46 +1,22 @@ #ifndef SCM_LIBGUILE_H #define SCM_LIBGUILE_H -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2008 Free Software Foundation, Inc. * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301 USA - * - * As a special exception, the Free Software Foundation gives permission - * for additional uses of the text contained in its release of GUILE. + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. * - * The exception is that, if you link the GUILE library with other files - * to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the GUILE library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the - * Free Software Foundation under the name GUILE. If you copy - * code from other Free Software Foundation releases into a copy of - * GUILE, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. * - * If you write modifications of your own for GUILE, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. */ + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + */ /* This needs to be included outside of the extern "C" block. diff --git a/libguile/.gitignore b/libguile/.gitignore new file mode 100644 index 000000000..41f7909d2 --- /dev/null +++ b/libguile/.gitignore @@ -0,0 +1,15 @@ +c-tokenize.c +cpp_err_symbols.c +cpp_sig_symbols.c +gen-scmconfig +gen-scmconfig.h +guile +guile-doc-snarf +guile-func-name-check +guile-procedures.texi +guile-snarf +guile-snarf-docs +guile_filter_doc_snarfage +libpath.h +scmconfig.h +version.h diff --git a/libguile/COPYING b/libguile/COPYING deleted file mode 100644 index e69de29bb..000000000 --- a/libguile/COPYING +++ /dev/null diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 691159b52..64229b235 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,445 @@ +2008-08-29 Julian Graham <joolean@gmail.com> + + * threads.c (fat_mutex_lock): Resolve a deadlock caused by not + checking mutex state after calling `SCM_TICK'. + +2008-08-27 Ludovic Courtès <ludo@gnu.org> + + Fix builds `--without-threads'. Reported by Han-Wen Nienhuys + <hanwen@xs4all.nl>. + + * scmsigs.c (scm_i_close_signal_pipe): Don't refer to + `signal_pipe' unless `SCM_USE_PTHREAD_THREADS' is true. + * threads.c (scm_leave_guile_cleanup): Mark as `SCM_UNUSED'. + +2008-08-25 Ludovic Courtès <ludo@gnu.org> + + * Makefile.am (AM_CFLAGS): New. + (guile_CFLAGS, libguile_la_CFLAGS): Use it. + +2008-08-20 Ludovic Courtès <ludo@gnu.org> + + * eval.c, filesys.c, gc.c, numbers.c, stime.c, threads.c: Don't + define `_GNU_SOURCE' explicitly as it's now defined in + <config.h> thanks to `AC_USE_SYSTEM_EXTENSIONS'. + +2008-08-19 Han-Wen Nienhuys <hanwen@lilypond.org> + Ludovic Courtès <ludo@gnu.org> + + * goops.c (scm_init_goops_builtins, go_to_hell): Fix allocation + of `hell' by passing "hell_size * sizeof (*hell)" instead of + "hell_size" to `scm_malloc ()' and `scm_realloc ()'. + +2008-08-02 Neil Jerram <neil@ossau.uklinux.net> + + * numbers.c (scm_rationalize): Update docstring to match the + manual (which is more correct). Change argument "err" to "eps", + also to match the manual. + +2008-07-17 Neil Jerram <neil@ossau.uklinux.net> + + From Thiemo Seufer <ths@networkno.de>: + + * gc_os_dep.c (CPP_WORDSZ, ALIGN_DOUBLE, DATAEND, + DYNAMIC_LOADING): Added #defines. + (_fdata, _end): Added declarations. + (DATASTART): Use _fdata instead of __data_start. + (STACKBOTTOM): Changed from 0x80000000 to 0x7fff8000. + +2008-07-16 Ludovic Courtès <ludo@gnu.org> + + * gen-scmconfig.h.in (SCM_I_GSC_HAVE_STRUCT_DIRENT64): New. + * gen-scmconfig.c (main): Produce definitions of + `SCM_HAVE_STRUCT_DIRENT64' and `SCM_HAVE_READDIR64_R'. + * _scm.h (dirent_or_dirent64): Depend on + `SCM_HAVE_STRUCT_DIRENT64', for the sake of HP-UX 11.11. + (readdir_r_or_readdir64_r): Depend on `SCM_HAVE_READDIR64_R', + for HP-UX 11.11. + +2008-07-05 Ludovic Courtès <ludo@gnu.org> + + * strings.c (scm_c_symbol_length): New function. + * strings.h (scm_c_symbol_length): New declaration. + +2008-07-04 Ludovic Courtès <ludo@gnu.org> + + * posix.h (scm_i_locale_mutex): Don't declare as `SCM_INTERNAL' + since it's needed by `libguile-i18n'. Reported by Patrick + Horgan <phorgan1@gmail.com>. + + * __scm.h (SCM_INTERNAL): Add `extern' so that these symbols are + not considered as "common" by GCC 4.3. Reported by Patrick + Horgan <phorgan1@gmail.com>. + +2008-06-28 Ludovic Courtès <ludo@gnu.org> + + * Makefile.am (INCLUDES): Renamed to... + (AM_CPPFLAGS): this, to match current Automake conventions. + Users updated. + + * tags.h (SCM_UNPACK): Disable type-checking for `__DECC' and + `__HP_cc'. Reported by Peter O'Gorman <pogma@thewrittenword.com>. + +2008-06-02 Ludovic Courtès <ludo@gnu.org> + + * deprecated.c (maybe_close_port): Rename EXCEPT to EXCEPT_SET + to workaround `#define except' on Tru64. Reported by Peter + O'Gorman <pogma@thewrittenword.com>. + +2008-05-31 Ludovic Courtès <ludo@gnu.org> + + * __scm.h (SCM_INTERNAL): New macro. + * *.h: Use it to mark as internal `scm_i_' and `scm_init_' + functions that are not used by public macros or inline + functions. + +2008-05-14 Julian Graham <joolean@gmail.com> + + * threads.c (fat_mutex)[recursive]: New field. + (make_fat_mutex): Adjust initialization to reflect changes to + mutex lock level semantics. + (fat_mutex_lock, fat_mutex_unlock): Add support for unowned + mutexes and locking mutexes on behalf of other threads. + (scm_lock_mutex, scm_lock_mutex_timed): Update to reflect + signature change to fat_mutex_lock. + (scm_mutex_owner, scm_mutex_level, scm_mutex_locked_p): New / + re-enabled functions. + * threads.h (scm_mutex_owner, scm_mutex_level, + scm_mutex_locked_p): Prototypes for new functions. + +2008-05-12 Neil Jerram <neil@ossau.uklinux.net> + + * discouraged.c: Expand DEFFROM and DEFTO macros, to avoid + compiler warnings about excess semicolons. (Reported by Didier + Godefroy.) + +2008-05-08 Neil Jerram <neil@ossau.uklinux.net> + + * throw.c (scm_ithrow): For IA64 add a return statement, to + appease GCC. + + * threads.h (scm_i_thread): New IA64 fields: + register_backing_store_base and pending_rbs_continuation. + + * threads.c (guilify_self_1): For IA64: cap RBS base address at + the current value of scm_ia64_ar_bsp, and store the capped value + in thread state. + (SCM_MARK_BACKING_STORE): Use thread->register_backing_store_base + instead of scm_ia64_register_backing_store_base(). + (scm_threads_mark_stacks): Add "&" in "&t->regs", so that the code + works both for jmp_buf defined as an array, and jmp_buf defined as + a struct. + + * continuations.h (scm_t_contregs): Remove `fresh' and `ctx' + fields; these are now inside the IA64 definition of `jmp_buf'. + + * continuations.c (scm_make_continuation): Simplify, by moving + some of the IA64 code inside the definition of "setjmp", and by + some obvious commonizations. For IA64 register backing store + (RBS) stack base, use thread->register_backing_store_base instead + of scm_ia64_register_backing_store_base(). + (copy_stack): For IA64, store pointer to continuation being + invoked in thread state, so we can restore the continuation's RBS + stack just before the next setcontext call. + (copy_stack_and_call): Don't restore RBS stack explicitly here. + It will be restored, if appropriate, inside the longjmp call. + (scm_ia64_longjmp): New function. + + * __scm.h (setjmp, longjmp, jmp_buf): For IA64, implement using + getcontext and setcontext. + +2008-05-07 Ludovic Courtès <ludo@gnu.org> + + * numbers.c (scm_from_complex_double): Mark as `SCM_UNUSED'. + This fixes compilation with `-Werror' on FreeBSD 6.2 (i386). + +2008-05-05 Neil Jerram <neil@ossau.uklinux.net> + + * c-tokenize.lex: #define YY_NO_INPUT. + +2008-04-26 Ludovic Courtès <ludo@gnu.org> + + * read.c (scm_read_sexp): Remove extraneous semi-colon at + end-of-line, which broke compilation with GCC 2.7. Reported by + Alain Guibert <alguibert+bts@free.fr>. + +2008-04-24 Ludovic Courtès <ludo@gnu.org> + + * Makefile.am (DEFAULT_INCLUDES): New. Fixes compilation on + Tru64 where our "random.h" would shadown libc's one. + (INCLUDES): Add "-I$(top_buildir)", which is normally in + `DEFAULT_INCLUDES'. + * gen-scmconfig.c: Include <libguile/gen-scmconfig.h>, not + "gen-scmconfig.h" since that file is under `$(builddir)'. + +2008-04-16 Ludovic Courtès <ludo@gnu.org> + + * ports.c (scm_getc, scm_putc, scm_puts): Moved... + * inline.h: ... here. Noticeably improves `read' performance. + +2008-04-15 Ludovic Courtès <ludo@gnu.org> + Julian Graham <joolean@gmail.com> + + * read.c (scm_keyword_postfix): New. + (scm_read_opts): Update docstring for `keywords'. + (scm_read_mixed_case_symbol): Add support for postfix keywords. + +2008-04-13 Ludovic Courtès <ludo@gnu.org> + + * inline.h (SCM_C_USE_EXTERN_INLINE): New macro. Use it to make + sure "extern" declarations are produced when "extern inline" is + used. Simplify macrology around inline definitions. + +2008-04-10 Ludovic Courtès <ludo@gnu.org> + + * inline.h (SCM_C_EXTERN_INLINE): Special-case Apple's GCC + 4.0-based compiler, which doesn't support GNU inline semantics + at all in C99 mode but doesn't define `__GNUC_STDC_INLINE__'. + See http://thread.gmane.org/gmane.network.gnutls.general/1135 . + +2008-04-10 Andy Wingo <wingo@pobox.com> + + * struct.c (scm_struct_ref, scm_struct_set_x): "Light" structs + have no hidden words (members of the SCM_STRUCT_DATA(x) array + accessed with negative indices). In that case, determine the + number of fields from the length of the struct layout + descriptor. (Most GOOPS instances are light structs.) + + * goops.c (wrap_init): Initialize 'u' slots to 0, not some random + SCM value. + + * goops.c (get_slot_value, set_slot_value): In the struct + allocation case, don't poke the slots array directly -- we should + go through struct-ref/struct-set! code so that we get the + permissions and allocation ('u' versus 'p') correct. + +2008-04-03 Ludovic Courtès <ludo@gnu.org> + + * inline.h (SCM_C_EXTERN_INLINE): New macro, addresses the + "extern inline" semantic change in C99 mode with GCC 4.3 and + later and the warning in C99 mode with GCC 4.2. Use it in the + inline function definitions. + +2008-03-24 Neil Jerram <neil@ossau.uklinux.net> + + Applying patch from Julian Graham, containing minor fixes to his + thread enhancements: + + * threads.c (to_timespec): Change 1000000 multiplier to + 1000000000. + (unchecked_unlock_sym, allow_external_unlock_sym, + recursive_sym): Use SCM_SYMBOL. + (scm_make_mutex_with_flags): When raising unsupported option + error, report what the unsupported option was. + (fat_mutex_unlock): When raising errors, unlock m->lock first. + (fat_cond_timedwait): Removed. + (scm_timed_wait_condition_variable): Call fat_mutex_unlock + directly instead of via fat_cond_timedwait. + +2008-03-10 Ludovic Courtès <ludo@gnu.org> + + * eval.c, filesys.c: Enclose `alloca' blob in `#ifndef alloca', + as per Gnulib's `alloca'. This should fix compilation on + FreeBSD 6. + +2008-03-09 Neil Jerram <neil@ossau.uklinux.net> + + * numbers.c: Only define scm_from_complex_double if it will + actually be used. + +2008-03-08 Julian Graham <joolean@gmail.com> + + * threads.c (scm_join_thread_timed, scm_thread_p, + scm_make_mutex_with_flags, scm_lock_mutex_timed, + scm_unlock_mutex_timed, scm_mutex_p, scm_condition_variable_p): New + functions. + (thread_mark): Updated to mark new struct field `mutexes'. + (do_thread_exit): Notify threads waiting on mutexes locked by exiting + thread. + (scm_join_thread, scm_make_mutex, scm_make_recursive_mutex, + scm_mutex_lock): Reimplement in terms of their newer + counterparts. + (scm_abandoned_mutex_error_key): New symbol. + (fat_mutex)[unchecked_unlock, allow_external_unlock]: New fields. + (fat_mutex_lock): Reimplement to support timeouts and abandonment. + (fat_mutex_trylock, scm_try_mutex): Remove fat_mutex_trylock and + reimplement scm_try_mutex as a lock attempt with a timeout of zero. + (fat_mutex_unlock): Allow unlocking from other threads and unchecked + unlocking; implement in terms of condition variable wait. + (scm_timed_wait_condition_variable): Reimplement in terms of + fat_mutex_unlock. + * threads.h (scm_i_thread)[mutexes]: New field. + (scm_join_thread_timed, scm_thread_p, scm_lock_mutex_timed, + scm_unlock_mutex_timed, scm_mutex_p, scm_condition_variable_p): + Prototypes for new functions. + +2008-03-06 Ludovic Courtès <ludo@gnu.org> + + * eval.c (scm_eval): If MODULE_OR_STATE is not a dynamic state, + make sure it's a module. Reported by David I. Lehn. + +2008-03-02 Ludovic Courtès <ludo@gnu.org> + + * pairs.h (scm_is_pair): Moved declaration to `inline.h'. + * inline.h: Make sure `extern' declarations are not produced + when `inline' is supported but GCC is not used. This + fixes "mixed linkage" errors with compilers such as + DEC/Compaq/HP CC. + +2008-02-27 Neil Jerram <neil@ossau.uklinux.net> + + * _scm.h (errno): Remove declarations that have been there + forever, and are known to conflict on some platforms with that + provided by <errno.h>, which we include unconditionally. If + <errno.h> doesn't provide a errno declaration, what is the point + of it? + +2008-02-23 Ludovic Courtès <ludo@gnu.org> + + * numbers.c (scm_make_rectangular): Rename argument to + `real_part' and `imaginary_part' to work around Solaris 2.10 + headers which define `imaginary' as a macro. Patch by Tim + Mooney <mooney@dogbert.cc.ndsu.NoDak.edu>. + +2008-02-22 Ludovic Courtès <ludo@gnu.org> + + * read.c (strncasecmp): Add declaration when + `HAVE_DECL_STRNCASECMP' is undefined. Fixes compilation on + NetBSD 1.6. + + * gc.c (scm_ia64_ar_bsp)[linux]: Don't discard `const' qualifier + of OPAQUE. + +2008-02-21 Ludovic Courtès <ludo@gnu.org> + + Fix bug #22369. + + * goops.c (scm_add_slot): Add `SCM_UNDEFINED' as last argument + to `scm_list_n ()'. Thanks to René Köcher + <shirk87@googlemail.com>. + +2008-02-17 Ludovic Courtès <ludo@gnu.org> + + * script.c (scm_compile_shell_switches): Update copyright year. + +2008-02-16 Ludovic Courtès <ludo@gnu.org> + + * gc_os_dep.c: Add NetBSD/alpha support. Patch by Greg Troxel + <gdt@ir.bbn.com>. + +2008-02-12 Ludovic Courtès <ludo@gnu.org> + + * guile-snarf.in (tempdir): Honor `$TMPDIR'. + +2008-02-11 Neil Jerram <neil@ossau.uklinux.net> + + * numbers.c (SCM_COMPLEX_VALUE): Use GUILE_I instead of _Complex_I + directly, and only if GUILE_I was defined by the configure step. + (scm_log, scm_log10, scm_exp, scm_sqrt): Use SCM_COMPLEX_VALUE + code only if SCM_COMPLEX_VALUE is defined. + +2008-02-07 Ludovic Courtès <ludo@gnu.org> + + Fix bug #21378. + Thanks to David Diffenbaugh <davediff@nbcs.rutgers.edu>. + + * read.c (scm_read_quote): Don't use `__FUNCTION__' since it is + not supported by Sun CC on Solaris 9. + (scm_read_keyword): Likewise. + * strings.c (scm_take_locale_stringn): Remove + `SCM_C_INLINE_KEYWORD' to allow compilation with Sun CC. + +2008-02-07 Julian Graham <joolean@gmail.com> + + * threads.c (do_thread_exit, scm_cancel_thread, + scm_set_thread_cleanup_x, scm_thread_cleanup): Lock on thread-specific + admin mutex instead of `thread_admin_mutex'. + * threads.h (scm_i_thread)[admin_mutex]: New field. + * throw.c (make_jmpbuf): Don't enter critical section during thread + spawn -- there is a possibility of deadlock if other threads are + exiting. + +2008-02-06 Neil Jerram <neil@ossau.uklinux.net> + + * gc-malloc.c (scm_gc_malloc): Return NULL if requested size is 0. + (scm_gc_free): Don't call `free' if mem is NULL. + +2008-02-06 Ludovic Courtès <ludo@gnu.org> + + * numbers.c (scm_i_mkbig, scm_i_long2big, scm_i_ulong2big, + scm_i_clonebig, scm_i_bigcmp, scm_i_dbl2big, scm_i_dbl2num, + scm_i_normbig): Remove `SCM_C_INLINE_KEYWORD' since these are + declared as `extern' in `numbers.h'. This precluded compilation + on Solaris 9 with Sun CC (reported by David Halik + <dhalik@nbcs.rutgers.edu>). + +2008-02-05 Neil Jerram <neil@ossau.uklinux.net> + + * fports.c (fport_seek): Make dependent on GUILE_USE_64_CALLS. + + * _scm.h: Make definition of CHOOSE_LARGEFILE depend on + GUILE_USE_64_CALLS. + +2008-02-01 Neil Jerram <neil@ossau.uklinux.net> + + * modules.c (the_root_module): Moved before scm_current_module. + (scm_current_module): Return the root module if `the-module' fluid + gives #f. + +2008-01-22 Neil Jerram <neil@ossau.uklinux.net> + + * COPYING: Removed. + + * __scm.h, _scm.h, weaks.c: Update copyright statement to LGPL. + +2008-01-18 Neil Jerram <neil@ossau.uklinux.net> + + * hashtab.c (scm_hash_fn_create_handle_x): If supplied assoc_fn + returns neither a pair nor #f, signal a wrong-type-arg error. + (Thanks to Gregory Marton for reporting this.) + +2007-12-29 Neil Jerram <neil@ossau.uklinux.net> + + * gc.c (mark_gc_async): Change "func_data" to "fn_data", to avoid + clash with AIX header file. + * hooks.c (scm_c_hook_add, scm_c_hook_remove): Same again. + * hooks.h (scm_t_c_hook_function, scm_c_hook_add, + scm_c_hook_remove): Same again. + +2007-12-08 Ludovic Courtès <ludo@gnu.org> + + * __scm.h (SCM_EXPECT, SCM_LIKELY, SCM_UNLIKELY): New macros. + (SCM_ASSERT, SCM_ASSERT_TYPE, SCM_ASRTGO, SCM_GASSERT0, + SCM_GASSERT1, SCM_GASSERT2, SCM_GASSERTn): Use them. + * eval.c (ASSERT_SYNTAX, ASSERT_SYNTAX_2): Likewise. + * eval.i.c (CEVAL): Use branch prediction hints for syntax + errors, wrong number of arguments and similar. + * numbers.c (scm_sum): Use `SCM_LIKELY' for the sum of two + immediate numbers. + (scm_difference, scm_product, scm_i_divide): Likewise. + * validate.h (SCM_ASSERT_RANGE): Use `SCM_UNLIKELY'. + +2007-12-04 Ludovic Courtès <ludo@gnu.org> + + * ports.c (scm_c_read): Validate PORT as an open input port. + (scm_c_write): Validate PORT as an open output port. + + * socket.c (scm_accept): Leave guile mode using + `scm_std_select ()' before calling `accept(2)'. Reported by + dskr <dskr@mac.com>. + +2007-10-27 Ludovic Courtès <ludo@gnu.org> + + * fports.c (scm_i_evict_port): Expect a port, rather than a pair + containing the port. Fixes a bug in the new port table (2007-08-26). + (scm_evict_ports): Use `scm_c_port_for_each ()'. + +2007-10-21 Neil Jerram <neil@ossau.uklinux.net> + + * eval.c (unmemoize_delay): Extend the environment before + unmemoizing the promise thunk. This fixes a segmentation fault + reported by Frank Schwidom. + 2007-10-20 Julian Graham <joolean@gmail.com> Add support for thread cancellation and user-defined thread @@ -26,7 +468,7 @@ 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 ()' + (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, @@ -36,7 +478,7 @@ * 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 @@ -59,9 +501,9 @@ `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 ()' + `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 ()' @@ -78,7 +520,7 @@ * posix.c (scm_putenv): Confine the putenv("NAME=") bit to mingw, use putenv("NAME") as the fallback everywhere else. In particular this is needed for solaris 9. Reported by Frank Storbeck. - + 2007-09-03 Ludovic Courtès <ludo@gnu.org> * read.c (flush_ws): Handle SCSH block comments. @@ -142,7 +584,7 @@ Fix tests of the tc16 number types, they were checked under scm_tc7_number, but the values went down the tag>=255 smob case. Put smob case under scm_tc7_smob instead of using tag>=255, per - recommendation in comments with scm_tc7_smob to use symbolic values. + recommendation in comments with scm_tc7_smob to use symbolic values. Use SCM_TC2SMOBNUM to extract scm_smobs index, instead of explicit code. Lose some unnecessary "break" statements. @@ -408,7 +850,7 @@ is equal to S1 and FIELD2 is equal to S2. This avoids infinite recursion when comparing `s' fields, as the REQUIRED_VTABLE_FIELDS added by `make-vtable-vtable'. Reported by Marco Maggi. - + 2007-01-18 Han-Wen Nienhuys <hanwen@lilypond.org> * throw.c (scm_ithrow): more refined error message: print symbols @@ -501,7 +943,7 @@ Also, the REDUCED bit alters the SCM_CELL_TYPE(), making comparisons between reduced and unreduced fractions go wrong. - + * numbers.h: remove SCM_FRACTION_SET_NUMERATOR, SCM_FRACTION_SET_DENOMINATOR, SCM_FRACTION_REDUCED_BIT, SCM_FRACTION_REDUCED_SET, SCM_FRACTION_REDUCED_CLEAR, @@ -612,7 +1054,7 @@ * script.c (scm_shell_usage): Note need for subscription to bug-guile@gnu.org. 2006-11-08 Ludovic Courtès <ludovic.courtes@laas.fr> - + * libguile/gc-freelist.c (scm_i_adjust_min_yield): Take two "sweep_stats" arguments; use them instead of accessing the global variables `scm_gc_cells_collected' and `scm_gc_cells_collected_1'. @@ -663,7 +1105,7 @@ 2006-10-25 Neil Jerram <neil@ossau.uklinux.net> IA64 HP-UX GC patch from Hrvoje NikÅ¡ić. (Thanks!) - + * threads.c (SCM_MARK_BACKING_STORE): Use scm_ia64_ar_bsp() and scm_ia64_register_backing_store_base() instead of Linux-specific implementations. @@ -851,7 +1293,7 @@ HAVE_TM_ZONE. (scm_strptime): Use tm_gmtoff from the strptime result when that field exists, it's set by glibc strptime "%s". - + 2006-06-13 Ludovic Courtès <ludovic.courtes@laas.fr> * eq.c: Include "struct.h", "goops.h" and "objects.h". @@ -877,7 +1319,7 @@ * throw.c (scm_handle_by_message): Add dummy return value to avoid compiler warning on cygwin. Reported by Ryan VanderBijl. - + * Makefile.am (EXTRA_DOT_X_FILES): Typo in dependency rule, was a duplicate of EXTRA_DOT_DOC_FILES. (DOT_X_FILES, EXTRA_DOT_X_FILES, DOT_DOC_FILES, EXTRA_DOT_DOC_FILES): @@ -991,7 +1433,7 @@ * fports.c (scm_setvbuf): Fix for not _IOLBF, clear SCM_BUFLINE instead of toggling it. Reported by Ludovic Courtès. - + 2006-03-26 Marius Vollmer <mvo@zagadka.de> * threads.c (get_thread_stack_base): Use scm_get_stack_base @@ -1261,7 +1703,7 @@ 2005-12-07 Marius Vollmer <mvo@zagadka.de> Reported by Bruce Korb: - + * init.c (invoke_main_func): Don't call exit here. Throws that are only caught by scm_with_guile will bypass us and would cause scm_boot_guile to return erroneously. @@ -1269,16 +1711,16 @@ here, passing it an appropriate exit code. From Andy Wingo: - + * script.c (scm_find_executable): Compile fix -- fgetc returns an unsigned char cast to an int, or -1 for EOS. - + 2005-12-06 Marius Vollmer <mvo@zagadka.de> * srfi-4.h, srfi-4.c, srfi-4.i.c (take_uvec): Make BASE pointer non-const. (scm_take_u8vector, etc): Likewise. Thanks to Ludovic Courtès! - + * threads.h, threads.c (scm_t_guile_ticket, scm_leave_guile, scm_enter_guile): Removed from public API. See comment at scm_without_guile for the rationale. @@ -1379,7 +1821,7 @@ 2005-10-23 Marius Vollmer <marius.vollmer@uni-dortmund.de> PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP is not portable enough. - + * null-threads.h, pthread-threads.h (SCM_I_PTHREAD_RECURSIVE_MUTEX_INITIALIZER): Removed. (scm_i_pthread_mutexattr_recursive): New. @@ -1389,7 +1831,7 @@ (scm_threads_prehistory): Initialize scm_i_pthread_mutexattr_recursive and scm_i_critical_section_mutex here. - + * eval.c (source_mutex): Do not initialiaze statically. (scm_init_eval): Do it here, using scm_i_pthread_mutexattr_recursive. @@ -1403,7 +1845,7 @@ (quote_keywordish_symbol): New, for evaluating the option. (scm_print_symbol_name): Use it. (scm_init_print): Initialize new option to sym_reader. - + 2005-08-15 Neil Jerram <neil@ossau.uklinux.net> * eval.c (eval_letrec_inits): New. @@ -1438,7 +1880,7 @@ * modules.h, modules.c (scm_eval_closure_module): Removed, we already have scm_lookup_closure_module, which does the same thing. - + 2005-08-01 Marius Vollmer <mvo@zagadka.de> New marking algorithm for weak hashtables that fixes the problem @@ -1447,7 +1889,7 @@ Guardians have been changed back to their original semantics and are no longer greedy and no longer drop cycles. - + * gc-mark.c (scm_mark_all): Do not rely on hooks to run the weak hashtable and guardian machinery but call the relevant functions directly. @@ -1462,7 +1904,7 @@ scm_i_identify_inaccessible_guardeds, scm_i_mark_inaccessible_guardeds): New. (scm_make_guardian): Removed greedy_p argument. - + * weaks.h, weaks.c (SCM_I_WVECT_TYPE, SCM_I_SET_WVECT_TYPE): New. (SCM_I_WVECT_N_ITEMS, SCM_I_SET_WVECT_N_ITEMS): New. (SCM_WVECTF_NOSCAN, SCM_WVECT_NOSCAN_P): Removed. @@ -1472,7 +1914,7 @@ scm_i_remove_weaks_from_weak_vectors, scm_i_remove_weaks): New. (scm_weak_vector_gc_init, scm_mark_weak_vector_spines, scm_scan_weak_vectors): Removed. - + * hashtab.h (scm_i_scan_weak_hashtables): New. * hashtab.c (make_hash_table, scm_i_rehash): Do not use SCM_WVECTF_NOSCAN. @@ -1498,7 +1940,7 @@ * hashtab.c (scm_i_rehash): Cast SCM_HASHTABLE_FLAGS (table) to scm_t_bits before storing them in the type word. - + * gc.c (tag_table_to_type_alist): Modified type of c_tag from scm_t_bits to int. @@ -1509,11 +1951,11 @@ * pairs.c (scm_error_pair_access): Use scm_from_locale_string rather than scm_makfrom0str. Reported by Ken Raeburn. - + * gc-card.c (scm_dbg_gc_get_bvec): Change return from long* to scm_t_c_bvec_long*, gcc 4 doesn't like different pointer targets when returning SCM_GC_CARD_BVEC. - + * pairs.c (scm_error_pair_access): Plain ascii ' in error message rather than latin-1 acute accent, the latter may not print on all terminals. @@ -1585,7 +2027,7 @@ 2005-06-09 Han-Wen Nienhuys <hanwen@xs4all.nl> * gc.c (tag_table_to_type_alist): convert tag number to "tag %d" - string, so live object stats can be sorted with string<?. + string, so live object stats can be sorted with string<?. 2005-06-06 Marius Vollmer <mvo@zagadka.de> @@ -1616,21 +2058,21 @@ From Jan Nieuwenhuizen <janneke@gnu.org>. Thanks! * hashtab.h: Bugfix: use SCM_API (WAS: extern). - + * socket.c: Remove obsolete comment about socklen_t. (s_scm_setsockopt)[!HAVE_IP_MREQ]: Do not use ip_mreq code. - + * numbers.h (isnan)[__MINGW32__]: Remove. - + * Makefile.am (gen_scmconfig_SOURCES): Bugfix: Add DEFAULT_INCLUDES when cross compiling. - + * threads.c (ETIMEDOUT, pipe)[__MINGW32__]: Add defines. * stime.c (scm_strftime)[!HAVE_TM_ZONE]: Use SCM_SIMPLE_VECTOR_REF instead of SCM_VELTS. (Changed slightly from Jan's patch.) - + 2005-05-22 Marius Vollmer <mvo@zagadka.de> * unif.c (scm_make_shared_array): Add old base to new base since @@ -1643,7 +2085,7 @@ 2005-05-12 Neil Jerram <neil@ossau.uklinux.net> Mac OS X compile warning fixes, reported by Richard Todd. - + * unif.c (scm_i_read_array): Declare rank as ssize_t, to guarantee that it is signed. @@ -1664,7 +2106,7 @@ 2005-05-11 Neil Jerram <neil@ossau.uklinux.net> Fix C99isms reported by Ludovic Courtès: - + * threads.c (s_scm_lock_mutex): Don't declare msg in middle of code. @@ -1739,7 +2181,7 @@ non-NULL. Always use a NULL closure. (scm_hash_fn_create_handle_x): Also rehash when table contains too few entries. - + 2005-03-29 Marius Vollmer <marius.vollmer@uni-dortmund.de> * hashtab.h, hashtab.c (scm_hash_fx_remove_x): Removed delete_fn @@ -1749,7 +2191,7 @@ (scm_hashx_remove_x): Likewise. Also, exported to Scheme. (scm_hash_clear): Accept plain vectors as hashtables. (scm_delx_x): Removed. - + 2005-03-28 Han-Wen Nienhuys <hanwen@xs4all.nl> * inline.h (scm_double_cell): use __asm__ iso. asm, to maintain @@ -1761,7 +2203,7 @@ scm_root. * threads.c: Removed fprintf debug statements. - + 2005-03-24 Neil Jerram <neil@ossau.uklinux.net> * debug.c (scm_make_memoized): Restore use of SCM_UNPACK. @@ -1861,13 +2303,13 @@ simple things inside that region. (scm_make_fluid, scm_make_dynamic_state): Lock fluid_admin_mutex while adding to the global lists. - + 2005-03-08 Marius Vollmer <mvo@zagadka.de> libltdl is no longer distributed. We expect it to be installed already. - + * Makefile.am (INCLUDES): Removed @LTDLINCL@. (libguile_la_LIBADD): Removed @LIBLTDL@. @@ -1885,14 +2327,14 @@ * throw.c (scm_ithrow): Abort when scm_i_critical_section_level is not zero. - + * threads.h, threads.c (scm_frame_lock_mutex): New. (scm_frame_critical_section): Take mutex as argument. (framed_critical_section_mutex): New, used as default for above. (scm_init_threads): Initialize it. (scm_threads_prehistory): Do not initialize thread_admin_mutex and scm_i_critical_section_mutex; both are initialized statically. - + * continuation.c, deprecated.c, goops.c, guardians.c keywords.c, libguile_la-arrays.loT, objprop.c, ports.c, smob.c, sort.s, srcprop.c, stime.c, struct.c, throw.c, regex-posix.c: Include @@ -1906,7 +2348,7 @@ section. (scm_dynthrow): Abort when scm_i_critical_section_level is not zero. - + 2005-03-04 Marius Vollmer <marius.vollmer@uni-dortmund.de> * threads.c (scm_try_mutex): Renamed argument for consistency. @@ -1919,11 +2361,11 @@ Big merge from the mvo-thread-cleanup branch. The main changes are: - + - The dynamic roots functionality has been split into dynamic states and continuations barriers. Fluids have been reimplemented and can now be garbage collected. - + - Initialization of Guile now works in a multi-thread friendly manner. Threads can freely enter and leave guile mode. @@ -1934,13 +2376,13 @@ - Signals are delivered via a pipe to a dedicated 'signal delivery thread'. - + - SCM_DEFER_INTS, SCM_ALLOW_INTS etc have been deprecated. * throw.c (scm_handle_by_message): Exit only the current thread, not the whole process. (scm_handle_by_message_noexit): Exit when catching 'quit. - + * scmsigs.c (take_signal, signal_delivery_thread, start_signal_delivery_thread, ensure_signal_delivery_thread, install_handler): Reimplemented signal delivery as explained in @@ -1966,7 +2408,7 @@ when using pthreads. * null-threads.c, null-threads.h: Provide dummy definitions for the above symbols when not using pthreads. - + * modules.h, modules.c (scm_frame_current_module): New. * load.c (scm_primitive_load): Use scm_i_frame_current_load_port @@ -1981,7 +2423,7 @@ Moved around some init funcs. Call scm_init_threads_default_dynamic_state. Register cleanup_for_exit with atexit. - + * hashtab.c (scm_hash_fn_create_handle_x, scm_hash_fn_remove_x): Use "!scm_is_eq" instead of "!=". @@ -1993,7 +2435,7 @@ scm_after_gc_c_hook. (scm_permanent_object): Allocate outside of critical section. (cleanup): Removed. - + * fluids.h, fluids.c: Reimplemented completely. (SCM_FLUID_NUM, SCM_FAST_FLUID_REF, SCM_FAST_FLUID_SET): Reimplemented as functions. @@ -2004,19 +2446,19 @@ scm_set_current_dynamic_state, scm_frame_current_dynamic_state, scm_c_with_dynamic_state, scm_with_dynamic_state, scm_i_make_initial_dynamic_state, scm_fluids_prehistory): New. - + * feature.c (progargs_fluid): New. (scm_program_arguments, scm_set_program_arguments): Use it instead of scm_progargs. (scm_init_feature): Allocate it. Also, only add "threads" feature when SCM_USE_PTHREAD_THREADS is true. - + * eval.c (scm_makprom): Use scm_make_recursive_mutex instead of scm_make_rec_mutex, with all the consequences. (scm_eval_x, scm_eval): Use scm_frame_begin etc instead of scm_internal_dynamic_wind. Handle dynamic states as second argument. - + * threads.h, threads.c (scm_internal_select): Renamed to scm_std_select and discouraged old name. (scm_thread_sleep, scm_thread_usleep): Likewise, as scm_std_sleep @@ -2086,9 +2528,9 @@ respectively. * fluid.h (SCM_FLUIDP): Deprecated. - + * coop-threads.c: Removed. - + * continuations.h, continuations.c (scm_with_continuation_barrier, scm_c_with_continuation_barrier, scm_i_with_continuation_barrier): New. @@ -2102,14 +2544,14 @@ current sleep. (scm_system_async_mark_for_thread): Do not use scm_current_thread since that might not work during early initialization. - + * __scm.h (SCM_DEFER_INTS, SCM_ALLOW_INTS, SCM_REDEFER_INTS, SCM_REALLOW_INTS): Deprecated by moving into deprecated.h and deprecated.c. Replaced all uses with SCM_CRITICAL_SECTION_START and SCM_CRITICAL_SECTION_END. (SCM_ENTER_A_SECTION, SCM_EXIT_A_SECTION): Removed. Replaced with SCM_CRITICAL_SECTION_START/END. - + * Makefile.am (modinclude_HEADER): Removed threads-plugin.h. (libguile_la_SOURCES): Added null-threads.c (EXTRA_libguile_la_SOURCES): Removed pthread-threads.c and @@ -2129,8 +2571,8 @@ scm_frame_current_dynamic_state and scm_i_with_continuation_barrier. (scm_dynamic_root): Return current continuation barrier. - - + + 2005-02-28 Marius Vollmer <mvo@zagadka.de> * socket.c (scm_setsockopt): Handle IP_ADD_MEMBERSHIP and @@ -2158,7 +2600,7 @@ the hashtable. (scm_hash_fn_create_handle_x): Likewise. * vectors.h (SCM_I_SET_WVECT_TYPE): New, for use in scm_i_rehash. - + 2005-02-10 Mikael Djurfeldt <djurfeldt@nada.kth.se> * unif.c (prototype_to_type): Bugfix: Don't compare prototype to @@ -2196,7 +2638,7 @@ statistics on the number of live objects of each type. * gc-card.c (scm_i_tag_name): new function. - (scm_i_card_statistics): new function. + (scm_i_card_statistics): new function. 2005-01-24 Kevin Ryde <user42@zip.com.au> @@ -2239,14 +2681,14 @@ (scm_classes_initialized): Removed. (scm_class_of): Do not check it. (create_standard_classes): Do not set it. - + 2005-01-17 Marius Vollmer <marius.vollmer@uni-dortmund.de> * objects.h, objects.c (scm_classes_initialized): New. (scm_class_of): Signal error when scm_classes_initialized is zero. * goops.c (create_standard_classes): Set scm_classes_initialized to one. - + * random.c (scm_random_solid_sphere_x): Use scm_c_generalized_vector_length instead of scm_uniform_vector_length. @@ -2288,13 +2730,13 @@ (scm_init_srfi_4): Set mark function of smob when needed. Initialize scm_uint64_min, scm_uint64_max, scm_int64_min, scm_int64_max. - + Recognize 1.4 -e syntax. - + * script.c (sym_at, sym_atat, sym_main, all_symbols): New. (scm_compile_shell_switches): Use them to recognize and convert 1.4 "-e" syntax. - + 2005-01-12 Marius Vollmer <marius.vollmer@uni-dortmund.de> * deprecated.h, deprecated.c, strings.h, strings.c: Turn all @@ -2310,9 +2752,9 @@ (print_summary): New. (scm_init_deprecation): Initialize SCM_WARN_DEPRECATED instead of mode. - + Deprecated SCM_ARRAY* macros. - + * unif.h, unif.c, ramap.c, vectors.c, srfi-4.c, srfi-4.i.c (SCM_ARRAYP, SCM_I_ARRAYP): Renamed former to latter internal version. Changed all uses. @@ -2331,11 +2773,11 @@ Moved from unif.h to unif.c. (scm_c_array_rank): New. (scm_array_rank): Reimplement using it. - + * deprecated.h, deprecated.c (SCM_ARRAYP, SCM_ARRAY_NDIM, SCM_ARRAY_CONTP, SCM_ARRAY_MEM, SCM_ARRAY_V, SCM_ARRAY_BASE, SCM_ARRAY_DIMS, scm_t_array): New deprecated versions. - + 2005-01-11 Marius Vollmer <mvo@zagadka.de> * ramap.c: Replace uses of scm_make_ra with scm_i_make_ra. @@ -2355,7 +2797,7 @@ (scm_ra_set_contp): Deprecated, changed all uses to scm_i_ra_set_contp. (scm_cvref, scm_aind, scm_raprin1): Deprecated. - + 2005-01-10 Marius Vollmer <marius.vollmer@uni-dortmund.de> * eval.c (scm_eval): Added example to docstring. Thanks to Issac @@ -2367,7 +2809,7 @@ (scm_i_print_array): Print length information for arrays that need it. (scm_i_read_array): Parse it. - + * deprecated.h, deprecated.c (SCM_CHARS, SCM_UCHARS, SCM_LENGTH, scm_i_object_chars, scm_i_object_length): Brought back from the dead. @@ -2403,7 +2845,7 @@ uvec_fast_ref since scm_array_handle_ref should be faster now. (coerce_to_uvec, scm_c_uniform_vector_ref, scm_c_uniform_vector_set_x): Likewise. - + * unif.h, unif.c, inline.h (scm_i_t_array_ref, scm_i_t_array_set): New. (scm_t_array_handle): Added ref, set, elements and @@ -2421,12 +2863,12 @@ scm_bit_position, scm_bit_set_star_x, scm_bit_count_star, scm_bit_invert_x): Correctly multiply index with increment in the general case. - + * unif.c (scm_array_handle_set): Correctly execute only one alternative. D'Oh! (scm_list_to_typed_array, l2ra): Use scm_t_array_handle to fill the array; this covers all cases with much simpler code. - + * srfi-4.c (scm_uniform_element_size): Deprecated implementation as well. @@ -2443,7 +2885,7 @@ (scm_i_print_array): Print zero rank arrays specially. (tag_to_type): Return #t for an empty tag, not the empty symbol. (scm_i_read_array): Allow zero rank arrays. - + 2005-01-07 Marius Vollmer <marius.vollmer@uni-dortmund.de> * hashtab.h, hashtab.c (SCM_HASHTAB_BUCKET_LOC): Removed. @@ -2454,9 +2896,9 @@ Removed ref_stack field. (PSTATE_STACK_REF, PSTATE_STACK_SET): New, for accessing the stack of a print state. Use them everywhere instead of ref_stack. - + * srfi-4.h (scm_uniform_element_size): Deprecated for real. - + * srfi-4.c: Include deprecation.h. * vectors.h, vectors.c, unif.h, unif.c, deprecated.h, @@ -2471,12 +2913,12 @@ scm_vector_equal_p): Moved from vectors.[hc] to deprecated.[hc]. (scm_vector_equal_p, scm_i_vector_equal_p): Renamed former to latter. Changed use in eq.c. - + 2005-01-07 Marius Vollmer <mvo@zagadka.de> Make the uniform vector routines also deal with one dimensional arrays. - + * srfi-4.c (SCM_IS_UVEC): New, use it instead of SCM_SMOB_PREDICATE in this file. (is_uvec): Also recognize one-dimensional uniform numeric arrays @@ -2493,13 +2935,13 @@ (scm_uniform_vector_to_list): Let uvec_to_list do all the checking. (scm_uniform_vector_length): Use uvec_length. - + 2005-01-06 Marius Vollmer <marius.vollmer@uni-dortmund.de> * srfi-4.h, srfi-4.c (scm_c_uniform_vector_element_size, scm_c_uniform_vector_size): Removed. (scm_array_handle_uniform_element_size): New. - + * unif.h (scm_array_handle_ref, scm_array_handle_set): Changed type of POS parameter to be signed, positions can be negative. @@ -2507,11 +2949,11 @@ scm_t_array_handle to properly call it. (scm_vector_get_handle, scm_generalized_vector_get_handle): Renamed former to latter, changed all uses. - + 2005-01-05 Marius Vollmer <mvo@zagadka.de> Updated bitvector routines to also use scm_t_array_handles. - + * unif.h (scm_bitvector_elements, scm_bitvector_writable_elements): Use a scm_t_array_handle and deliver offset, length and increment to caller. Changed all uses. @@ -2526,7 +2968,7 @@ arrays is now SCM_UNSPECIFIED. The old special value SCM_BOOL_F was a valid value to fill bitvectors with, so it can't really be specialed out. - + 2005-01-04 Kevin Ryde <user42@zip.com.au> * stime.c (scm_strftime): Free t.tm_zone produced by bdtime2c. @@ -2548,7 +2990,7 @@ so that it doesn't leak. (scm_stable_sort): Simply call scm_stable_sort_x on a copy of the list or vector. - + * ramap.c (scm_array_map_x): Do not try to convert fill value before filling, any necessary conversion is done while storing. @@ -2568,7 +3010,7 @@ vector elements API or simple vector API, as appropriate. Removed SCM_HAVE_ARRAYS ifdefery. Replaced all uses of SCM_HASHTABLE_BUCKETS with SCM_HASHTABLE_BUCKET. - + * srfi-4.h, srfi-4.c, srfi-4.i.c (scm_array_handle_uniform_elements, scm_array_handle_uniform_writable_elements, @@ -2578,10 +3020,10 @@ scm_t_array_handle, deliver length and increment. (scm_array_handle_<foo>_elements, scm_array_handle_<foo>_writable_elements): New. - + * gen-scmconfig.h.in (SCM_I_GSC_HAVE_ARRAYS): Removed. * gen-scmconfig.c: Hard code SCM_HAVE_ARRAYS to "1". - + * unif.h, unif.c (scm_t_array_handle, scm_array_get_handle, scm_array_handle_rank, scm_array_handle_dims, scm_array_handle_ref scm_array_handle_set, scm_array_handle_elements @@ -2593,7 +3035,7 @@ (scm_make_shared_array, scm_enclose_array): Correctly use scm_c_generalized_vector_length instead of scm_uniform_vector_length. - + * validate.h (SCM_VALIDATE_VECTOR, SCM_VALIDATE_VECTOR_OR_DVECTOR): use scm_is_simple_vector instead of SCM_VECTORP. @@ -2639,7 +3081,7 @@ No longer use creators to specify the type of an array. Creators expose the fact that arrays are wrapped around vectors, but that might change. - + * srfi-4.h (scm_i_proc_make_u8vector, scm_i_proc_make_s8vector, scm_i_proc_make_u16vector, scm_i_proc_make_s16vector, scm_i_proc_make_u32vector, scm_i_proc_make_s32vector, @@ -2673,7 +3115,7 @@ (tag_to_type): New. (scm_i_read_array): Use scm_list_to_typed_array instead of scm_list_to_uniform_array. - + 2004-12-27 Marius Vollmer <mvo@zagadka.de> * unif.h, unif.c (scm_bitvector_elements): Made return value "const". @@ -2700,7 +3142,7 @@ scm_frame_uniform_vector_release_writable_elements): New. Takes crown of longest identifier yet. Changed all uses as required by the changes above. - + * vectors.h, vectors.c (scm_c_vector_set_x): Make return type void. (scm_is_vector, scm_vector_p, scm_vector_length, @@ -2720,7 +3162,7 @@ scm_uniform_vector_length. (scm_ramap, rafe): Use scm_c_vector_ref instead of SCM_VELTS. use scm_c_generalized_vector_ref instead of scm_uniform_vector_ref. - + 2004-12-23 Marius Vollmer <marius.vollmer@uni-dortmund.de> * continuations.h, continuations.c (scm_t_contregs): New 'offset' @@ -2731,7 +3173,7 @@ scm_last_stack_frame, scm_stack_id): Use the new 'offset' member of continuations instead of calculating the offset ourselves. Relocate 'vect' member of scm_t_debug_frame. - + 2004-12-16 Kevin Ryde <user42@zip.com.au> * ramap.c (scm_array_map_x): Check for at least one source argument. @@ -2775,7 +3217,7 @@ use of an array as their storage 'vector'. When all generalized vectors are allowed as storage, including one-dimensional arrays, this will no longer work.) - + * unif.h, unif.c: (scm_tc16_enclosed_array, SCM_ENCLOSED_ARRAYP): New. (exactly_one_third, singp): Removed. @@ -2815,7 +3257,7 @@ explicitly. (scm_init_unif): Initialize scm_tc16_enclosed_array smob. Use scm_i_print_array as printer for scm_tc16_array. - + 2004-11-10 Marius Vollmer <mvo@zagadka.de> * ramap.c (cind): Changed second arg to be pointer to long instead @@ -2831,7 +3273,7 @@ in terms of scm_uniform_vector_read_x and scm_uniform_vector_write, respectively. Strings and bitvector support has been dropped. - + * srfi-4.h, srfi-4.c: Do not include <libguile.h>, include the needed files directly. Include config.h, <unistd.h> and <io.h> when available. @@ -2854,7 +3296,7 @@ (make_uvec): ...but not here. (coerce_to_uvec): Use new generalized vector functions to handle all kinds of vectors in one go. - + * tags.h (scm_tc7_bvect): Renamed to scm_tc7_unused7, renaming the remaining scm_tc7_unused tags to get a neatly ordered list. @@ -2871,7 +3313,7 @@ scm_is_generalized_vector, scm_c_generalized_vector_length, scm_c_generalized_vector_ref, scm_c_generalized_vector_set_x): New. - + * unif.h, unif.c (scm_bitvector_p, scm_bitvector, scm_make_bitvector, scm_bitvector_length, scm_bitvector_ref, scm_bitvector_set_x, scm_list_to_bitvector, scm_bitvector_to_list, @@ -2956,7 +3398,7 @@ * srfi-4.h, srfi-4.c (scm_frame_uniform_vector_release): New. * unif.c (scm_bit_set_star_x, scm_bit_count_star_x): Use it to get more efficient access to the u32vector. - + * tags.h (scm_tc7_llvect, scm_tc7_uvect, scm_tc7_fvect, scm_tc7_dvect, scm_tc7_cvect, scm_tc7_svect, scm_tc7_byvect, scm_tc7_ivect): Renamed to scm_tc7_unused_1 to scm_tc7_unused_8. @@ -2972,7 +3414,7 @@ * unif.c (scm_bit_set_star_x, scm_bit_count_star_x): Use u32vectors instead of old-sytle uvectors. - + * convert.c, convert.i.c: Rewritten completely, using scm_any_to_u8vector, etc and other new-style uniform vector functions. @@ -2997,7 +3439,7 @@ return creators. (scm_make_uve): Use scm_call_1 instead of scm_call_2 with a second arg of SCM_UNDEFINED. The latter is wrong. - + * unif.h, unif.c (scm_make_u1vector): New, but only temporary. (make_uve): Removed. (scm_i_proc_make_vector, scm_i_proc_make_string, @@ -3029,7 +3471,7 @@ Updated all tables and generic functions to support them. (scm_i_proc_make_u8vector, scm_i_proc_make_s8vector, etc): New. (scm_init_srfi_4): Initialize them. - + * srfi-4.i.c (scm_take_u8vector, etc): use uvec_sizes instead of sizeof(CTYPE) as explained in the comment. @@ -3046,7 +3488,7 @@ vector. The plan is to gradually replace one type after the other until none is left and then to consider general cleanups and optimizations. - + * srfi-4.h, srfi-4.i.c (scm_u8vector_elements, etc): New. * srfi-4.h, srfi-4.c (scm_uniform_vector_p, @@ -3108,7 +3550,7 @@ requested. * convert.c (scm_c_scm2chars, scm_c_chars2scm, scm_c_chars2byvect): Use a s8vector instead of a scm_tc7_byvect. - + 2004-10-26 Marius Vollmer <marius.vollmer@uni-dortmund.de> * numbers.h, numbers.c (scm_i_print_double): New. @@ -3139,11 +3581,11 @@ (scm_uint2str): New, for scm_t_uintmax. (scm_iint2str): Argument type changed to scm_t_intmax, reimplemented in terms of scm_uint2str. - + * print.c, print.h (scm_uintprint): New, for printing scm_t_uintmax values. (scm_intprint): Argument type changed to scm_t_intmax. - + * sort.c (quicksort, scm_merge, scm_merge_list_x, scm_merge_list_step, scm_merge_vector_step): Inserted SCM_TICKs at strategic places so that the loops can be interrupted. @@ -3152,7 +3594,7 @@ "-I$(top_srcdir)/libguile-ltdl". (libguile_la_LIBADD): Use @LIBLTDL@ instead of "../libguile-ltdl/libguile-ltdl.a". - + * guile.c, dynl.c: Switched to using libltdl directly. Replaced all references to scm_lt_* with just lt_*. Include <ltdl.h> instead of <libguile-ltdl.h>. @@ -3165,12 +3607,12 @@ quicksort to fail, it just put all the burdon on the insertion sort and was thus very slow. Thanks to Rolan Orre for reporting the slowness! - + 2004-10-19 Marius Vollmer <marius.vollmer@uni-dortmund.de> * numbers.c (scm_i_range_error): New. * conv-integer.i.c, conv-uinteger.i.c: Use it instead of - scm_out_of_range. + scm_out_of_range. * sort.c (scm_restricted_vector_sort_x): Validate startpos <= endpos. State inclusiveness/exclusiveness of bounds in docstring. @@ -3198,11 +3640,11 @@ Keywords no longer store a 'dash symbol'. Instead, they store a symbol with their real name. - + * keywords.h, keywords.c, deprecated.h, deprecated.c (SCM_KEYWORDP, SCM_KEYWORDSYM): Deprecated and implemented in terms of scm_is_keyword and scm_keyword_dash_symbol. - + * keywords.h, keywords.c, discouraged.h, discouraged.c (scm_make_keyword_from_dash_symbol, scm_keyword_dash_symbol, scm_c_make_keyword): Discouraged. @@ -3212,7 +3654,7 @@ (scm_is_keyword, scm_from_locale_keyword, scm_from_locale_keywordn): New. - * goops.c: Replaced SCM_KEYWORDP with scm_is_keyword. + * goops.c: Replaced SCM_KEYWORDP with scm_is_keyword. * snarf.h (SCM_KEYWORD, SCM_GLOBAL_KEYWORD): Use scm_from_locale_keyword instead of scm_c_make_keyword. @@ -3270,7 +3712,7 @@ (libguile_la_LIBADD): Removed THREAD_LIBS_LOCAL, which is unused now. (libpath.h): Put GUILE_CFLAGS in the build-info. - + 2004-09-23 Marius Vollmer <mvo@zagadka.de> * print.h (scm_print_state): Added highlight_objects. @@ -3282,14 +3724,14 @@ * backtrace.h, backtrace.c (scm_display_backtrace_with_highlights, scm_backtrace_with_highlights): New. Set highlight_objects of printstate. - + * error.c (scm_error_scm): Document new meaning of data/rest argument for out-of-range and wrong-type-arg errors. (scm_out_of_range, scm_out_of_range_pos, scm_wrong_type_arg, scm_wrong_type_arg_msg): Pass bad_value in rest argument of exception so that it gets highlighted in the backtrace. Don't talk about "argument" when not giving a position. - + * throw.c (handler_message): The rest argument is the fourth argument, not everything after the third. Call scm_display_backtrace_with_highlights, passing the rest argument @@ -3353,8 +3795,8 @@ * strings.h, strings.c (scm_substring_read_only, scm_c_substring_read_only, scm_i_substring_read_only): New. (RO_STRING_TAG, IS_RO_STRING): New. - (scm_i_string_writable_chars): Bail on read-only strings. - + (scm_i_string_writable_chars): Bail on read-only strings. + * read.c (scm_lreadr): use scm_c_substring_read_only for string literals, thus making them read-only as specified by R5RS. @@ -3369,7 +3811,7 @@ numbers.c. (scm_to_mpz, scm_from_mpz): New. Thanks to Andreas Vögele! - + * read.c (skip_scsh_block_comment): Recognize "!#" everywhere, not just on a line of its own. @@ -3380,7 +3822,7 @@ over- or underflow occurs. Thanks to Andreas Vögele! (scm_xsubstring, scm_string_xcopy_x): Use ints for 'extended' indices, which can also be negative. - + 2004-09-20 Marius Vollmer <mvo@zagadka.de> * gc-mark.c (SCM_MARK_BACKING_STORE): Removed, it was unused. @@ -3418,7 +3860,7 @@ (scm_lreadr): Abort on seeing "#!", which should no longer happen. (skip_scsh_block_comment): Use scm_input_error instead of scm_misc_error in case of EOF. - + 2004-09-07 Kevin Ryde <user42@zip.com.au> * numbers.c (scm_integer_expt): Reject exponent +/-inf. @@ -3492,7 +3934,7 @@ scm_i_string_chars et al. Copious scm_remember_upto_heres have been inserted. Made sure that no internal string pointer is used across a SCM_TICK or a possible GC. - + * script.c (scm_compile_shell_switches): Use scm_from_locale_string instead of scm_makfrom0str. @@ -3507,7 +3949,7 @@ * srfi-13.c, srfi-13.h, srfi-14.c, srfi-14.h: New files. * strop.h, strop.c: Removed, they are now empty. * Makefile.am: Updated for new and removed files. - + * symbols.h, symbols.c (scm_string_ci_to_symbol): Moved here, next to scm_string_to_symbol. @@ -3521,7 +3963,7 @@ scm_string_geq_p, scm_string_ci_less_p, scm_string_ci_leq_p, scm_string_ci_gr_p, scm_string_ci_geq_p): Use scm_string_eq, etc instead of explicit code. - + * deprecated.c, load.c, posix.c, unif.c, symbols.c: Include "srfi-13.h" instead of "strop.h". @@ -3539,14 +3981,14 @@ scm_i_string_char, scm_i_string_writable_chars): Use it. (scm_i_substring_copy): Make START argument optional for C callers, for upcoming SRFI-13 integration. - + 2004-08-21 Marius Vollmer <mvo@zagadka.de> From Richard Todd, Thanks! - + * script.c (scm_compile_shell_switches): added '-L' switch to add to the %load-path. - + 2004-08-21 Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> * eval.c (unmemoize_exprs): When dropping internal body markers @@ -3564,7 +4006,7 @@ scm_i_string_writable_chars doesn't give that. Fixed by letting mkstemp modify a locale version of the tmpl argument and copying the result back into tmpl. - + * strop.c (scm_substring_move_x): Store into str2, not str1. 2004-08-20 Kevin Ryde <user42@zip.com.au> @@ -3583,7 +4025,7 @@ New string implementation, with copy-on-write strings and mutation-sharing substrings, and a new internal string API. Symbols can now share memory with strings. - + * tags.h (scm_tc7_stringbuf): New tag. * strings.h, strings.c: (scm_i_string_chars, scm_i_string_length, @@ -3638,12 +4080,12 @@ (scm_i_thread_wake_up): Unlock all threads, including ourselves, call scm_i_enter_guile. (scm_thread_mark_stacks): Expect all threads to be suspended. - + * gc.h, gc.c (scm_i_gc_admin_mutex): New, to protect scm_gc_mallocated, for now. (scm_init_storage): Initialize it. * gc-malloc.c (descrease_mtrigger, increase_mtrigger): Use it. - + * gc-mark.c (scm_gc_mark_dependencies): Call scm_i_string_mark, scm_i_stringbuf_mark and scm_i_symbol_mark, as appropriate. * gc-card.c (scm_i_sweep_card): Call scm_i_string_free, @@ -3686,7 +4128,7 @@ (scm_recv, scm_send, scm_recvfrom, scm_sendto): Use SCM_I_STRING_CHARS and SCM_I_STRING_LENGTH instead of SCM_STRING_CHARS and SCM_STRING_LENGTH. - + * simpos.c (scm_system): Convert SCM strings to locale strings instead of accessing their internals. @@ -3710,12 +4152,12 @@ (scm_basename, scm_dirname): Use SCM_I_STRING_CHARS and SCM_I_STRING_LENGTH instead of SCM_STRING_CHARS and SCM_STRING_LENGTH. - + * extensions.c (load_extension): Convert lib and init to locale strings instead of accessing the internals directly. (scm_c_load_extension): Use scm_from_locale_string instead of scm_makfrom0str. - + * fports.h, fports.c (scm_i_fdes_to_port): New, like scm_fdes_to_port, but take mode bits directly instead of as a C string. @@ -3734,7 +4176,7 @@ (scm_void_port): Implement using above. (scm_sys_make_void_port): Use scm_i_void_port together with scm_i_mode_bits to avoid accessing internals of SCM string. - + * strings.h, strings.c (scm_i_get_substring_spec): New. * socket.c, rw.c, deprecated.h, validate.h @@ -3743,7 +4185,7 @@ scm_to_locale_string, etc. (SCM_VALIDATE_SUBSTRING_SPEC_COPY): Deprecated. Replaced as above, plus scm_i_get_substring_spec. - + * regex-posix.c, read.c, random.c, ramap.c, print.c, numbers.c, hash.c, gc.c, gc-card.c, convert.i.c, backtrace.c, strop.c, strorder.c, strports.c, struct.c, symbols.c, unif.c, ports.c: Use @@ -3761,7 +4203,7 @@ (scm_putenv): Rewritten to use only C strings. (scm_setlocale, scm_crpt): Convert argument strings to locale strings. - + 2004-08-11 Marius Vollmer <marius.vollmer@uni-dortmund.de> * load.c (scm_primitive_load_path): Do not check for absolute @@ -3805,7 +4247,7 @@ (scm_string_append): Use memcpy instead of explicit loop. Do not use register keyword. Use plain 'char' instead of 'unsigned char'. - + * strports.c (scm_mkstrport): Use SCM_I_STRING_UCHARS instead of SCM_STRING_UCHARS. Use SCM_I_STRINGP instead of SCM_STRINGP. @@ -3821,7 +4263,7 @@ SCM_STRING_LENGTH with SCM_I_STRINGP, SCM_I_STRING_CHARS, and SCM_I_STRING_LENGTH, respectively. (gh_scm2newstr): Implement in terms of scm_to_locale_string. - + * environments.c: Instead calling scm_puts on the SCM_STRING_CHARS of a string, call scm_display on the string itself. @@ -3847,7 +4289,7 @@ scm_error, this avoids the back and forth conversion of SUBR and MESSAGE and also plugs a memory leak. (scm_error): Call scm_error_scm. - + * backtrace.c: Replaced SCM_STRINGP with scm_is_string. (display_header): Print FNAME when it is true, not merely when it is a string. @@ -3855,7 +4297,7 @@ * strings.h (SCM_SET_STRING_LENGTH, SCM_SET_STRING_CHARS): Removed unceremoniously. They were unused by Guile itself, and external use should stop immediately. - + 2004-08-10 Marius Vollmer <mvo@zagadka.de> @@ -3863,7 +4305,7 @@ scm_truncate): Renamed to scm_c_round and scm_c_truncate; deprecated versions installed in deprecated.h and deprecated.c. Changed all uses. - + 2004-08-06 Rob Browning <rlb@defaultvalue.org> * net_db.c (scm_resolv_error): don't cause an exception while @@ -3893,7 +4335,7 @@ stat on the filename, to be certain a file rename can't mean we get info on one filesystem object but open another. This fstat usage is similar to Emacs copy-file. - + * posix.c (scm_setgroups): Enhance docstring, per doc/ref/posix.texi. * simpos.c (scm_system_star): Change scm_from_long to scm_from_int on @@ -3915,7 +4357,7 @@ New. (scm_make_complex): Discouraged by moving to discouraged.h and discouraged.c. Replaced all uses with scm_c_make_rectangular. - + * discouraged.h, discouraged.c, numbers.c, numbers.h (scm_is_rational): New. (scm_i_short2big, scm_i_int2big, scm_i_uint2big, scm_i_size2big, @@ -3931,7 +4373,7 @@ explicit code. (scm_from_double): Do not implement in terms of scm_make_real, use explicit code. - + 2004-08-02 Marius Vollmer <marius.vollmer@uni-dortmund.de> * init.c (scm_init_guile_1): Call scm_i_init_discouraged. @@ -3963,7 +4405,7 @@ * numbers.h, numbers.c: Removed GUILE_DEBUG code. (scm_i_short2big, scm_i_ushort2big, scm_i_int2big, scm_i_uint2big, scm_i_size2big, scm_i_ptrdiff2big): Removed. - (scm_i_long2big, scm_i_ulong2big): New, explicit definitions. + (scm_i_long2big, scm_i_ulong2big): New, explicit definitions. * conv-integer.i.c, conv-uinteger.i.c: Use them instead of explicit code. @@ -4017,7 +4459,7 @@ SCM_T_INT64_MIN, SCM_T_INT64_MAX, SCM_T_UINT64_MAX, SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, SCM_T_UINTMAX_MAX): Moved definition into __scm.h, using new SCM_I_TYPE_MIN, etc. - + * conv-integer.i.c, conv-uinteger.i.c: New files, used to generate the functions below. @@ -4032,11 +4474,11 @@ (scm_to_signed_integer, scm_to_unsigned_integer, scm_from_signed_integer, scm_from_unsigned_integer): Generate via conv-integer.i.c and conv-uinteger.i.c, as well. - + * number.h (scm_to_ssize_t, scm_to_size_t): Use the new SCM_I_SSIZE_MIN, SCM_I_SSIZE_MAX, and SCM_I_SIZE_MAX macros for the limits. Those are always defined. - + 2004-07-29 Kevin Ryde <user42@zip.com.au> * posix.c (scm_ttyname): Use scm_i_misc_mutex for thread safety. @@ -4056,7 +4498,7 @@ Reimplement using scm_is_false, scm_is_true, scm_is_bool, and scm_from_bool, respectively. (SCM_NINUMP): Added. - + * tags.h, deprecated.h (SCM_EQ_P): Deprecated by moving it into deprecated.h. Replaced all uses with scm_is_eq. @@ -4077,7 +4519,7 @@ * dynwind.c (scm_i_dowinds): Removed unused code that would call the unexisting scm_cross_dynwind_binding_scope for inums on the windlist. - + 2004-07-10 Marius Vollmer <marius.vollmer@uni-dortmund.de> * socket.c (ipv6_net_to_num, scm_from_ipv6): Renamed @@ -4088,7 +4530,7 @@ an IPv& byte-wise address to a SCM integer. Changed all uses. (bignum_in_ipv6_range_p, VALIDATE_INET6): Removed, their function is now done by scm_to_ipv6. - + * numbers.c (scm_to_signed_integer, scm_to_unsigned_integer): dot not accept inexact integers. @@ -4122,7 +4564,7 @@ use CHAR_BIT instead of hardcoding 8. (LLONG_MIN, LLONG_MAX, ULLONG_MAX): Removed and used SCM_I_LLONG_MIN etc. instead. - + * numbers.h (SCM_MAKINUM, SCM_I_MAKINUM): Renamed SCM_MAKINUM to SCM_I_MAKINUM and changed all uses. * deprecated.h, deprecated.c (SCM_MAKINUM): Newly deprecated. @@ -4150,7 +4592,7 @@ scm_from_uint8, scm_from_int16, scm_from_uint16, scm_from_int32, scm_from_uint32, scm_from_int64, scm_from_uint64, scm_from_intmax, scm_from_uintmax): New. - + 2004-07-06 Marius Vollmer <marius.vollmer@uni-dortmund.de> * tags.h (scm_is_eq): New. @@ -4174,7 +4616,7 @@ scm_from_uint, scm_from_long, scm_from_ulong, scm_from_size_t, scm_from_ssize_t, scm_is_real, scm_to_double, scm_from_double): New. - + 2004-07-05 Marius Vollmer <marius.vollmer@uni-dortmund.de> * boolean.h, boolean.c (scm_is_true, scm_is_false, scm_from_bool, @@ -4254,7 +4696,7 @@ unmemoize_do, unmemoize_if, unmemoize_lambda, unmemoize_let, unmemoize_letrec, unmemoize_letstar, unmemoize_or, unmemoize_set_x, unmemoize_apply, unmemoize_atcall_cc, - unmemoize_at_call_with_values, unmemoize_future, sym_atslot_ref, + unmemoize_at_call_with_values, unmemoize_future, sym_atslot_ref, unmemoize_atslot_ref, sym_atslot_set_x, unmemoize_atslot_set_x, unmemoize_builtin_macro): New static functions and symbols. @@ -4282,7 +4724,7 @@ macroexp and made static. Added new version of scm_macroexp that emits a deprecation warning and then calls macroexp. (scm_m_undefine): Issue deprecation warning. - + 2004-05-30 Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> * eval.c (lookup_global_symbol, literal_p, try_macro_lookup): @@ -4390,7 +4832,7 @@ Convert floating point numbers into strings with an arbitrary radix. Thanks to Richard Todd! - + * numbers.c (FLOBUFLEN): Increase so that radix 2 strings will fit. (fx): Removed. @@ -4476,7 +4918,7 @@ * num2integral.i.c (NUM2INTEGRAL): Test BIGMPZ_FITSP with "!= 0" to avoid warning from gcc 3.4. Reported by Hyperdivision. - + * numbers.c (scm_bit_extract): Use min instead of MIN. (MIN): Remove, this conflicts with similar macro defined by limits.h on HP-UX. Reported by Andreas Vögele. @@ -4563,7 +5005,7 @@ rounding in x+0.5 when x is a big value already an integer. In certain hardware rounding cases x+0.5 can give an adjacent integer, leading to that as the result, when we really just wanted x itself. - + 2004-04-19 Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> * eval.c (scm_unmemocopy): Fixed unmemoization of let*. @@ -4613,7 +5055,7 @@ 2004-04-15 Kevin Ryde <user42@zip.com.au> * cpp_sig_symbols.in: Add SIGSYS. - + * list.c (scm_append_x): Use iterative style, to avoid non-tail recursion. @@ -4630,9 +5072,9 @@ * inline.h (scm_cell): use SCM_GC_CELL_WORD for checking tag. * chars.h (scm_init_chars): change scm_{upcase,downcase} to - scm_c_{up,down}case. + scm_c_{up,down}case. (SCM_MAKE_CHAR): add (unsigned char) cast. This prevents havoc - when hi-bit ASCII is subjected to SCM_MAKE_CHAR(). + when hi-bit ASCII is subjected to SCM_MAKE_CHAR(). 2004-04-06 Kevin Ryde <user42@zip.com.au> @@ -4840,7 +5282,7 @@ SCM_DEBUG_CELL_ACCESSES is not defined. Scheme source code should use (if (defined? 'set-debug-cell-accesses!) .. ) to switch on debugging conditionally. - + 2004-03-21 Kevin Ryde <user42@zip.com.au> * stime.c (scm_gmtime): Use gmtime_r when available, for thread safety. @@ -4912,10 +5354,10 @@ * gc.h (scm_gc_cells_collected): Removed duplicated declaration. Thanks to Bill Schottstaedt! - + * socket.h (scm_gethost): Removed prototype it is already in "net_db.h". Thanks to Bill Schottstaedt! - + 2004-02-18 Kevin Ryde <user42@zip.com.au> * num2integral.i.c (INTEGRAL2BIG): WORDS_BIGENDIAN not right for word @@ -5008,7 +5450,7 @@ * read.h: Remove conditionally compiled last arg to scm_lreadparen. (SCM_ELISP_VECTORS_P, SCM_ESCAPED_PARENS_P): New. - + 2004-01-23 Han-Wen Nienhuys <hanwen@xs4all.nl> * eval.c (m_expand_body): remove stray variable new_body. @@ -5030,7 +5472,7 @@ * dynwind.h, dynwind.c (scm_frame_unwind, scm_frame_unwind_handler): Renamed and changed all uses. (scm_frame_rewind, scm_frame_rewind_handler): Likewise. - + 2004-01-11 Kevin Ryde <user42@zip.com.au> * unif.c (scm_bit_count, scm_bit_position, s_scm_bit_set_star_x, @@ -5056,14 +5498,14 @@ case of only one fluid. (scm_with_fluid): New. (scm_c_with_fluid): Use frames instead of scm_c_with_fluids. - + * fluids.h, fluids.c (scm_frame_fluid): New. (scm_with_fluid): New. (scm_i_swap_fluids, scm_i_swap_fluids_reverse): Removed. * dynwind.c (scm_frame_end): Do not use scm_i_dowinds. Instead, do the unwinding directly. It is simple enough. - + * dynwind.h, dynwind.c: Did the following renamings: scm_begin_frame -> scm_frame_begin, scm_end_frame -> scm_frame_end, @@ -5077,7 +5519,7 @@ scm_with_blocked_asyncs -> scm_frame_block_asyncs, scm_with_unblocked_asyncs -> scm_frame_unblock_asyncs. Changed all uses. - + * ports.h, ports.c: Did the follwing renamings: scm_with_current_input_port -> scm_frame_current_input_port, scm_with_current_output_port -> scm_frame_current_output_port, @@ -5109,12 +5551,12 @@ (WINDER_F_MARK, WINDER_MARK_P, winder_mark): New. (scm_on_unwind_with_scm, scm_on_rewind_with_scm): New. Use above to protect SCM values. - + * dynwind.h (SCM_F_WIND_EXPLICITELY, SCM_F_WIND_EXPLICITLY): It's "explicitly" not "explicitely", damn. Changed all uses. (scm_on_unwind_with_scm, scm_on_rewind_with_scm): New. - + 2004-01-05 Marius Vollmer <mvo@zagadka.de> * ports.h, ports.c (scm_with_current_input_port, @@ -5143,12 +5585,12 @@ rewinding. (scm_dynthrow): Do not call scm_dowinds, this is now done by copy_stack_and_call. - + 2004-01-04 Kevin Ryde <user42@zip.com.au> * numbers.c (scm_less_p): Don't convert frac to float for compares, can give bad results due to rounding. - + * stime.c (scm_current_time, scm_gettimeofday): Add a comment about setzone/restorezone protection for DOS. @@ -5249,13 +5691,13 @@ 2003-11-18 Marius Vollmer <marius.vollmer@uni-dortmund.de> Support for exact fractions from Bill Schottstaedt! Thanks! - + * print.c (scm_iprin1): Handle fractions. * objects.h (scm_class_fraction): New. - * objects.c (scm_class_fraction): New. + * objects.c (scm_class_fraction): New. (scm_class_of): Handle fractions. - + * hash.c (scm_hasher): Handle fractions. * numbers.c: New code for handling fraction all over the place. @@ -5278,7 +5720,7 @@ scm_rational_p): New prototypes. (scm_i_dbl2num, scm_i_fraction2double, scm_i_fraction_equalp, scm_i_print_fraction): New prototypes. - + * goops.c (create_standard_classes): Create "<fraction>" class. * gc-mark.c (scm_gc_mark_dependencies): Handle fractions. @@ -5852,7 +6294,7 @@ * numbers.c (scm_lognot): Rewrite using ~ and mpz_com, for directness and to have non-integer types rejected as per other logical funcs. - + 2003-08-28 Kevin Ryde <user42@zip.com.au> * gc.h (scm_remember_upto_here_1): Revise comments on the asm form. @@ -5889,7 +6331,7 @@ that parameter name. (scm_primitive_property_set_x): In docstring, VAL is the value parameter not CODE. - + 2003-07-27 Marius Vollmer <mvo@zagadka.de> * print.c (scm_print_symbol_name): handle more weird characters by @@ -5899,7 +6341,7 @@ * posix.c (scm_setgroups): New. Thanks to Paul Jarc! (scm_getgroups): Handle groups ids that don't fit into a fixnum. Don't use SCM_WRITABLE_VELTS. - + * gc.h (SCM_GC_SET_CELL_BVEC): New. * gc-card.c (scm_i_init_card_freelist): Use it. Thanks to Matthias Koeppe! @@ -5977,13 +6419,13 @@ 2003-07-03 Han-Wen Nienhuys <hanwen@cs.uu.nl> - * __scm.h (SCM_ASSERT): change "else" expansion to "do { } while (0)" + * __scm.h (SCM_ASSERT): change "else" expansion to "do { } while (0)" 2003-07-02 Han-Wen Nienhuys <hanwen@cs.uu.nl> * __scm.h (SCM_ASRTGO): add "else" to macro expansions with if clauses. - + 2003-06-29 Marius Vollmer <mvo@zagadka.de> * deprecated.h (SCM_OPDIRP, scm_fport, scm_option, scm_srcprops, @@ -5998,7 +6440,7 @@ * continuations.c: Redeclaration of getcontext() via the __asm__ ("getcontext") directive. - * continuations.h: Include <ucontext.h> instead of + * continuations.h: Include <ucontext.h> instead of <sys/ucontext.h>. 2003-06-21 Kevin Ryde <user42@zip.com.au> @@ -6029,7 +6471,7 @@ (scm_getspecific, scm_setspecific): Made these two function real part of the API. - * posix.c (s_scm_putenv): Added some code to make a + * posix.c (s_scm_putenv): Added some code to make a (putenv "FOO="), i.e. setting an empty string, work also on Win32 systems. Thanks to Kevin Ryde for the proposal. @@ -6077,7 +6519,7 @@ * read.c (scm_input_error): Pass arg list parameter to scm_error_scm, rather than SCM_EOL. Needed by "Unknown # object" case in scm_lreadr. - + 2003-06-04 Dirk Herrmann <D.Herrmann@tu-bs.de> * __scm.h, gc-card.c (SCM_DEBUG_DEBUGGER_SUPPORT, @@ -6161,7 +6603,7 @@ 2003-05-30 Stefan Jahn <stefan@lkcc.org> - * posix.c (s_scm_putenv): Use the new HAVE_UNSETENV + * posix.c (s_scm_putenv): Use the new HAVE_UNSETENV appropriately for mingw32 hosts. * numbers.h: Defining copysign(), isnan() and finite() to @@ -6192,13 +6634,13 @@ * load.c (s_scm_search_path): Fixed absolute and relative path detections for native Windows platforms. - * gc.h, threads.h: Export some more symbols using SCM_API (necessary + * gc.h, threads.h: Export some more symbols using SCM_API (necessary to build on mingw32). - * gc-freelist.c ("s_scm_map_free_list", + * gc-freelist.c ("s_scm_map_free_list", "s_scm_gc_set_debug_check_freelist_x"): Fixed use of FUNC_NAME. - * fports.c (fport_fill_input): Disable use of + * fports.c (fport_fill_input): Disable use of fport_wait_for_input() on Win32 platforms. * filesys.c (s_scm_basename): Fixed __MINGW32__ code. @@ -6254,7 +6696,7 @@ branch. Some have been slightly rewritten. (scm_i_object_chars, scm_i_object_length): New, to support SCM_CHARS, SCM_UCHARS, and SCM_LENTH. - + 2003-05-19 Dirk Herrmann <D.Herrmann@tu-bs.de> * eval.c (scm_m_do, unmemocopy, SCM_CEVAL): Reversed order of @@ -6308,7 +6750,7 @@ (print_state_mutex): New mutex. (scm_make_print_state, scm_free_print_state, scm_prin1): Lock/unlock print_state_mutex. - + * deprecated.h (SCM_GC8MARKP, SCM_SETGC8MARK, SCM_CLRGC8MARK): Use current names in definitions. @@ -6391,7 +6833,7 @@ scm_port_for_each. (scm_port_for_each): Reimplemented using scm_c_port_for_each. * ports.h (scm_c_port_for_each): New prototype. - + 2003-04-28 Mikael Djurfeldt <djurfeldt@nada.kth.se> * eval.c (scm_m_atdispatch): Removed until actually needed. (This @@ -6656,7 +7098,7 @@ * goops.c (prep_hashsets): make static to match prototype. (scm_sym_args): SCM_SYMBOL -> SCM_GLOBAL_SYMBOL. Thanks to Albert Chin. - + * c-tokenize.lex: remove trailing comma from enum. Thanks to Albert Chin. @@ -6922,7 +7364,7 @@ builds work. (DOT_X_FILES): Removed "iselect.x". (DOT_DOC_FILES): Removed "iselect.doc". - + 2003-03-25 Rob Browning <rlb@defaultvalue.org> * win32-socket.h: #include "libguile/__scm.h". Replace usage of @@ -7446,7 +7888,7 @@ * goops.c (scm_sys_prep_layout_x): Bugfix: Only create layout for slots with instance allocation. - + * goops.c, goops.h (scm_class_extended_generic_with_setter): New class. (scm_compute_applicable_methods): Use scm_generic_function_methods. @@ -7481,7 +7923,7 @@ * Makefile.am (c-tokenize.o): Refer to source via $< so that vpath builds work. (EXTRA_DIST): Added version.h.in. - + 2002-12-21 Mikael Djurfeldt <djurfeldt@nada.kth.se> This change makes it possible for one thread to do lazy sweeping @@ -7662,7 +8104,7 @@ These changes remove scm_ints_disabled (which hasn't has any effect in Guile for quite some time). - + * async.c, error.h (scm_ints_disabled): Removed. * gc.c (scm_gc_for_newcell), init.c (scm_init_guile_1), @@ -7687,7 +8129,7 @@ threads, though. Signalling and error handling for threads is very likely broken. Work on making the implementation cleaner and more efficient is needed. - + * __scm.h (SCM_ALLOW_INTS_ONLY): Removed. (SCM_NONREC_CRITICAL_SECTION_START, SCM_NONREC_CRITICAL_SECTION_END, SCM_REC_CRITICAL_SECTION_START, @@ -7735,7 +8177,7 @@ * Makefile.am (version.h): Changed $^ --> $< in rule for version.h. - + 2002-12-08 Rob Browning <rlb@defaultvalue.org> * version.h.in (SCM_MICRO_VERSION): use @--@ substitution now. @@ -7760,13 +8202,13 @@ implements the rest on top of that. Guile's implementation is what the "coop-pthreads" package has been previously. Support for "coop" threads has been removed until I get time to add it again. - + * Makefile.am (libguile_la_SOURCES): Removed iselect.c. (noinst_HEADERS): Removed coop-threads.c, coop-threads.h, coop.c, null-threads.c, coop-pthreads.c. (modinclude_HEADERS): Removed coop-defs.h, coop-pthreads.h. Added pthread-threads.h. - + * validate.h (SCM_VALIDATE_THREAD): Moved to threads.h. * threads.h: Do not include "libguile/coop-defs.h". Include @@ -7792,7 +8234,7 @@ * pthread-threads.h: New, implement pthread-like API by deferring to pthread itself. - + * init.c (scm_init_guile_1): Do not call scm_init_iselect, which has been lost in the reorganization. @@ -7820,7 +8262,7 @@ case; Use trampolines. Other changes: - + * sort.c (scm_cmp_function): Choose subr2less for scm_tc7_subr_2o; (subr2oless): Removed. (scm_restricted_vector_sort_x): Use scm_return_first to keep the @@ -7915,13 +8357,13 @@ SCM_COPT_THREADS is defined. (SCM_SYSCALL): Use EINTR-expection version when SCM_COPT_THREADS is defined. - + * coop-pthreads.c: Some harmless renamings of internal stuff. (create_thread): New, generalized version of scm_call_with_new_thread. (scm_call_with_new_thread): Use it. (scm_spawn_thread): New, use create_thread. - + 2002-11-02 Marius Vollmer <mvo@zagadka.ping.de> * coop-pthreads.c, coop-pthreads.h: Redone completely, you might @@ -7940,7 +8382,7 @@ (take_signal): Simplified, to avoid race conditions. (scm_sigaction_for_thread): Use new Scheme. Validate that thread hasn't exited yet. - + * async.c (scm_async_click): Reset pending_asyncs, handle signal_asyncs. Don't set cdr of a non-signal async to #f. (scm_i_queue_async_cell): Do not check cdr of cell for #f, queue @@ -7949,7 +8391,7 @@ exited. (scm_unmask_signals, decrease_block): Call scm_async_click after block_asyncs becomes zero. - + * __scm.h (SCM_ASYNC_CLICK): Check pending_asyncs instead of active_asyncs. @@ -7957,16 +8399,16 @@ fields. * root.c (root_mark): Mark them. (make_root): Initialize them. - + * iselect.c, iselect.h: Replaced GUILE_ISELECT with USE_COOP_THREADS. (scm_internal_select): Define one version for USE_COOP_THREADS and one for USE_NULL_THREADS. (scm_init_iselect): Likewise. - + * inline.h (scm_cell, scm_double_cell): Also allow USE_COPT_THREADS to not protect the slot initializers. - + * init.c (scm_init_guile_1): Call scm_init_thread_procs. This is because threads need to be initialized before the stack, but gsubrs such as scm_timed_condition_variable_wait can only be @@ -8015,7 +8457,7 @@ scm_cond_wait, scm_cond_signal, scm_cond_broadcast, scm_cond_destory): Do not define, they are now deprecated and handled by threads.{h,c}. - + * null-threads.c (scm_null_mutex, scm_null_cond): Define here. (scm_threads_init): Create smobs here, using the appropriate sizes. @@ -8057,7 +8499,7 @@ * goops.c (hell_mutex): Reimplemented using scm_make_mutex, etc. * coop-pthreads.h, coop-pthreads.c: New, but unfinished. - + 2002-10-21 Marius Vollmer <mvo@zagadka.ping.de> * null-threads.c: Include <time.h>. Also, use <...> for inclusion @@ -8136,7 +8578,7 @@ * scmsigs.c (scm_sigaction_for_thread): Store original handler in signal_handlers, not the closure that is used as the async. The closure is stored in signal_handler_cells, as previously. - + 2002-10-10 Marius Vollmer <mvo@zagadka.ping.de> * root.h (scm_root_state): Added 'block_async' slot. @@ -8161,7 +8603,7 @@ (increase_block, decrease_block, scm_call_with_blocked_asyncs, scm_call_with_unblocked_asyncs, scm_c_call_with_blocked_asyncs, scm_c_call_with_unblocked_asyncs): New. - + * script.c (scm_compile_shell_switches): Do not set scm_mask_ints. Asyncs are enabled by default. @@ -8182,7 +8624,7 @@ (scm_system_async_mark_for_thread): Initialize cdr of handler cell with SCM_BOOL_F. * scmsigs.c (scm_sigaction_for_thread): Likewise. - + 2002-10-04 Rob Browning <rlb@defaultvalue.org> * guile.c (main): switch to scm_lt_dlset_preloaded_symbols; @@ -8228,7 +8670,7 @@ scm_set_switch_rate, scm_system_async_mark_from_signal_handler): Removed prototypes. (scm_i_queue_async_cell): New. - + * __scm.h (scm_asyncs_pending_p): Removed. (SCM_ASYNC_CLICK): Check scm_active_asyncs instead of scm_asyncs_pending_p. @@ -8275,7 +8717,7 @@ 2002-09-19 Han-Wen Nienhuys <hanwen@cs.uu.nl> - * inline.h (scm_double_cell): move SET_GCMARK set out of if body. + * inline.h (scm_double_cell): move SET_GCMARK set out of if body. 2002-09-09 Han-Wen Nienhuys <hanwen@cs.uu.nl> @@ -8296,7 +8738,7 @@ * gc-malloc.c (scm_gc_init_malloc): check user settings for sanity. - * gc-freelist.c (scm_init_freelist): check user settings for sanity. + * gc-freelist.c (scm_init_freelist): check user settings for sanity. * struct.h: change scm_structs_to_free to scm_i_structs_to_free @@ -8363,7 +8805,7 @@ 2002-08-23 Han-Wen Nienhuys <hanwen@cs.uu.nl> * gc-segment.c (scm_i_get_new_heap_segment): Oops. We want segment - length *at* least SCM_MIN_HEAP_SEG_SIZE, not at most. + length *at* least SCM_MIN_HEAP_SEG_SIZE, not at most. 2002-08-22 Han-Wen Nienhuys <hanwen@cs.uu.nl> @@ -8394,7 +8836,7 @@ function * ports.h: use scm_i_ prefix for port table and port table size. - + 2002-08-15 Mikael Djurfeldt <mdj@linnaeus> * vports.c (scm_make_soft_port): Initialize pt variable. @@ -8409,12 +8851,12 @@ (scm_eval_string): Implement using scm_eval_string_in_module. (scm_c_eval_string_in_module): New. Thanks to Ralf Mattes for the suggestion! - + 2002-08-09 Han-Wen Nienhuys <hanwen@cs.uu.nl> * gc-card.c ("sweep_card"): remove SCM_MISC_ERROR messages: print message and abort. - + * gc-mark.c ("scm_gc_mark_dependencies"): idem. * ports.c ("scm_new_port_table_entry"): return a boxed SCM in @@ -8438,7 +8880,7 @@ 2002-08-05 Han-Wen Nienhuys <hanwen@cs.uu.nl> - * tags.h: remove GC bits documentation from the tags table. + * tags.h: remove GC bits documentation from the tags table. * read.c (INPUT_ERROR): Prepare for file:line:column error messages for errors in scm_lreadr() and friends. @@ -8446,14 +8888,14 @@ 2002-08-04 Han-Wen Nienhuys <hanwen@cs.uu.nl> * gc-malloc.c (scm_malloc): use scm_realloc() (simplifies - implementation). + implementation). (scm_gc_calloc): new function 2002-08-04 Han-Wen Nienhuys <hanwen@cs.uu.nl> * ports.c (scm_new_port_table_entry): init port entry to 0 completely. - + * ports.c (scm_new_port_table_entry): change function from scm_add_to_port_table. This prevents cells with null-pointers from being exposed to GC. @@ -8484,7 +8926,7 @@ 2002-07-24 Stefan Jahn <stefan@lkcc.org> - * continuations.h: ia64: Include <signal.h> before + * continuations.h: ia64: Include <signal.h> before <sys/ucontext.h>. 2002-07-21 Dirk Herrmann <D.Herrmann@tu-bs.de> @@ -8517,7 +8959,7 @@ * *.c: use SCM_VECTOR_SET everywhere, where a vector is written. Document cases where SCM_WRITABLE_VELTS() is used. - + * vectors.h (SCM_VELTS): prepare for write barrier, and let SCM_VELTS() return a const pointer (SCM_VECTOR_SET): add macro. diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 88287508a..0687c03a2 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007 Free Software Foundation, Inc. +## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -23,11 +23,19 @@ AUTOMAKE_OPTIONS = gnu ## Prevent automake from adding extra -I options DEFS = @DEFS@ + +# Override Automake's `DEFAULT_INCLUDES'. By default, it contains +# "-I$(srcdir)", which causes problems on Tru64 where our "random.h" +# is picked up by <stdlib.h> instead of the libc's <random.h>. +DEFAULT_INCLUDES = + ## Check for headers in $(srcdir)/.., so that #include ## <libguile/MUMBLE.h> will find MUMBLE.h in this dir when we're ## building. Also look for Gnulib headers in `lib'. -INCLUDES = -I.. -I$(top_srcdir) \ - -I$(top_srcdir)/lib -I$(top_builddir)/lib +AM_CPPFLAGS = -I$(top_srcdir) -I$(top_builddir) \ + -I$(top_srcdir)/lib -I$(top_builddir)/lib + +AM_CFLAGS = $(GCC_CFLAGS) ## The Gnulib Libtool archive. gnulib_library = $(top_builddir)/lib/libgnu.la @@ -47,7 +55,7 @@ gen_scmconfig_SOURCES = gen-scmconfig.c ## For some reason, OBJEXT does not include the dot gen-scmconfig.$(OBJEXT): gen-scmconfig.c if [ "$(cross_compiling)" = "yes" ]; then \ - $(CC_FOR_BUILD) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) -c -o $@ $<; \ + $(CC_FOR_BUILD) $(DEFS) $(DEFAULT_INCLUDES) $(AM_CPPFLAGS) -c -o $@ $<; \ else \ $(COMPILE) -c -o $@ $<; \ fi @@ -75,7 +83,7 @@ guile_filter_doc_snarfage_SOURCES = c-tokenize.c ## For some reason, OBJEXT does not include the dot c-tokenize.$(OBJEXT): c-tokenize.c if [ "$(cross_compiling)" = "yes" ]; then \ - $(CC_FOR_BUILD) $(DEFS) $(INCLUDES) -c -o $@ $<; \ + $(CC_FOR_BUILD) $(DEFS) $(AM_CPPFLAGS) -c -o $@ $<; \ else \ $(COMPILE) -c -o $@ $<; \ fi @@ -91,11 +99,11 @@ guile_filter_doc_snarfage$(EXEEXT): $(guile_filter_doc_snarfage_OBJECTS) $(guile guile_SOURCES = guile.c -guile_CFLAGS = $(GUILE_CFLAGS) +guile_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS) guile_LDADD = libguile.la guile_LDFLAGS = @DLPREOPEN@ $(GUILE_CFLAGS) -libguile_la_CFLAGS = $(GUILE_CFLAGS) +libguile_la_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS) libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \ chars.c continuations.c convert.c debug.c deprecation.c \ @@ -282,7 +290,7 @@ libpath.h: $(srcdir)/Makefile.in $(top_builddir)/config.status @mv libpath.tmp libpath.h -snarfcppopts = $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) +snarfcppopts = $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS) SUFFIXES = .x .doc .c.x: @@ -332,7 +340,7 @@ schemelibdir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION) schemelib_DATA = guile-procedures.txt ## Add -MG to make the .x magic work with auto-dep code. -MKDEP = gcc -M -MG $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) +MKDEP = gcc -M -MG $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS) cpp_err_symbols.c: cpp_err_symbols.in cpp_cnvt.awk $(AWK) -f $(srcdir)/cpp_cnvt.awk < $(srcdir)/cpp_err_symbols.in > \ diff --git a/libguile/__scm.h b/libguile/__scm.h index fc581631a..d486b69bf 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -3,46 +3,22 @@ #ifndef SCM___SCM_H #define SCM___SCM_H -/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003, 2006, 2007, 2008 Free Software Foundation, Inc. * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. * - * This program is distributed in the hope that it will be useful, + * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301 USA - * - * As a special exception, the Free Software Foundation gives permission - * for additional uses of the text contained in its release of GUILE. - * - * The exception is that, if you link the GUILE library with other files - * to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the GUILE library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the - * Free Software Foundation under the name GUILE. If you copy - * code from other Free Software Foundation releases into a copy of - * GUILE, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. - * - * If you write modifications of your own for GUILE, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. */ + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + */ @@ -109,6 +85,29 @@ #endif +/* The SCM_EXPECT macros provide branch prediction hints to the compiler. To + * use only in places where the result of the expression under "normal" + * circumstances is known. */ +#if defined(__GNUC__) && (__GNUC__ >= 3) +# define SCM_EXPECT __builtin_expect +#else +# define SCM_EXPECT(_expr, _value) (_expr) +#endif + +#define SCM_LIKELY(_expr) SCM_EXPECT ((_expr), 1) +#define SCM_UNLIKELY(_expr) SCM_EXPECT ((_expr), 0) + +/* The SCM_INTERNAL macro makes it possible to explicitly declare a function + * as having "internal" linkage. */ +#if (defined __GNUC__) && \ + ((__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ == 3)) +# define SCM_INTERNAL extern __attribute__ ((__visibility__ ("internal"))) +#else +# define SCM_INTERNAL extern +#endif + + + /* {Supported Options} * * These may be defined or undefined. @@ -198,6 +197,14 @@ #define SCM_DEBUG 0 #endif +/* For debugging purposes: define this is to ensure nobody is using + * the mark bits outside of the marking phase. This is meant for + * debugging purposes only. + */ +#ifndef SCM_DEBUG_MARKING_API +#define SCM_DEBUG_MARKING_API 0 +#endif + /* If SCM_DEBUG_CELL_ACCESSES is set to 1, cell accesses will perform * exhaustive parameter checking: It will be verified that cell parameters * actually point to a valid heap cell. Note: If this option is enabled, @@ -412,7 +419,23 @@ # define setjmp setjump # define longjmp longjump # else /* ndef _CRAY1 */ -# include <setjmp.h> +# if defined (__ia64__) +/* For IA64, emulate the setjmp API using getcontext. */ +# include <signal.h> +# include <ucontext.h> + typedef struct { + ucontext_t ctx; + int fresh; + } jmp_buf; +# define setjmp(JB) \ + ( (JB).fresh = 1, \ + getcontext (&((JB).ctx)), \ + ((JB).fresh ? ((JB).fresh = 0, 0) : 1) ) +# define longjmp(JB,VAL) scm_ia64_longjmp (&(JB), VAL) + void scm_ia64_longjmp (jmp_buf *, int); +# else /* ndef __ia64__ */ +# include <setjmp.h> +# endif /* ndef __ia64__ */ # endif /* ndef _CRAY1 */ #endif /* ndef vms */ @@ -500,14 +523,14 @@ do { \ #define SCM_ASSERT_TYPE(_cond, _arg, _pos, _subr, _msg) #define SCM_ASRTGO(_cond, _label) #else -#define SCM_ASSERT(_cond, _arg, _pos, _subr) \ - do { if (!(_cond)) \ +#define SCM_ASSERT(_cond, _arg, _pos, _subr) \ + do { if (SCM_UNLIKELY (!(_cond))) \ scm_wrong_type_arg (_subr, _pos, _arg); } while (0) -#define SCM_ASSERT_TYPE(_cond, _arg, _pos, _subr, _msg) \ - do { if (!(_cond)) \ +#define SCM_ASSERT_TYPE(_cond, _arg, _pos, _subr, _msg) \ + do { if (SCM_UNLIKELY (!(_cond))) \ scm_wrong_type_arg_msg(_subr, _pos, _arg, _msg); } while (0) -#define SCM_ASRTGO(_cond, _label) \ - do { if (!(_cond)) \ +#define SCM_ASRTGO(_cond, _label) \ + do { if (SCM_UNLIKELY (!(_cond))) \ goto _label; } while (0) #endif @@ -526,8 +549,9 @@ SCM_API SCM scm_call_generic_0 (SCM gf); return (SCM_UNPACK (gf) \ ? scm_call_generic_0 ((gf)) \ : (scm_error_num_args_subr ((subr)), SCM_UNSPECIFIED)) -#define SCM_GASSERT0(cond, gf, subr) \ - if (!(cond)) SCM_WTA_DISPATCH_0((gf), (subr)) +#define SCM_GASSERT0(cond, gf, subr) \ + if (SCM_UNLIKELY(!(cond))) \ + SCM_WTA_DISPATCH_0((gf), (subr)) SCM_API SCM scm_call_generic_1 (SCM gf, SCM a1); @@ -535,8 +559,9 @@ SCM_API SCM scm_call_generic_1 (SCM gf, SCM a1); return (SCM_UNPACK (gf) \ ? scm_call_generic_1 ((gf), (a1)) \ : (scm_wrong_type_arg ((subr), (pos), (a1)), SCM_UNSPECIFIED)) -#define SCM_GASSERT1(cond, gf, a1, pos, subr) \ - if (!(cond)) SCM_WTA_DISPATCH_1((gf), (a1), (pos), (subr)) +#define SCM_GASSERT1(cond, gf, a1, pos, subr) \ + if (SCM_UNLIKELY (!(cond))) \ + SCM_WTA_DISPATCH_1((gf), (a1), (pos), (subr)) SCM_API SCM scm_call_generic_2 (SCM gf, SCM a1, SCM a2); @@ -546,8 +571,9 @@ SCM_API SCM scm_call_generic_2 (SCM gf, SCM a1, SCM a2); : (scm_wrong_type_arg ((subr), (pos), \ (pos) == SCM_ARG1 ? (a1) : (a2)), \ SCM_UNSPECIFIED)) -#define SCM_GASSERT2(cond, gf, a1, a2, pos, subr) \ - if (!(cond)) SCM_WTA_DISPATCH_2((gf), (a1), (a2), (pos), (subr)) +#define SCM_GASSERT2(cond, gf, a1, a2, pos, subr) \ + if (SCM_UNLIKELY (!(cond))) \ + SCM_WTA_DISPATCH_2((gf), (a1), (a2), (pos), (subr)) SCM_API SCM scm_apply_generic (SCM gf, SCM args); @@ -558,8 +584,9 @@ SCM_API SCM scm_apply_generic (SCM gf, SCM args); scm_list_ref ((args), \ scm_from_int ((pos) - 1))), \ SCM_UNSPECIFIED)) -#define SCM_GASSERTn(cond, gf, args, pos, subr) \ - if (!(cond)) SCM_WTA_DISPATCH_n((gf), (args), (pos), (subr)) +#define SCM_GASSERTn(cond, gf, args, pos, subr) \ + if (SCM_UNLIKELY (!(cond))) \ + SCM_WTA_DISPATCH_n((gf), (args), (pos), (subr)) #ifndef SCM_MAGIC_SNARFER /* Let these macros pass through if diff --git a/libguile/_scm.h b/libguile/_scm.h index fd05770c2..6b728be2b 100644 --- a/libguile/_scm.h +++ b/libguile/_scm.h @@ -3,46 +3,22 @@ #ifndef SCM__SCM_H #define SCM__SCM_H -/* Copyright (C) 1995,1996,2000,2001, 2002, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001, 2002, 2006, 2008 Free Software Foundation, Inc. * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. * - * This program is distributed in the hope that it will be useful, + * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301 USA - * - * As a special exception, the Free Software Foundation gives permission - * for additional uses of the text contained in its release of GUILE. - * - * The exception is that, if you link the GUILE library with other files - * to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the GUILE library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the - * Free Software Foundation under the name GUILE. If you copy - * code from other Free Software Foundation releases into a copy of - * GUILE, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. - * - * If you write modifications of your own for GUILE, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. */ + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + */ @@ -119,14 +95,6 @@ # define SCM_SYSCALL(line) line; #endif /* ndef SCM_SYSCALL */ -#if !defined (MSDOS) && !defined (__MINGW32__) -# ifdef ARM_ULIB - extern volatile int errno; -# else - extern int errno; -# endif /* def ARM_ULIB */ -#endif /* ndef MSDOS && ndef __MINGW32__*/ - #ifndef min @@ -138,14 +106,18 @@ -#if HAVE_STAT64 +#if GUILE_USE_64_CALLS && HAVE_STAT64 #define CHOOSE_LARGEFILE(foo,foo64) foo64 #else #define CHOOSE_LARGEFILE(foo,foo64) foo #endif /* These names are a bit long, but they make it clear what they represent. */ -#define dirent_or_dirent64 CHOOSE_LARGEFILE(dirent,dirent64) +#if SCM_HAVE_STRUCT_DIRENT64 == 1 +# define dirent_or_dirent64 CHOOSE_LARGEFILE(dirent,dirent64) +#else +# define dirent_or_dirent64 dirent +#endif #define fstat_or_fstat64 CHOOSE_LARGEFILE(fstat,fstat64) #define ftruncate_or_ftruncate64 CHOOSE_LARGEFILE(ftruncate,ftruncate64) #define lseek_or_lseek64 CHOOSE_LARGEFILE(lseek,lseek64) @@ -153,7 +125,11 @@ #define off_t_or_off64_t CHOOSE_LARGEFILE(off_t,off64_t) #define open_or_open64 CHOOSE_LARGEFILE(open,open64) #define readdir_or_readdir64 CHOOSE_LARGEFILE(readdir,readdir64) -#define readdir_r_or_readdir64_r CHOOSE_LARGEFILE(readdir_r,readdir64_r) +#if SCM_HAVE_READDIR64_R == 1 +# define readdir_r_or_readdir64_r CHOOSE_LARGEFILE(readdir_r,readdir64_r) +#else +# define readdir_r_or_readdir64_r readdir_r +#endif #define stat_or_stat64 CHOOSE_LARGEFILE(stat,stat64) #define truncate_or_truncate64 CHOOSE_LARGEFILE(truncate,truncate64) #define scm_from_off_t_or_off64_t CHOOSE_LARGEFILE(scm_from_off_t,scm_from_int64) diff --git a/libguile/alist.h b/libguile/alist.h index 3d1784c7f..76cccba2b 100644 --- a/libguile/alist.h +++ b/libguile/alist.h @@ -3,7 +3,7 @@ #ifndef SCM_ALIST_H #define SCM_ALIST_H -/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000, 2006, 2008 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 @@ -42,7 +42,7 @@ SCM_API SCM scm_assoc_set_x (SCM alist, SCM key, SCM val); SCM_API SCM scm_assq_remove_x (SCM alist, SCM key); SCM_API SCM scm_assv_remove_x (SCM alist, SCM key); SCM_API SCM scm_assoc_remove_x (SCM alist, SCM key); -SCM_API void scm_init_alist (void); +SCM_INTERNAL void scm_init_alist (void); #endif /* SCM_ALIST_H */ diff --git a/libguile/arbiters.h b/libguile/arbiters.h index d04244926..7a7dfd3fa 100644 --- a/libguile/arbiters.h +++ b/libguile/arbiters.h @@ -3,7 +3,7 @@ #ifndef SCM_ARBITERS_H #define SCM_ARBITERS_H -/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000, 2006, 2008 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 @@ -29,7 +29,7 @@ SCM_API SCM scm_make_arbiter (SCM name); SCM_API SCM scm_try_arbiter (SCM arb); SCM_API SCM scm_release_arbiter (SCM arb); -SCM_API void scm_init_arbiters (void); +SCM_INTERNAL void scm_init_arbiters (void); #endif /* SCM_ARBITERS_H */ diff --git a/libguile/async.h b/libguile/async.h index a81a98d74..c01bde031 100644 --- a/libguile/async.h +++ b/libguile/async.h @@ -3,7 +3,7 @@ #ifndef SCM_ASYNC_H #define SCM_ASYNC_H -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2005, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2005, 2006, 2008 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 @@ -38,10 +38,11 @@ SCM_API SCM scm_async (SCM thunk); SCM_API SCM scm_async_mark (SCM a); SCM_API SCM scm_system_async_mark (SCM a); SCM_API SCM scm_system_async_mark_for_thread (SCM a, SCM thread); -SCM_API void scm_i_queue_async_cell (SCM cell, scm_i_thread *); -SCM_API int scm_i_setup_sleep (scm_i_thread *, - SCM obj, scm_i_pthread_mutex_t *m, int fd); -SCM_API void scm_i_reset_sleep (scm_i_thread *); +SCM_INTERNAL void scm_i_queue_async_cell (SCM cell, scm_i_thread *); +SCM_INTERNAL int scm_i_setup_sleep (scm_i_thread *, + SCM obj, scm_i_pthread_mutex_t *m, + int fd); +SCM_INTERNAL void scm_i_reset_sleep (scm_i_thread *); SCM_API SCM scm_run_asyncs (SCM list_of_a); SCM_API SCM scm_noop (SCM args); SCM_API SCM scm_call_with_blocked_asyncs (SCM proc); @@ -77,7 +78,7 @@ extern int scm_i_critical_section_level; scm_async_click (); \ } while (0) -SCM_API void scm_init_async (void); +SCM_INTERNAL void scm_init_async (void); #if (SCM_ENABLE_DEPRECATED == 1) diff --git a/libguile/backtrace.h b/libguile/backtrace.h index b4033dede..e11cb85de 100644 --- a/libguile/backtrace.h +++ b/libguile/backtrace.h @@ -3,7 +3,7 @@ #ifndef SCM_BACKTRACE_H #define SCM_BACKTRACE_H -/* Copyright (C) 1996,1998,1999,2000,2001, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1996,1998,1999,2000,2001, 2004, 2006, 2008 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 @@ -27,7 +27,8 @@ SCM_API SCM scm_the_last_stack_fluid_var; SCM_API void scm_display_error_message (SCM message, SCM args, SCM port); -SCM_API void scm_i_display_error (SCM stack, SCM port, SCM subr, SCM message, SCM args, SCM rest); +SCM_INTERNAL void scm_i_display_error (SCM stack, SCM port, SCM subr, + SCM message, SCM args, SCM rest); SCM_API SCM scm_display_error (SCM stack, SCM port, SCM subr, SCM message, SCM args, SCM rest); SCM_API SCM scm_display_application (SCM frame, SCM port, SCM indent); SCM_API SCM scm_display_backtrace (SCM stack, SCM port, SCM first, SCM depth); @@ -38,7 +39,7 @@ SCM_API SCM scm_backtrace_with_highlights (SCM highlights); SCM_API SCM scm_set_print_params_x (SCM params); #endif -SCM_API void scm_init_backtrace (void); +SCM_INTERNAL void scm_init_backtrace (void); #endif /* SCM_BACKTRACE_H */ diff --git a/libguile/boolean.h b/libguile/boolean.h index 3dc82e1f6..1388c2fdc 100644 --- a/libguile/boolean.h +++ b/libguile/boolean.h @@ -3,7 +3,7 @@ #ifndef SCM_BOOLEAN_H #define SCM_BOOLEAN_H -/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000, 2006, 2008 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 @@ -43,7 +43,7 @@ SCM_API int scm_to_bool (SCM x); SCM_API SCM scm_not (SCM x); SCM_API SCM scm_boolean_p (SCM obj); -SCM_API void scm_init_boolean (void); +SCM_INTERNAL void scm_init_boolean (void); #endif /* SCM_BOOLEAN_H */ diff --git a/libguile/c-tokenize.lex b/libguile/c-tokenize.lex index 1d9b40b92..938a5d2cf 100644 --- a/libguile/c-tokenize.lex +++ b/libguile/c-tokenize.lex @@ -18,7 +18,12 @@ INTQUAL (l|L|ll|LL|lL|Ll|u|U) #include <stdio.h> #include <stdlib.h> #include <string.h> - + +/* Prevent compilation of static input() function in generated scanner + code. This function is never actually used, and GCC 4.3 will emit + an error for that. */ +#define YY_NO_INPUT + int yylex(void); int yyget_lineno (void); diff --git a/libguile/chars.h b/libguile/chars.h index 1a139e901..97c611af4 100644 --- a/libguile/chars.h +++ b/libguile/chars.h @@ -3,7 +3,7 @@ #ifndef SCM_CHARS_H #define SCM_CHARS_H -/* Copyright (C) 1995,1996,2000,2001,2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001,2004, 2006, 2008 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 @@ -62,7 +62,7 @@ SCM_API SCM scm_char_upcase (SCM chr); SCM_API SCM scm_char_downcase (SCM chr); SCM_API int scm_c_upcase (unsigned int c); SCM_API int scm_c_downcase (unsigned int c); -SCM_API void scm_init_chars (void); +SCM_INTERNAL void scm_init_chars (void); #endif /* SCM_CHARS_H */ diff --git a/libguile/continuations.c b/libguile/continuations.c index a06ae79ab..07c843d21 100644 --- a/libguile/continuations.c +++ b/libguile/continuations.c @@ -89,47 +89,30 @@ scm_make_continuation (int *first) continuation->offset = continuation->stack - src; memcpy (continuation->stack, src, sizeof (SCM_STACKITEM) * stack_size); -#ifdef __ia64__ - continuation->fresh = 1; - getcontext (&continuation->ctx); - if (continuation->fresh) + *first = !setjmp (continuation->jmpbuf); + if (*first) { +#ifdef __ia64__ continuation->backing_store_size = - (char *) scm_ia64_ar_bsp(&continuation->ctx) + (char *) scm_ia64_ar_bsp(&continuation->jmpbuf.ctx) - - (char *) scm_ia64_register_backing_store_base (); + (char *) thread->register_backing_store_base; continuation->backing_store = NULL; continuation->backing_store = scm_gc_malloc (continuation->backing_store_size, "continuation backing store"); memcpy (continuation->backing_store, - (void *) scm_ia64_register_backing_store_base (), + (void *) thread->register_backing_store_base, continuation->backing_store_size); - *first = 1; - continuation->fresh = 0; +#endif /* __ia64__ */ return cont; } else { SCM ret = continuation->throw_value; - *first = 0; - continuation->throw_value = SCM_BOOL_F; - return ret; - } -#else /* !__ia64__ */ - if (setjmp (continuation->jmpbuf)) - { - SCM ret = continuation->throw_value; - *first = 0; continuation->throw_value = SCM_BOOL_F; return ret; } - else - { - *first = 1; - return cont; - } -#endif /* !__ia64__ */ } #undef FUNC_NAME @@ -183,6 +166,9 @@ copy_stack (void *data) copy_stack_data *d = (copy_stack_data *)data; memcpy (d->dst, d->continuation->stack, sizeof (SCM_STACKITEM) * d->continuation->num_stack_items); +#ifdef __ia64__ + SCM_I_CURRENT_THREAD->pending_rbs_continuation = d->continuation; +#endif } static void @@ -200,16 +186,26 @@ copy_stack_and_call (scm_t_contregs *continuation, SCM val, scm_i_set_last_debug_frame (continuation->dframe); continuation->throw_value = val; -#ifdef __ia64__ - memcpy (scm_ia64_register_backing_store_base (), - continuation->backing_store, - continuation->backing_store_size); - setcontext (&continuation->ctx); -#else longjmp (continuation->jmpbuf, 1); -#endif } +#ifdef __ia64__ +void +scm_ia64_longjmp (jmp_buf *JB, int VAL) +{ + scm_i_thread *t = SCM_I_CURRENT_THREAD; + + if (t->pending_rbs_continuation) + { + memcpy (t->register_backing_store_base, + t->pending_rbs_continuation->backing_store, + t->pending_rbs_continuation->backing_store_size); + t->pending_rbs_continuation = NULL; + } + setcontext (&JB->ctx); +} +#endif + /* Call grow_stack until the stack space is large enough, then, as the current * stack frame might get overwritten, let copy_stack_and_call perform the * actual copying and continuation calling. diff --git a/libguile/continuations.h b/libguile/continuations.h index 0274c1b2d..1a648dd28 100644 --- a/libguile/continuations.h +++ b/libguile/continuations.h @@ -3,7 +3,7 @@ #ifndef SCM_CONTINUATIONS_H #define SCM_CONTINUATIONS_H -/* Copyright (C) 1995,1996,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001, 2006, 2008 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 @@ -46,8 +46,6 @@ typedef struct jmp_buf jmpbuf; SCM dynenv; #ifdef __ia64__ - ucontext_t ctx; - int fresh; void *backing_store; unsigned long backing_store_size; #endif /* __ia64__ */ @@ -92,14 +90,15 @@ SCM_API SCM scm_make_continuation (int *first); SCM_API void *scm_c_with_continuation_barrier (void *(*func)(void*), void *); SCM_API SCM scm_with_continuation_barrier (SCM proc); -SCM_API SCM scm_i_with_continuation_barrier (scm_t_catch_body body, - void *body_data, - scm_t_catch_handler handler, - void *handler_data, - scm_t_catch_handler pre_unwind_handler, - void *pre_unwind_handler_data); +SCM_INTERNAL SCM +scm_i_with_continuation_barrier (scm_t_catch_body body, + void *body_data, + scm_t_catch_handler handler, + void *handler_data, + scm_t_catch_handler pre_unwind_handler, + void *pre_unwind_handler_data); -SCM_API void scm_init_continuations (void); +SCM_INTERNAL void scm_init_continuations (void); #endif /* SCM_CONTINUATIONS_H */ diff --git a/libguile/coop-defs.h b/libguile/coop-defs.h deleted file mode 100644 index 9ce80358b..000000000 --- a/libguile/coop-defs.h +++ /dev/null @@ -1,223 +0,0 @@ -/* classes: h_files */ - -#ifndef SCM_COOP_DEFS_H -#define SCM_COOP_DEFS_H - -/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2002, 2006 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 - * License as published by the Free Software Foundation; either - * version 2.1 of the License, or (at your option) any later version. - * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - */ - - - -#include "libguile/__scm.h" -#include "libguile/iselect.h" - -#if SCM_HAVE_WINSOCK2_H -# include <winsock2.h> -#endif - -#ifdef GUILE_PTHREAD_COMPAT -# include <pthread.h> -#endif - -#include "libguile/boehm-gc.h" - -/* This file is included by threads.h, which, in turn, is included by - libguile.h while coop-threads.h only is included by - coop-threads.c. */ - -/* The coop_t struct must be declared here, since macros in this file - refer to the data member. */ - -/* The notion of a thread is merged with the notion of a queue. - Thread stuff: thread status (sp) and stuff to use during - (re)initialization. Queue stuff: next thread in the queue - (next). */ - -struct qt_t; - -typedef struct coop_t { - struct qt_t *sp; /* QuickThreads handle. */ - void *sto; /* `malloc'-allocated stack. */ - - struct coop_t *next; /* Next thread in the queue. */ - - struct coop_t *all_next; - struct coop_t *all_prev; - - void *data; /* Thread local data */ - void **specific; /* Data associated with keys */ - int n_keys; /* Upper limit for keys on this thread */ - - void *base; /* Base of stack */ - void *top; /* Top of stack */ - - void *joining; /* A queue of threads waiting to join this - thread */ - - SCM handle; /* SCM handle, protected via scm_all_threads. */ - - int nfds; - SELECT_TYPE *readfds; - SELECT_TYPE *writefds; - SELECT_TYPE *exceptfds; - int timeoutp; - struct timeval wakeup_time; /* Time to stop sleeping */ - int _errno; - int retval; - -#ifdef GUILE_PTHREAD_COMPAT - pthread_t dummy_thread; - pthread_mutex_t dummy_mutex; -#endif -} coop_t; - -/* A queue is a circular list of threads. The queue head is a - designated list element. If this is a uniprocessor-only - implementation we can store the `main' thread in this, but in a - multiprocessor there are several `heavy' threads but only one run - queue. A fancier implementation might have private run queues, - which would lead to a simpler (trivial) implementation */ - -typedef struct coop_q_t { - coop_t t; - coop_t *tail; -} coop_q_t; - -/* A Mutex variable is made up of a owner thread, and a queue of threads - waiting on the mutex */ - -typedef struct coop_m { - coop_t *owner; /* Mutex owner */ - int level; /* for recursive locks. */ - coop_q_t waiting; /* Queue of waiting threads */ -} coop_m; - -typedef int coop_mattr; - -SCM_API int coop_mutex_init (coop_m*); -SCM_API int coop_new_mutex_init (coop_m*, coop_mattr*); -SCM_API int coop_mutex_lock (coop_m*); -SCM_API int coop_mutex_trylock (coop_m*); -SCM_API int coop_mutex_unlock (coop_m*); -SCM_API int coop_mutex_destroy (coop_m*); - -/* A Condition variable is made up of a list of threads waiting on the - condition. */ - -typedef struct coop_c { - coop_q_t waiting; /* Queue of waiting threads */ -} coop_c; - -typedef int coop_cattr; - -SCM_API int coop_condition_variable_init (coop_c*); -SCM_API int coop_new_condition_variable_init (coop_c*, coop_cattr*); -SCM_API int coop_condition_variable_wait_mutex (coop_c*, coop_m*); -SCM_API int coop_condition_variable_timed_wait_mutex (coop_c*, - coop_m*, - const scm_t_timespec *abstime); -SCM_API int coop_condition_variable_signal (coop_c*); -SCM_API int coop_condition_variable_broadcast (coop_c*); -SCM_API int coop_condition_variable_destroy (coop_c*); - -typedef int coop_k; - -typedef coop_k scm_t_key; - -SCM_API int coop_key_create (coop_k *keyp, void (*destruktor) (void *value)); -SCM_API int coop_setspecific (coop_k key, const void *value); -SCM_API void *coop_getspecific (coop_k key); -SCM_API int coop_key_delete (coop_k); -#define scm_key_create coop_key_create -#define scm_setspecific coop_setspecific -#define scm_getspecific coop_getspecific -#define scm_key_delete coop_key_delete - -SCM_API coop_t *coop_global_curr; /* Currently-executing thread. */ - -SCM_API void coop_join (coop_t *t); -SCM_API void coop_yield (void); - -SCM_API size_t scm_switch_counter; -SCM_API size_t scm_thread_count; - - -/* Some iselect functions. */ - -/* I'm not sure whether these three declarations should be here. - They're really defined in iselect.c, so you'd think they'd go in - iselect.h, but they use coop_t, defined above, which uses things - defined in iselect.h. Basically, we're making at best a flailing - (and failing) attempt at modularity here, and I don't have time to - rethink this at the moment. This code awaits a Hero. --JimB - */ -SCM_API void coop_timeout_qinsert (coop_q_t *, coop_t *); -SCM_API coop_t *coop_next_runnable_thread (void); -SCM_API coop_t *coop_wait_for_runnable_thread_now (struct timeval *); -SCM_API coop_t *coop_wait_for_runnable_thread (void); - - - - -/* Cooperative threads don't need to have these defined */ - -#define SCM_CRITICAL_SECTION_START -#define SCM_CRITICAL_SECTION_END - - - -#define SCM_NO_CRITICAL_SECTION_OWNER 0 -#define SCM_THREAD_SWITCH_COUNT 50 /* was 10 /mdj */ - - - -#if 0 -#define SCM_THREAD_SWITCHING_CODE \ -do { \ - if (scm_thread_count > 1) \ - coop_yield(); \ -} while (0) - -#else -#define SCM_THREAD_SWITCHING_CODE \ -do { \ - if (scm_thread_count > 1) \ - { \ - scm_switch_counter--; \ - if (scm_switch_counter == 0) \ - { \ - scm_switch_counter = SCM_THREAD_SWITCH_COUNT; \ - coop_yield(); \ - } \ - } \ -} while (0) - -#endif - -/* For pthreads, this is a value associated with a specific key. - * For coop, we use a special field for increased efficiency. - */ -#define SCM_THREAD_LOCAL_DATA (coop_global_curr->data) -#define SCM_SET_THREAD_LOCAL_DATA(ptr) (coop_global_curr->data = (ptr)) - -#endif /* SCM_COOP_DEFS_H */ - -/* - Local Variables: - c-file-style: "gnu" - End: -*/ diff --git a/libguile/coop-pthreads.h b/libguile/coop-pthreads.h index 57b53ede4..490b1e28b 100644 --- a/libguile/coop-pthreads.h +++ b/libguile/coop-pthreads.h @@ -3,7 +3,7 @@ #ifndef SCM_COOP_PTHREADS_H #define SCM_COOP_PTHREADS_H -/* Copyright (C) 2002, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2002, 2006, 2008 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 @@ -72,7 +72,7 @@ SCM_API int scm_i_switch_counter; #define SCM_SET_THREAD_LOCAL_DATA(ptr) (scm_i_copt_set_thread_data (ptr)) SCM_API void *scm_i_copt_thread_data; -SCM_API void scm_i_copt_set_thread_data (void *data); +SCM_INTERNAL void scm_i_copt_set_thread_data (void *data); #endif /* SCM_COOP_PTHREAD_H */ diff --git a/libguile/coop-threads.h b/libguile/coop-threads.h deleted file mode 100644 index 56ada64fd..000000000 --- a/libguile/coop-threads.h +++ /dev/null @@ -1,105 +0,0 @@ -/* classes: h_files */ - -#ifndef SCM_COOP_THREADS_H -#define SCM_COOP_THREADS_H - -/* Copyright (C) 1996,1997,1998,2000, 2002, 2006 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 - * License as published by the Free Software Foundation; either - * version 2.1 of the License, or (at your option) any later version. - * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - */ - - - -/* This file is only included by coop-threads.c while coop-defs.h is - included by threads.h, which, in turn, is included by - libguile.h. */ - -/* The coop_t struct is declared in coop-defs.h. */ - -#include "libguile/__scm.h" - -#include <time.h> - -#include "libguile/coop-defs.h" -#include "qt/qt.h" - -/* This code is based on a sample thread libraru by David Keppel. - Portions of this file fall under the following copyright: */ - -/* - * QuickThreads -- Threads-building toolkit. - * Copyright (c) 1993 by David Keppel - * - * Permission to use, copy, modify and distribute this software and - * its documentation for any purpose and without fee is hereby - * granted, provided that the above copyright notice and this notice - * appear in all copies. This software is provided as a - * proof-of-concept and for demonstration purposes; there is no - * representation about the suitability of this software for any - * purpose. - */ - -/* Each thread starts by calling a user-supplied function of this - type. */ - -typedef void (coop_userf_t)(void *p0); - -/* Call this before any other primitives. */ -SCM_API void coop_init (void); - -/* When one or more threads are created by the main thread, - the system goes multithread when this is called. It is done - (no more runable threads) when this returns. */ - -SCM_API void coop_start (void); - -/* Create a thread and make it runable. When the thread starts - running it will call `f' with arguments `p0' and `p1'. */ - -SCM_API coop_t *coop_create (coop_userf_t *f, void *p0); - -/* The current thread stops running but stays runable. - It is an error to call `coop_yield' before `coop_start' - is called or after `coop_start' returns. */ - -SCM_API void coop_yield (void); - -/* Like `coop_yield' but the thread is discarded. Any intermediate - state is lost. The thread can also terminate by simply - returning. */ - -SCM_API void coop_abort (void); - -/* The following are needed in iselect.c */ - -SCM_API coop_t *coop_qget (coop_q_t *); -SCM_API void coop_qput (coop_q_t *, coop_t *); -SCM_API void *coop_sleephelp (qt_t *, void *, void *); - -SCM_API coop_t *coop_wait_for_runnable_thread (); - -SCM_API coop_q_t coop_global_runq; /* A queue of runable threads. */ -SCM_API coop_q_t coop_global_sleepq; -SCM_API coop_q_t coop_tmp_queue; -SCM_API coop_q_t coop_global_allq; /* A queue of all threads. */ -SCM_API coop_t *coop_global_curr; /* Currently-executing thread. */ - -#endif /* SCM_COOP_THREADS_H */ - -/* - Local Variables: - c-file-style: "gnu" - End: -*/ diff --git a/libguile/debug-malloc.h b/libguile/debug-malloc.h index 444f06d71..1aa5221c6 100644 --- a/libguile/debug-malloc.h +++ b/libguile/debug-malloc.h @@ -3,7 +3,7 @@ #ifndef SCM_DEBUG_MALLOC_H #define SCM_DEBUG_MALLOC_H -/* Copyright (C) 2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2000,2001, 2006, 2008 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 @@ -32,8 +32,8 @@ SCM_API void scm_malloc_reregister (void *obj, void *new, const char *what); SCM_API SCM scm_malloc_stats (void); -SCM_API void scm_debug_malloc_prehistory (void); -SCM_API void scm_init_debug_malloc (void); +SCM_INTERNAL void scm_debug_malloc_prehistory (void); +SCM_INTERNAL void scm_init_debug_malloc (void); #endif /* SCM_DEBUG_MALLOC_H */ diff --git a/libguile/debug.h b/libguile/debug.h index 79afa4d53..607716230 100644 --- a/libguile/debug.h +++ b/libguile/debug.h @@ -3,7 +3,7 @@ #ifndef SCM_DEBUG_H #define SCM_DEBUG_H -/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004 +/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -150,8 +150,8 @@ SCM_API SCM scm_evaluator_traps (SCM setting); SCM_API SCM scm_debug_options (SCM setting); SCM_API SCM scm_make_debugobj (scm_t_debug_frame *debug); -SCM_API SCM scm_i_unmemoize_expr (SCM memoized); -SCM_API void scm_init_debug (void); +SCM_INTERNAL SCM scm_i_unmemoize_expr (SCM memoized); +SCM_INTERNAL void scm_init_debug (void); #ifdef GUILE_DEBUG SCM_API SCM scm_memcons (SCM car, SCM cdr, SCM env); diff --git a/libguile/deprecated.c b/libguile/deprecated.c index bb17967f9..da1160852 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -2,7 +2,7 @@ deprecate something, move it here when that is feasible. */ -/* Copyright (C) 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2003, 2004, 2006, 2008 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 @@ -319,14 +319,14 @@ scm_load_scheme_module (SCM name) static void maybe_close_port (void *data, SCM port) { - SCM except = (SCM)data; + SCM except_set = (SCM) data; - while (!scm_is_null (except)) + while (!scm_is_null (except_set)) { - SCM p = SCM_COERCE_OUTPORT (SCM_CAR (except)); + SCM p = SCM_COERCE_OUTPORT (SCM_CAR (except_set)); if (scm_is_eq (p, port)) return; - except = SCM_CDR (except); + except_set = SCM_CDR (except_set); } scm_close_port (port); diff --git a/libguile/deprecation.h b/libguile/deprecation.h index 53500eeca..78853277b 100644 --- a/libguile/deprecation.h +++ b/libguile/deprecation.h @@ -3,7 +3,7 @@ #ifndef SCM_DEPRECATION_H #define SCM_DEPRECATION_H -/* Copyright (C) 2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2006, 2008 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 @@ -41,7 +41,7 @@ SCM_API SCM scm_issue_deprecation_warning (SCM msgs); #endif SCM_API SCM scm_include_deprecated_features (void); -SCM_API void scm_init_deprecation (void); +SCM_INTERNAL void scm_init_deprecation (void); #endif /* SCM_DEPRECATION_H */ diff --git a/libguile/discouraged.c b/libguile/discouraged.c index 1b5794a82..07663e0fe 100644 --- a/libguile/discouraged.c +++ b/libguile/discouraged.c @@ -23,33 +23,128 @@ #if (SCM_ENABLE_DISCOURAGED == 1) -#define DEFFROM(t,f1,f2) SCM f1(t x) { return f2 (x); } -#define DEFTO(t,f1,f2) t f1(SCM x, unsigned long pos, const char *s_caller) \ - { return f2 (x); } - -DEFFROM (short, scm_short2num, scm_from_short); -DEFFROM (unsigned short, scm_ushort2num, scm_from_ushort); -DEFFROM (int, scm_int2num, scm_from_int); -DEFFROM (unsigned int, scm_uint2num, scm_from_uint); -DEFFROM (long, scm_long2num, scm_from_long); -DEFFROM (unsigned long, scm_ulong2num, scm_from_ulong); -DEFFROM (size_t, scm_size2num, scm_from_size_t); -DEFFROM (ptrdiff_t, scm_ptrdiff2num, scm_from_ssize_t); - -DEFTO (short, scm_num2short, scm_to_short); -DEFTO (unsigned short, scm_num2ushort, scm_to_ushort); -DEFTO (int, scm_num2int, scm_to_int); -DEFTO (unsigned int, scm_num2uint, scm_to_uint); -DEFTO (long, scm_num2long, scm_to_long); -DEFTO (unsigned long, scm_num2ulong, scm_to_ulong); -DEFTO (size_t, scm_num2size, scm_to_size_t); -DEFTO (ptrdiff_t, scm_num2ptrdiff, scm_to_ssize_t); +SCM +scm_short2num (short x) +{ + return scm_from_short (x); +} + +SCM +scm_ushort2num (unsigned short x) +{ + return scm_from_ushort (x); +} + +SCM +scm_int2num (int x) +{ + return scm_from_int (x); +} + +SCM +scm_uint2num (unsigned int x) +{ + return scm_from_uint (x); +} + +SCM +scm_long2num (long x) +{ + return scm_from_long (x); +} + +SCM +scm_ulong2num (unsigned long x) +{ + return scm_from_ulong (x); +} + +SCM +scm_size2num (size_t x) +{ + return scm_from_size_t (x); +} + +SCM +scm_ptrdiff2num (ptrdiff_t x) +{ + return scm_from_ssize_t (x); +} + +short +scm_num2short (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_short (x); +} + +unsigned short +scm_num2ushort (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_ushort (x); +} + +int +scm_num2int (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_int (x); +} + +unsigned int +scm_num2uint (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_uint (x); +} + +long +scm_num2long (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_long (x); +} + +unsigned long +scm_num2ulong (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_ulong (x); +} + +size_t +scm_num2size (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_size_t (x); +} + +ptrdiff_t +scm_num2ptrdiff (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_ssize_t (x); +} #if SCM_SIZEOF_LONG_LONG != 0 -DEFFROM (long long, scm_long_long2num, scm_from_long_long); -DEFFROM (unsigned long long, scm_ulong_long2num, scm_from_ulong_long); -DEFTO (long long, scm_num2long_long, scm_to_long_long); -DEFTO (unsigned long long, scm_num2ulong_long, scm_to_ulong_long); + +SCM +scm_long_long2num (long long x) +{ + return scm_from_long_long (x); +} + +SCM +scm_ulong_long2num (unsigned long long x) +{ + return scm_from_ulong_long (x); +} + +long long +scm_num2long_long (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_long_long (x); +} + +unsigned long long +scm_num2ulong_long (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_ulong_long (x); +} + #endif SCM diff --git a/libguile/dynl.h b/libguile/dynl.h index 6936afd3d..72dc92ea4 100644 --- a/libguile/dynl.h +++ b/libguile/dynl.h @@ -3,7 +3,7 @@ #ifndef SCM_DYNL_H #define SCM_DYNL_H -/* Copyright (C) 1996,1998,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1996,1998,2000,2001, 2006, 2008 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 @@ -33,7 +33,7 @@ SCM_API SCM scm_dynamic_func (SCM symb, SCM dobj); SCM_API SCM scm_dynamic_call (SCM symb, SCM dobj); SCM_API SCM scm_dynamic_args_call (SCM symb, SCM dobj, SCM args); -SCM_API void scm_init_dynamic_linking (void); +SCM_INTERNAL void scm_init_dynamic_linking (void); #endif /* SCM_DYNL_H */ diff --git a/libguile/dynwind.h b/libguile/dynwind.h index 9e5390b10..dd39dae5a 100644 --- a/libguile/dynwind.h +++ b/libguile/dynwind.h @@ -3,7 +3,7 @@ #ifndef SCM_DYNWIND_H #define SCM_DYNWIND_H -/* Copyright (C) 1995,1996,1998,1999,2000,2003,2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2003,2004, 2006, 2008 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 @@ -36,9 +36,9 @@ SCM_API SCM scm_internal_dynamic_wind (scm_t_guard before, void *inner_data, void *guard_data); SCM_API void scm_dowinds (SCM to, long delta); -SCM_API void scm_i_dowinds (SCM to, long delta, - void (*turn_func) (void *), void *data); -SCM_API void scm_init_dynwind (void); +SCM_INTERNAL void scm_i_dowinds (SCM to, long delta, + void (*turn_func) (void *), void *data); +SCM_INTERNAL void scm_init_dynwind (void); SCM_API void scm_swap_bindings (SCM vars, SCM vals); diff --git a/libguile/environments.h b/libguile/environments.h index 31b34d9e0..2d8765a38 100644 --- a/libguile/environments.h +++ b/libguile/environments.h @@ -3,7 +3,7 @@ #ifndef SCM_ENVIRONMENTS_H #define SCM_ENVIRONMENTS_H -/* Copyright (C) 1999,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1999,2000, 2006, 2008 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 @@ -120,8 +120,8 @@ SCM_API SCM scm_environment_observe_weak (SCM env, SCM proc); SCM_API SCM scm_c_environment_observe (SCM env, scm_environment_observer proc, SCM data, int weak_p); SCM_API SCM scm_environment_unobserve (SCM token); -SCM_API void scm_environments_prehistory (void); -SCM_API void scm_init_environments (void); +SCM_INTERNAL void scm_environments_prehistory (void); +SCM_INTERNAL void scm_init_environments (void); diff --git a/libguile/eq.h b/libguile/eq.h index da5a71c9f..af6959fe8 100644 --- a/libguile/eq.h +++ b/libguile/eq.h @@ -3,7 +3,7 @@ #ifndef SCM_EQ_H #define SCM_EQ_H -/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000, 2006, 2008 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 @@ -29,7 +29,7 @@ SCM_API SCM scm_eq_p (SCM x, SCM y); SCM_API SCM scm_eqv_p (SCM x, SCM y); SCM_API SCM scm_equal_p (SCM x, SCM y); -SCM_API void scm_init_eq (void); +SCM_INTERNAL void scm_init_eq (void); #endif /* SCM_EQ_H */ diff --git a/libguile/error.h b/libguile/error.h index 7ba0c4b37..042fb4d14 100644 --- a/libguile/error.h +++ b/libguile/error.h @@ -3,7 +3,7 @@ #ifndef SCM_ERROR_H #define SCM_ERROR_H -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2006, 2008 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 @@ -57,7 +57,7 @@ SCM_API void scm_wrong_type_arg_msg (const char *subr, int pos, SCM_API void scm_memory_error (const char *subr) SCM_NORETURN; SCM_API void scm_misc_error (const char *subr, const char *message, SCM args) SCM_NORETURN; -SCM_API void scm_init_error (void); +SCM_INTERNAL void scm_init_error (void); #endif /* SCM_ERROR_H */ diff --git a/libguile/eval.c b/libguile/eval.c index 0e92241a6..0aec95106 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006 +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -18,8 +18,6 @@ -#define _GNU_SOURCE - /* SECTION: This code is compiled once. */ @@ -299,10 +297,12 @@ syntax_error (const char* const msg, const SCM form, const SCM expr) /* Shortcut macros to simplify syntax error handling. */ -#define ASSERT_SYNTAX(cond, message, form) \ - { if (!(cond)) syntax_error (message, form, SCM_UNDEFINED); } -#define ASSERT_SYNTAX_2(cond, message, form, expr) \ - { if (!(cond)) syntax_error (message, form, expr); } +#define ASSERT_SYNTAX(cond, message, form) \ + { if (SCM_UNLIKELY (!(cond))) \ + syntax_error (message, form, SCM_UNDEFINED); } +#define ASSERT_SYNTAX_2(cond, message, form, expr) \ + { if (SCM_UNLIKELY (!(cond))) \ + syntax_error (message, form, expr); } @@ -1268,7 +1268,13 @@ static SCM unmemoize_delay (const SCM expr, const SCM env) { const SCM thunk_expr = SCM_CADDR (expr); - return scm_list_2 (scm_sym_delay, unmemoize_expression (thunk_expr, env)); + /* A promise is implemented as a closure, and when applying a + closure the evaluator adds a new frame to the environment - even + though, in the case of a promise, the added frame is always + empty. We need to extend the environment here in the same way, + so that any ILOCs in thunk_expr can be unmemoized correctly. */ + const SCM new_env = SCM_EXTEND_ENV (SCM_EOL, SCM_EOL, env); + return scm_list_2 (scm_sym_delay, unmemoize_expression (thunk_expr, new_env)); } @@ -2115,7 +2121,7 @@ unmemoize_future (const SCM expr, const SCM env) return scm_list_2 (scm_sym_future, unmemoize_expression (thunk_expr, env)); } -#endif +#endif /* futures disabled. */ SCM_SYNTAX (s_gset_x, "set!", scm_i_makbimacro, scm_m_generalized_set_x); SCM_SYMBOL (scm_sym_setter, "setter"); @@ -4014,7 +4020,10 @@ SCM_DEFINE (scm_eval, "eval", 2, 0, 0, if (scm_is_dynamic_state (module_or_state)) scm_dynwind_current_dynamic_state (module_or_state); else - scm_dynwind_current_module (module_or_state); + { + SCM_VALIDATE_MODULE (2, module_or_state); + scm_dynwind_current_module (module_or_state); + } res = scm_primitive_eval (exp); diff --git a/libguile/eval.h b/libguile/eval.h index 247cf164e..bf6279b82 100644 --- a/libguile/eval.h +++ b/libguile/eval.h @@ -3,7 +3,7 @@ #ifndef SCM_EVAL_H #define SCM_EVAL_H -/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003,2004 +/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003,2004,2008 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -152,7 +152,7 @@ SCM_API SCM scm_apply_0 (SCM proc, SCM args); SCM_API SCM scm_apply_1 (SCM proc, SCM arg1, SCM args); SCM_API SCM scm_apply_2 (SCM proc, SCM arg1, SCM arg2, SCM args); SCM_API SCM scm_apply_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM args); -SCM_API SCM scm_i_call_closure_0 (SCM proc); +SCM_INTERNAL SCM scm_i_call_closure_0 (SCM proc); SCM_API scm_t_trampoline_0 scm_trampoline_0 (SCM proc); SCM_API scm_t_trampoline_1 scm_trampoline_1 (SCM proc); SCM_API scm_t_trampoline_2 scm_trampoline_2 (SCM proc); @@ -167,18 +167,18 @@ SCM_API SCM scm_force (SCM x); SCM_API SCM scm_promise_p (SCM x); SCM_API SCM scm_cons_source (SCM xorig, SCM x, SCM y); SCM_API SCM scm_copy_tree (SCM obj); -SCM_API SCM scm_i_eval_x (SCM exp, SCM env); -SCM_API SCM scm_i_eval (SCM exp, SCM env); +SCM_API SCM scm_i_eval_x (SCM exp, SCM env) /* not internal */; +SCM_INTERNAL SCM scm_i_eval (SCM exp, SCM env); SCM_API SCM scm_primitive_eval (SCM exp); SCM_API SCM scm_primitive_eval_x (SCM exp); SCM_API SCM scm_eval (SCM exp, SCM module); SCM_API SCM scm_eval_x (SCM exp, SCM module); -SCM_API void scm_i_print_iloc (SCM /*iloc*/, SCM /*port*/); -SCM_API void scm_i_print_isym (SCM /*isym*/, SCM /*port*/); -SCM_API SCM scm_i_unmemocopy_expr (SCM expr, SCM env); -SCM_API SCM scm_i_unmemocopy_body (SCM forms, SCM env); -SCM_API void scm_init_eval (void); +SCM_INTERNAL void scm_i_print_iloc (SCM /*iloc*/, SCM /*port*/); +SCM_INTERNAL void scm_i_print_isym (SCM /*isym*/, SCM /*port*/); +SCM_INTERNAL SCM scm_i_unmemocopy_expr (SCM expr, SCM env); +SCM_INTERNAL SCM scm_i_unmemocopy_body (SCM forms, SCM env); +SCM_INTERNAL void scm_init_eval (void); #if (SCM_ENABLE_DEPRECATED == 1) diff --git a/libguile/eval.i.c b/libguile/eval.i.c index c1e1fb62e..83878ff41 100644 --- a/libguile/eval.i.c +++ b/libguile/eval.i.c @@ -681,7 +681,7 @@ dispatch: #ifdef DEVAL debug.info->a.args = arg1; #endif - if (scm_badargsp (formals, arg1)) + if (SCM_UNLIKELY (scm_badargsp (formals, arg1))) scm_wrong_num_args (proc); ENTER_APPLY; /* Copy argument list */ @@ -1143,7 +1143,7 @@ dispatch: case scm_tcs_closures: { const SCM formals = SCM_CLOSURE_FORMALS (proc); - if (scm_is_pair (formals)) + if (SCM_UNLIKELY (scm_is_pair (formals))) goto wrongnumargs; x = SCM_CLOSURE_BODY (proc); env = SCM_EXTEND_ENV (formals, SCM_EOL, SCM_ENV (proc)); @@ -1187,7 +1187,7 @@ dispatch: /* must handle macros by here */ x = SCM_CDR (x); - if (scm_is_pair (x)) + if (SCM_LIKELY (scm_is_pair (x))) arg1 = EVALCAR (x, env); else scm_wrong_num_args (proc); @@ -1316,7 +1316,7 @@ dispatch: goto badfun; } } - if (scm_is_pair (x)) + if (SCM_LIKELY (scm_is_pair (x))) arg2 = EVALCAR (x, env); else scm_wrong_num_args (proc); @@ -1440,7 +1440,7 @@ dispatch: } } } - if (!scm_is_pair (x)) + if (SCM_UNLIKELY (!scm_is_pair (x))) scm_wrong_num_args (proc); #ifdef DEVAL debug.info->a.args = scm_cons2 (arg1, arg2, @@ -1518,7 +1518,7 @@ dispatch: } #else /* DEVAL */ case scm_tc7_subr_3: - if (!scm_is_null (SCM_CDR (x))) + if (SCM_UNLIKELY (!scm_is_null (SCM_CDR (x)))) scm_wrong_num_args (proc); else RETURN (SCM_SUBRF (proc) (arg1, arg2, EVALCAR (x, env))); @@ -1709,37 +1709,38 @@ tail: switch (SCM_TYP7 (proc)) { case scm_tc7_subr_2o: - if (SCM_UNBNDP (arg1)) + if (SCM_UNLIKELY (SCM_UNBNDP (arg1))) scm_wrong_num_args (proc); if (scm_is_null (args)) args = SCM_UNDEFINED; else { - if (! scm_is_null (SCM_CDR (args))) + if (SCM_UNLIKELY (! scm_is_null (SCM_CDR (args)))) scm_wrong_num_args (proc); args = SCM_CAR (args); } RETURN (SCM_SUBRF (proc) (arg1, args)); case scm_tc7_subr_2: - if (scm_is_null (args) || !scm_is_null (SCM_CDR (args))) + if (SCM_UNLIKELY (scm_is_null (args) || + !scm_is_null (SCM_CDR (args)))) scm_wrong_num_args (proc); args = SCM_CAR (args); RETURN (SCM_SUBRF (proc) (arg1, args)); case scm_tc7_subr_0: - if (!SCM_UNBNDP (arg1)) + if (SCM_UNLIKELY (!SCM_UNBNDP (arg1))) scm_wrong_num_args (proc); else RETURN (SCM_SUBRF (proc) ()); case scm_tc7_subr_1: - if (SCM_UNBNDP (arg1)) + if (SCM_UNLIKELY (SCM_UNBNDP (arg1))) scm_wrong_num_args (proc); case scm_tc7_subr_1o: - if (!scm_is_null (args)) + if (SCM_UNLIKELY (!scm_is_null (args))) scm_wrong_num_args (proc); else RETURN (SCM_SUBRF (proc) (arg1)); case scm_tc7_dsubr: - if (SCM_UNBNDP (arg1) || !scm_is_null (args)) + if (SCM_UNLIKELY (SCM_UNBNDP (arg1) || !scm_is_null (args))) scm_wrong_num_args (proc); if (SCM_I_INUMP (arg1)) { @@ -1760,13 +1761,13 @@ tail: SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1, SCM_ARG1, scm_i_symbol_chars (SCM_SNAME (proc))); case scm_tc7_cxr: - if (SCM_UNBNDP (arg1) || !scm_is_null (args)) + if (SCM_UNLIKELY (SCM_UNBNDP (arg1) || !scm_is_null (args))) scm_wrong_num_args (proc); RETURN (scm_i_chase_pairs (arg1, (scm_t_bits) SCM_SUBRF (proc))); case scm_tc7_subr_3: - if (scm_is_null (args) - || scm_is_null (SCM_CDR (args)) - || !scm_is_null (SCM_CDDR (args))) + if (SCM_UNLIKELY (scm_is_null (args) + || scm_is_null (SCM_CDR (args)) + || !scm_is_null (SCM_CDDR (args)))) scm_wrong_num_args (proc); else RETURN (SCM_SUBRF (proc) (arg1, SCM_CAR (args), SCM_CADR (args))); @@ -1777,7 +1778,7 @@ tail: RETURN (SCM_SUBRF (proc) (SCM_UNBNDP (arg1) ? SCM_EOL : scm_cons (arg1, args))); #endif case scm_tc7_lsubr_2: - if (!scm_is_pair (args)) + if (SCM_UNLIKELY (!scm_is_pair (args))) scm_wrong_num_args (proc); else RETURN (SCM_SUBRF (proc) (arg1, SCM_CAR (args), SCM_CDR (args))); @@ -1809,7 +1810,7 @@ tail: #else arg1 = (SCM_UNBNDP (arg1) ? SCM_EOL : scm_cons (arg1, args)); #endif - if (scm_badargsp (SCM_CLOSURE_FORMALS (proc), arg1)) + if (SCM_UNLIKELY (scm_badargsp (SCM_CLOSURE_FORMALS (proc), arg1))) scm_wrong_num_args (proc); /* Copy argument list */ diff --git a/libguile/evalext.h b/libguile/evalext.h index e9b442e44..a6a4a9fdc 100644 --- a/libguile/evalext.h +++ b/libguile/evalext.h @@ -3,7 +3,7 @@ #ifndef SCM_EVALEXT_H #define SCM_EVALEXT_H -/* Copyright (C) 1998,1999,2000, 2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1998,1999,2000, 2003, 2006, 2008 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 @@ -28,7 +28,7 @@ SCM_API SCM scm_defined_p (SCM sym, SCM env); SCM_API SCM scm_self_evaluating_p (SCM obj); -SCM_API void scm_init_evalext (void); +SCM_INTERNAL void scm_init_evalext (void); #if (SCM_ENABLE_DEPRECATED == 1) diff --git a/libguile/extensions.h b/libguile/extensions.h index 294dcad76..596b43ae0 100644 --- a/libguile/extensions.h +++ b/libguile/extensions.h @@ -3,7 +3,7 @@ #ifndef SCM_EXTENSIONS_H #define SCM_EXTENSIONS_H -/* Copyright (C) 2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2006, 2008 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 @@ -32,7 +32,7 @@ SCM_API void scm_c_register_extension (const char *lib, const char *init, SCM_API void scm_c_load_extension (const char *lib, const char *init); SCM_API SCM scm_load_extension (SCM lib, SCM init); -SCM_API void scm_init_extensions (void); +SCM_INTERNAL void scm_init_extensions (void); #endif /* SCM_EXTENSIONS_H */ diff --git a/libguile/feature.h b/libguile/feature.h index 9c61f8ce8..8c6371e94 100644 --- a/libguile/feature.h +++ b/libguile/feature.h @@ -3,7 +3,7 @@ #ifndef SCM_FEATURE_H #define SCM_FEATURE_H -/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2007, 2008 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 @@ -28,7 +28,7 @@ SCM_API void scm_add_feature (const char* str); SCM_API SCM scm_program_arguments (void); SCM_API void scm_set_program_arguments (int argc, char **argv, char *first); SCM_API SCM scm_set_program_arguments_scm (SCM lst); -SCM_API void scm_init_feature (void); +SCM_INTERNAL void scm_init_feature (void); #endif /* SCM_FEATURE_H */ diff --git a/libguile/filesys.c b/libguile/filesys.c index 0e90105ec..6536df849 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -19,7 +19,6 @@ /* See stime.c for comments on why _POSIX_C_SOURCE is not always defined. */ -#define _GNU_SOURCE /* ask glibc for everything */ #define _LARGEFILE64_SOURCE /* ask for stat64 etc */ #ifdef __hpux #define _POSIX_C_SOURCE 199506L /* for readdir_r */ diff --git a/libguile/filesys.h b/libguile/filesys.h index 6534da909..a38a5b594 100644 --- a/libguile/filesys.h +++ b/libguile/filesys.h @@ -3,7 +3,7 @@ #ifndef SCM_FILESYS_H #define SCM_FILESYS_H -/* Copyright (C) 1995,1997,1998,1999,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1997,1998,1999,2000,2001, 2006, 2008 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 @@ -65,7 +65,7 @@ SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile); SCM_API SCM scm_dirname (SCM filename); SCM_API SCM scm_basename (SCM filename, SCM suffix); -SCM_API void scm_init_filesys (void); +SCM_INTERNAL void scm_init_filesys (void); #endif /* SCM_FILESYS_H */ diff --git a/libguile/fluids.h b/libguile/fluids.h index cabce4617..c48a8c332 100644 --- a/libguile/fluids.h +++ b/libguile/fluids.h @@ -3,7 +3,7 @@ #ifndef SCM_FLUIDS_H #define SCM_FLUIDS_H -/* Copyright (C) 1996,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1996,2000,2001, 2006, 2008 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 @@ -82,10 +82,10 @@ SCM_API void *scm_c_with_dynamic_state (SCM state, void *(*func)(void *), void *data); SCM_API SCM scm_with_dynamic_state (SCM state, SCM proc); -SCM_API SCM scm_i_make_initial_dynamic_state (void); +SCM_INTERNAL SCM scm_i_make_initial_dynamic_state (void); -SCM_API void scm_fluids_prehistory (void); -SCM_API void scm_init_fluids (void); +SCM_INTERNAL void scm_fluids_prehistory (void); +SCM_INTERNAL void scm_init_fluids (void); #endif /* SCM_FLUIDS_H */ diff --git a/libguile/fports.c b/libguile/fports.c index 171bde644..bcb5a1ecf 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008 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 @@ -221,11 +221,10 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0, /* Move ports with the specified file descriptor to new descriptors, * resetting the revealed count to 0. */ -static SCM -scm_i_evict_port (SCM handle, void *closure) +static void +scm_i_evict_port (void *closure, SCM port) { int fd = * (int*) closure; - SCM port = SCM_CAR (handle); if (SCM_FPORTP (port)) { @@ -239,18 +238,12 @@ scm_i_evict_port (SCM handle, void *closure) scm_set_port_revealed_x (port, scm_from_int (0)); } } - - return handle; } void scm_evict_ports (int fd) { - scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex); - scm_internal_hash_for_each_handle (&scm_i_evict_port, - (void*) &fd, - scm_i_port_weak_hash); - scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex); + scm_c_port_for_each (scm_i_evict_port, (void *) &fd); } @@ -675,7 +668,7 @@ fport_seek_or_seek64 (SCM port, off_t_or_off64_t offset, int whence) case on NetBSD apparently), then fport_seek_or_seek64 is right to be fport_seek already. */ -#if HAVE_STAT64 && SIZEOF_OFF_T != SIZEOF_OFF64_T +#if GUILE_USE_64_CALLS && HAVE_STAT64 && SIZEOF_OFF_T != SIZEOF_OFF64_T static off_t fport_seek (SCM port, off_t offset, int whence) { diff --git a/libguile/fports.h b/libguile/fports.h index 634106760..c737b1eaa 100644 --- a/libguile/fports.h +++ b/libguile/fports.h @@ -3,7 +3,7 @@ #ifndef SCM_FPORTS_H #define SCM_FPORTS_H -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008 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 @@ -53,13 +53,13 @@ SCM_API void scm_evict_ports (int fd); SCM_API SCM scm_open_file (SCM filename, SCM modes); SCM_API SCM scm_fdes_to_port (int fdes, char *mode, SCM name); SCM_API SCM scm_file_port_p (SCM obj); -SCM_API void scm_init_fports (void); +SCM_INTERNAL void scm_init_fports (void); /* internal functions */ -SCM_API SCM scm_i_fdes_to_port (int fdes, long mode_bits, SCM name); -SCM_API int scm_i_fport_truncate (SCM, SCM); -SCM_API SCM scm_i_fport_seek (SCM, SCM, int); +SCM_INTERNAL SCM scm_i_fdes_to_port (int fdes, long mode_bits, SCM name); +SCM_INTERNAL int scm_i_fport_truncate (SCM, SCM); +SCM_INTERNAL SCM scm_i_fport_seek (SCM, SCM, int); #endif /* SCM_FPORTS_H */ diff --git a/libguile/futures.h b/libguile/futures.h index dffb38db8..95916f33b 100644 --- a/libguile/futures.h +++ b/libguile/futures.h @@ -3,7 +3,7 @@ #ifndef SCM_FUTURES_H #define SCM_FUTURES_H -/* Copyright (C) 2002, 2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2002, 2003, 2006, 2008 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 @@ -73,7 +73,7 @@ SCM_API scm_t_bits scm_tc16_future; extern SCM *scm_loc_sys_thread_handler; -SCM_API SCM scm_i_make_future (SCM thunk); +SCM_INTERNAL SCM scm_i_make_future (SCM thunk); SCM_API SCM scm_make_future (SCM thunk); SCM_API SCM scm_future_ref (SCM future); diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c index cb11ba049..a82ebe6be 100644 --- a/libguile/gc-malloc.c +++ b/libguile/gc-malloc.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2008 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 @@ -84,8 +84,8 @@ scm_gc_init_malloc (void) { scm_mtrigger = scm_getenv_int ("GUILE_INIT_MALLOC_LIMIT", SCM_DEFAULT_INIT_MALLOC_LIMIT); - scm_i_minyield_malloc = scm_getenv_int ("GUILE_MIN_YIELD_MALLOC", - SCM_DEFAULT_MALLOC_MINYIELD); + scm_i_minyield_malloc = scm_getenv_int ("GUILE_MIN_YIELD_MALLOC", + SCM_DEFAULT_MALLOC_MINYIELD); if (scm_i_minyield_malloc >= 100) scm_i_minyield_malloc = 99; @@ -204,7 +204,7 @@ scm_gc_malloc (size_t size, const char *what) again in scm_gc_register_collectable_memory. We don't really want the second GC since it will not find new garbage. - Note: this is a theoretical peeve. In reality, malloc() never + Note: this is a theoretical peeve. In reality, malloc () never returns NULL. Usually, memory is overcommitted, and when you try to write it the program is killed with signal 11. --hwn */ diff --git a/libguile/gc-segment-table.c b/libguile/gc-segment-table.c new file mode 100644 index 000000000..d0d70fdad --- /dev/null +++ b/libguile/gc-segment-table.c @@ -0,0 +1,295 @@ +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2006 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 + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + */ + +#include <assert.h> +#include <stdio.h> +#include <string.h> + +#include "libguile/_scm.h" +#include "libguile/pairs.h" +#include "libguile/gc.h" +#include "libguile/private-gc.h" + + +/* + Heap segment table. + + The table is sorted by the address of the data itself. This makes + for easy lookups. This is not portable: according to ANSI C, + pointers can only be compared within the same object (i.e. the same + block of malloced memory.). For machines with weird architectures, + this should be revised. + + (Apparently, for this reason 1.6 and earlier had macros for pointer + comparison. ) + + perhaps it is worthwhile to remove the 2nd level of indirection in + the table, but this certainly makes for cleaner code. +*/ +scm_t_heap_segment **scm_i_heap_segment_table; +size_t scm_i_heap_segment_table_size; +static scm_t_cell *lowest_cell; +static scm_t_cell *highest_cell; + + +/* + RETURN: index of inserted segment. + */ +int +scm_i_insert_segment (scm_t_heap_segment *seg) +{ + size_t size = (scm_i_heap_segment_table_size + 1) * sizeof (scm_t_heap_segment *); + SCM_SYSCALL (scm_i_heap_segment_table + = ((scm_t_heap_segment **) + realloc ((char *)scm_i_heap_segment_table, size))); + + /* + We can't alloc 4 more bytes. This is hopeless. + */ + if (!scm_i_heap_segment_table) + { + fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap segment table.\n"); + abort (); + } + + if (!lowest_cell) + { + lowest_cell = seg->bounds[0]; + highest_cell = seg->bounds[1]; + } + else + { + lowest_cell = SCM_MIN (lowest_cell, seg->bounds[0]); + highest_cell = SCM_MAX (highest_cell, seg->bounds[1]); + } + + + { + int i = 0; + int j = 0; + + while (i < scm_i_heap_segment_table_size + && scm_i_heap_segment_table[i]->bounds[0] <= seg->bounds[0]) + i++; + + /* + We insert a new entry; if that happens to be before the + "current" segment of a freelist, we must move the freelist index + as well. + */ + if (scm_i_master_freelist.heap_segment_idx >= i) + scm_i_master_freelist.heap_segment_idx ++; + if (scm_i_master_freelist2.heap_segment_idx >= i) + scm_i_master_freelist2.heap_segment_idx ++; + + for (j = scm_i_heap_segment_table_size; j > i; --j) + scm_i_heap_segment_table[j] = scm_i_heap_segment_table[j - 1]; + + scm_i_heap_segment_table[i] = seg; + scm_i_heap_segment_table_size ++; + + return i; + } +} + + +/* + Determine whether the given value does actually represent a cell in + some heap segment. If this is the case, the number of the heap + segment is returned. Otherwise, -1 is returned. Binary search is + used to determine the heap segment that contains the cell. + + I think this function is too long to be inlined. --hwn +*/ + +int +scm_i_find_heap_segment_containing_object (SCM obj) +{ + if (!CELL_P (obj)) + return -1; + + scm_i_find_heap_calls ++; + if ((scm_t_cell *) obj < lowest_cell || (scm_t_cell *) obj >= highest_cell) + return -1; + + { + scm_t_cell *ptr = SCM2PTR (obj); + unsigned int i = 0; + unsigned int j = scm_i_heap_segment_table_size - 1; + + if (ptr < scm_i_heap_segment_table[i]->bounds[0]) + return -1; + else if (scm_i_heap_segment_table[j]->bounds[1] <= ptr) + return -1; + else + { + while (i < j) + { + if (ptr < scm_i_heap_segment_table[i]->bounds[1]) + { + break; + } + else if (scm_i_heap_segment_table[j]->bounds[0] <= ptr) + { + i = j; + break; + } + else + { + unsigned long int k = (i + j) / 2; + + if (k == i) + return -1; + else if (ptr < scm_i_heap_segment_table[k]->bounds[1]) + { + j = k; + ++i; + if (ptr < scm_i_heap_segment_table[i]->bounds[0]) + return -1; + } + else if (scm_i_heap_segment_table[k]->bounds[0] <= ptr) + { + i = k; + --j; + if (scm_i_heap_segment_table[j]->bounds[1] <= ptr) + return -1; + } + } + } + + if (!SCM_DOUBLECELL_ALIGNED_P (obj) && scm_i_heap_segment_table[i]->span == 2) + return -1; + else if (SCM_GC_IN_CARD_HEADERP (ptr)) + return -1; + else + return i; + } + } +} + + +int +scm_i_marked_count (void) +{ + int i = 0; + int c = 0; + for (; i < scm_i_heap_segment_table_size; i++) + { + c += scm_i_heap_segment_marked_count (scm_i_heap_segment_table[i]); + } + return c; +} + + +SCM +scm_i_sweep_some_segments (scm_t_cell_type_statistics *freelist, + scm_t_sweep_statistics *sweep_stats) +{ + int i = freelist->heap_segment_idx; + SCM collected = SCM_EOL; + + if (i == -1) /* huh? --hwn */ + i++; + + for (; + i < scm_i_heap_segment_table_size; i++) + { + if (scm_i_heap_segment_table[i]->freelist != freelist) + continue; + + collected = scm_i_sweep_some_cards (scm_i_heap_segment_table[i], + sweep_stats, + DEFAULT_SWEEP_AMOUNT); + + if (collected != SCM_EOL) /* Don't increment i */ + break; + } + + freelist->heap_segment_idx = i; + + return collected; +} + +void +scm_i_reset_segments (void) +{ + int i = 0; + for (; i < scm_i_heap_segment_table_size; i++) + { + scm_t_heap_segment *seg = scm_i_heap_segment_table[i]; + seg->next_free_card = seg->bounds[0]; + } +} + + + + +/* + Return a hashtab with counts of live objects, with tags as keys. + */ +SCM +scm_i_all_segments_statistics (SCM tab) +{ + int i = 0; + for (; i < scm_i_heap_segment_table_size; i++) + { + scm_t_heap_segment *seg = scm_i_heap_segment_table[i]; + scm_i_heap_segment_statistics (seg, tab); + } + + return tab; +} + + +unsigned long* +scm_i_segment_table_info (int* size) +{ + *size = scm_i_heap_segment_table_size; + unsigned long *bounds = malloc (sizeof (unsigned long) * *size * 2); + int i; + if (!bounds) + abort (); + for (i = *size; i-- > 0; ) + { + bounds[2*i] = (unsigned long)scm_i_heap_segment_table[i]->bounds[0]; + bounds[2*i+1] = (unsigned long)scm_i_heap_segment_table[i]->bounds[1]; + } + return bounds; +} + + +void +scm_i_sweep_all_segments (char const *reason, + scm_t_sweep_statistics *sweep_stats) +{ + unsigned i= 0; + for (i = 0; i < scm_i_heap_segment_table_size; i++) + { + scm_i_sweep_segment (scm_i_heap_segment_table[i], sweep_stats); + } +} + + +void +scm_i_clear_mark_space (void) +{ + int i = 0; + for (; i < scm_i_heap_segment_table_size; i++) + { + scm_i_clear_segment_mark_space (scm_i_heap_segment_table[i]); + } +} diff --git a/libguile/gc.c b/libguile/gc.c index 6d65f9c1d..230957bbb 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008 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 @@ -15,8 +15,6 @@ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ -#define _GNU_SOURCE - /* #define DEBUGINFO */ #if HAVE_CONFIG_H @@ -154,7 +152,7 @@ scm_assert_cell_valid (SCM cell) */ if (scm_expensive_debug_cell_accesses_p) scm_i_expensive_validation_check (cell); - +#if (SCM_DEBUG_MARKING_API == 0) if (!SCM_GC_MARK_P (cell)) { fprintf (stderr, @@ -164,7 +162,8 @@ scm_assert_cell_valid (SCM cell) (unsigned long) SCM_UNPACK (cell)); abort (); } - +#endif /* SCM_DEBUG_MARKING_API */ + scm_i_cell_validation_already_running = 0; /* re-enable */ } } @@ -240,6 +239,7 @@ SCM_SYMBOL (sym_gc_time_taken, "gc-time-taken"); SCM_SYMBOL (sym_gc_mark_time_taken, "gc-mark-time-taken"); SCM_SYMBOL (sym_times, "gc-times"); SCM_SYMBOL (sym_cells_marked, "cells-marked"); +SCM_SYMBOL (sym_cells_marked_conservatively, "cells-marked-conservatively"); SCM_SYMBOL (sym_cells_swept, "cells-swept"); SCM_SYMBOL (sym_malloc_yield, "malloc-yield"); SCM_SYMBOL (sym_cell_yield, "cell-yield"); @@ -327,7 +327,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, scm_cons (sym_cells_swept, scm_from_double (local_scm_gc_cells_swept)), scm_cons (sym_malloc_yield, - scm_from_long(local_scm_gc_malloc_yield_percentage)), + scm_from_long (local_scm_gc_malloc_yield_percentage)), scm_cons (sym_cell_yield, scm_from_long (local_scm_gc_cell_yield_percentage)), scm_cons (sym_heap_segments, heap_segs), @@ -347,7 +347,6 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, - SCM_DEFINE (scm_object_address, "object-address", 1, 0, 0, (SCM obj), "Return an integer that for the lifetime of @var{obj} is uniquely\n" @@ -505,7 +504,7 @@ scm_permanent_object (SCM obj) */ /* Implementation note: For every object X, there is a counter which - scm_gc_protect_object(X) increments and scm_gc_unprotect_object(X) decrements. + scm_gc_protect_object (X) increments and scm_gc_unprotect_object (X) decrements. */ @@ -715,7 +714,7 @@ gc_async_thunk (void) */ static void * mark_gc_async (void * hook_data SCM_UNUSED, - void *func_data SCM_UNUSED, + void *fn_data SCM_UNUSED, void *data SCM_UNUSED) { /* If cell access debugging is enabled, the user may choose to perform diff --git a/libguile/gc.h b/libguile/gc.h index 3f46655ef..db55abc18 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -3,7 +3,7 @@ #ifndef SCM_GC_H #define SCM_GC_H -/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008 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 @@ -134,10 +134,10 @@ SCM_API int scm_debug_cells_gc_interval ; void scm_i_expensive_validation_check (SCM cell); #endif -SCM_API scm_i_pthread_mutex_t scm_i_gc_admin_mutex; +SCM_INTERNAL scm_i_pthread_mutex_t scm_i_gc_admin_mutex; #define scm_gc_running_p (SCM_I_CURRENT_THREAD->gc_running_p) -SCM_API scm_i_pthread_mutex_t scm_i_sweep_mutex; +SCM_INTERNAL scm_i_pthread_mutex_t scm_i_sweep_mutex; #ifdef __ia64__ void *scm_ia64_register_backing_store_base (void); diff --git a/libguile/gdbint.h b/libguile/gdbint.h index d6511f7ad..64b9559c9 100644 --- a/libguile/gdbint.h +++ b/libguile/gdbint.h @@ -3,7 +3,7 @@ #ifndef SCM_GDBINT_H #define SCM_GDBINT_H -/* Copyright (C) 1996,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1996,2000, 2006, 2008 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 @@ -28,7 +28,7 @@ SCM_API int scm_print_carefully_p; -SCM_API void scm_init_gdbint (void); +SCM_INTERNAL void scm_init_gdbint (void); #endif /* SCM_GDBINT_H */ diff --git a/libguile/gen-scmconfig.c b/libguile/gen-scmconfig.c index 6afa72fcc..6d3fea679 100644 --- a/libguile/gen-scmconfig.c +++ b/libguile/gen-scmconfig.c @@ -121,7 +121,7 @@ # include <config.h> #endif -#include "gen-scmconfig.h" +#include <libguile/gen-scmconfig.h> #include <stdio.h> #include <string.h> @@ -387,6 +387,19 @@ main (int argc, char *argv[]) pf ("#define SCM_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER %d /* 0 or 1 */\n", SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER); + pf ("\n\n/*** File system access ***/\n"); + + pf ("/* Define to 1 if `struct dirent64' is available. */\n"); + pf ("#define SCM_HAVE_STRUCT_DIRENT64 %d /* 0 or 1 */\n", + SCM_I_GSC_HAVE_STRUCT_DIRENT64); + + pf ("/* Define to 1 if `readdir64_r ()' is available. */\n"); +#ifdef HAVE_READDIR64_R + pf ("#define SCM_HAVE_READDIR64_R 1 /* 0 or 1 */\n"); +#else + pf ("#define SCM_HAVE_READDIR64_R 0 /* 0 or 1 */\n"); +#endif + #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 cdc59b047..1be95af94 100644 --- a/libguile/gen-scmconfig.h.in +++ b/libguile/gen-scmconfig.h.in @@ -30,6 +30,7 @@ #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@ +#define SCM_I_GSC_HAVE_STRUCT_DIRENT64 @SCM_I_GSC_HAVE_STRUCT_DIRENT64@ /* Local Variables: diff --git a/libguile/gettext.h b/libguile/gettext.h index 4d91358e5..8a13307d5 100644 --- a/libguile/gettext.h +++ b/libguile/gettext.h @@ -3,7 +3,7 @@ #ifndef SCM_GETTEXT_H #define SCM_GETTEXT_H -/* Copyright (C) 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2004, 2006, 2008 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 @@ -28,9 +28,9 @@ SCM_API SCM scm_textdomain (SCM domainname); SCM_API SCM scm_bindtextdomain (SCM domainname, SCM directory); SCM_API SCM scm_bind_textdomain_codeset (SCM domainname, SCM encoding); -SCM_API int scm_i_to_lc_category (SCM category, int allow_lc_all); +SCM_INTERNAL int scm_i_to_lc_category (SCM category, int allow_lc_all); -SCM_API void scm_init_gettext (void); +SCM_INTERNAL void scm_init_gettext (void); #endif /* SCM_GETTEXT_H */ diff --git a/libguile/goops.c b/libguile/goops.c index 1674b39e3..72579b881 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004 +/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -25,6 +25,7 @@ */ #include <stdio.h> +#include <assert.h> #include "libguile/_scm.h" #include "libguile/alist.h" @@ -1258,6 +1259,7 @@ slot_definition_using_name (SCM class, SCM slot_name) static SCM get_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef) +#define FUNC_NAME "%get-slot-value" { SCM access = SCM_CDDR (slotdef); /* Two cases here: @@ -1268,7 +1270,9 @@ get_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef) * we can just assume fixnums here. */ if (SCM_I_INUMP (access)) - return SCM_SLOT (obj, SCM_I_INUM (access)); + /* Don't poke at the slots directly, because scm_struct_ref handles the + access bits for us. */ + return scm_struct_ref (obj, access); else { /* We must evaluate (apply (car access) (list obj)) @@ -1285,6 +1289,7 @@ get_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef) return scm_eval_body (SCM_CLOSURE_BODY (code), env); } } +#undef FUNC_NAME static SCM get_slot_value_using_name (SCM class, SCM obj, SCM slot_name) @@ -1298,6 +1303,7 @@ get_slot_value_using_name (SCM class, SCM obj, SCM slot_name) static SCM set_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef, SCM value) +#define FUNC_NAME "%set-slot-value" { SCM access = SCM_CDDR (slotdef); /* Two cases here: @@ -1308,7 +1314,8 @@ set_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef, SCM value) * we can just assume fixnums here. */ if (SCM_I_INUMP (access)) - SCM_SET_SLOT (obj, SCM_I_INUM (access), value); + /* obey permissions bits via going through struct-set! */ + scm_struct_set_x (obj, access, value); else { /* We must evaluate (apply (cadr l) (list obj value)) @@ -1329,6 +1336,7 @@ set_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef, SCM value) } return SCM_UNSPECIFIED; } +#undef FUNC_NAME static SCM set_slot_value_using_name (SCM class, SCM obj, SCM slot_name, SCM value) @@ -1498,10 +1506,15 @@ static SCM wrap_init (SCM class, SCM *m, long n) { long i; + scm_t_bits slayout = SCM_STRUCT_DATA (class)[scm_vtable_index_layout]; + const char *layout = scm_i_symbol_chars (SCM_PACK (slayout)); - /* Set all slots to unbound */ + /* Set all SCM-holding slots to unbound */ for (i = 0; i < n; i++) - m[i] = SCM_GOOPS_UNBOUND; + if (layout[i*2] == 'p') + m[i] = SCM_GOOPS_UNBOUND; + else + m[i] = 0; return scm_double_cell ((((scm_t_bits) SCM_STRUCT_DATA (class)) | scm_tc3_struct), @@ -1691,11 +1704,10 @@ go_to_hell (void *o) { SCM obj = SCM_PACK ((scm_t_bits) o); scm_lock_mutex (hell_mutex); - if (n_hell == hell_size) + if (n_hell >= hell_size) { - long new_size = 2 * hell_size; - hell = scm_realloc (hell, new_size); - hell_size = new_size; + hell_size *= 2; + hell = scm_realloc (hell, hell_size * sizeof(*hell)); } hell[n_hell++] = SCM_STRUCT_DATA (obj); scm_unlock_mutex (hell_mutex); @@ -2867,7 +2879,8 @@ scm_add_slot (SCM class, char *slot_name, SCM slot_class, scm_list_1 (slot)))); { SCM n = SCM_SLOT (class, scm_si_nfields); - SCM gns = scm_list_n (name, SCM_BOOL_F, get, set, n, scm_from_int (1)); + SCM gns = scm_list_n (name, SCM_BOOL_F, get, set, n, scm_from_int (1), + SCM_UNDEFINED); SCM_SET_SLOT (class, scm_si_getters_n_setters, scm_append_x (scm_list_2 (SCM_SLOT (class, scm_si_getters_n_setters), scm_list_1 (gns)))); @@ -2979,7 +2992,7 @@ scm_init_goops_builtins (void) list_of_no_method = scm_permanent_object (scm_list_1 (sym_no_method)); - hell = scm_malloc (hell_size); + hell = scm_calloc (hell_size * sizeof (*hell)); hell_mutex = scm_permanent_object (scm_make_mutex ()); create_basic_classes (); diff --git a/libguile/goops.h b/libguile/goops.h index 3fc87886f..80ba98549 100644 --- a/libguile/goops.h +++ b/libguile/goops.h @@ -3,7 +3,7 @@ #ifndef SCM_GOOPS_H #define SCM_GOOPS_H -/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008 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 @@ -254,7 +254,8 @@ SCM_API SCM scm_pure_generic_p (SCM obj); #endif SCM_API SCM scm_sys_compute_slots (SCM c); -SCM_API SCM scm_i_get_keyword (SCM key, SCM l, long len, SCM default_value, const char *subr); +SCM_INTERNAL SCM scm_i_get_keyword (SCM key, SCM l, long len, + SCM default_value, const char *subr); SCM_API SCM scm_get_keyword (SCM key, SCM l, SCM default_value); SCM_API SCM scm_sys_initialize_object (SCM obj, SCM initargs); SCM_API SCM scm_sys_prep_layout_x (SCM c); @@ -297,8 +298,8 @@ SCM_API SCM scm_make (SCM args); SCM_API SCM scm_find_method (SCM args); SCM_API SCM scm_sys_method_more_specific_p (SCM m1, SCM m2, SCM targs); -SCM_API SCM scm_init_goops_builtins (void); -SCM_API void scm_init_goops (void); +SCM_INTERNAL SCM scm_init_goops_builtins (void); +SCM_INTERNAL void scm_init_goops (void); #if (SCM_ENABLE_DEPRECATED == 1) diff --git a/libguile/gsubr.h b/libguile/gsubr.h index e7488052b..418564901 100644 --- a/libguile/gsubr.h +++ b/libguile/gsubr.h @@ -3,7 +3,7 @@ #ifndef SCM_GSUBR_H #define SCM_GSUBR_H -/* Copyright (C) 1995,1996,1998,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008 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 @@ -51,7 +51,7 @@ SCM_API SCM scm_c_define_gsubr_with_generic (const char *name, SCM (*fcn) (), SCM *gf); SCM_API SCM scm_gsubr_apply (SCM args); -SCM_API void scm_init_gsubr (void); +SCM_INTERNAL void scm_init_gsubr (void); #endif /* SCM_GSUBR_H */ diff --git a/libguile/guardians.h b/libguile/guardians.h index 735f960f8..295092edf 100644 --- a/libguile/guardians.h +++ b/libguile/guardians.h @@ -3,7 +3,7 @@ #ifndef SCM_GUARDIANS_H #define SCM_GUARDIANS_H -/* Copyright (C) 1998,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1998,2000,2001, 2006, 2008 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 @@ -26,11 +26,11 @@ SCM_API SCM scm_make_guardian (void); -SCM_API void scm_i_init_guardians_for_gc (void); -SCM_API void scm_i_identify_inaccessible_guardeds (void); -SCM_API int scm_i_mark_inaccessible_guardeds (void); +SCM_INTERNAL void scm_i_init_guardians_for_gc (void); +SCM_INTERNAL void scm_i_identify_inaccessible_guardeds (void); +SCM_INTERNAL int scm_i_mark_inaccessible_guardeds (void); -SCM_API void scm_init_guardians (void); +SCM_INTERNAL void scm_init_guardians (void); #endif /* SCM_GUARDIANS_H */ diff --git a/libguile/guile-snarf.in b/libguile/guile-snarf.in index 89ef79092..617bad822 100644 --- a/libguile/guile-snarf.in +++ b/libguile/guile-snarf.in @@ -1,7 +1,7 @@ #!/bin/sh # Extract the initialization actions from source files. # -# Copyright (C) 1996, 97, 98, 99, 2000, 2001, 2002, 2004, 2006 Free Software Foundation, Inc. +# Copyright (C) 1996, 97, 98, 99, 2000, 2001, 2002, 2004, 2006, 2008 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 @@ -69,9 +69,12 @@ fi # set vars and handler -- handle CPP override cpp_ok_p=false -tempdir="/tmp/snarf.$$" + +if [ x"$TMPDIR" = x ]; then TMPDIR="/tmp" ; else : ; fi +tempdir="$TMPDIR/guile-snarf.$$" (umask 077 && mkdir $tempdir) || exit 1 temp="$tempdir/tmp" + if [ x"$CPP" = x ] ; then cpp="@CPP@" ; else cpp="$CPP" ; fi trap "rm -rf $tempdir" 0 1 2 15 diff --git a/libguile/hash.h b/libguile/hash.h index a2d00c203..bbf9b2562 100644 --- a/libguile/hash.h +++ b/libguile/hash.h @@ -3,7 +3,7 @@ #ifndef SCM_HASH_H #define SCM_HASH_H -/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000, 2006, 2008 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 @@ -34,7 +34,7 @@ SCM_API unsigned long scm_ihashv (SCM obj, unsigned long n); SCM_API SCM scm_hashv (SCM obj, SCM n); SCM_API unsigned long scm_ihash (SCM obj, unsigned long n); SCM_API SCM scm_hash (SCM obj, SCM n); -SCM_API void scm_init_hash (void); +SCM_INTERNAL void scm_init_hash (void); #endif /* SCM_HASH_H */ diff --git a/libguile/hashtab.c b/libguile/hashtab.c index 633d26261..08209613a 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2008 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 @@ -498,6 +498,8 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned long (*hash_ if (scm_is_true (it)) return it; + else if (scm_is_true (it)) + scm_wrong_type_arg_msg (NULL, 0, it, "a pair"); else { /* When this is a weak hashtable, running the GC can change it. diff --git a/libguile/hashtab.h b/libguile/hashtab.h index c7af133c0..005fd57aa 100644 --- a/libguile/hashtab.h +++ b/libguile/hashtab.h @@ -3,7 +3,7 @@ #ifndef SCM_HASHTAB_H #define SCM_HASHTAB_H -/* Copyright (C) 1995,1996,1999,2000,2001, 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1999,2000,2001, 2003, 2004, 2006, 2008 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 @@ -93,7 +93,8 @@ SCM_API SCM scm_weak_key_hash_table_p (SCM h); SCM_API SCM scm_weak_value_hash_table_p (SCM h); SCM_API SCM scm_doubly_weak_hash_table_p (SCM h); -SCM_API void scm_i_rehash (SCM table, unsigned long (*hash_fn)(), void *closure, const char*func_name); +SCM_INTERNAL void scm_i_rehash (SCM table, unsigned long (*hash_fn)(), + void *closure, const char *func_name); SCM_API SCM scm_hash_fn_get_handle (SCM table, SCM obj, unsigned long (*hash_fn) (), SCM (*assoc_fn) (), void * closure); SCM_API SCM scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned long (*hash_fn) (), SCM (*assoc_fn) (), void * closure); @@ -128,8 +129,8 @@ SCM_API SCM scm_hash_fold (SCM proc, SCM init, SCM hash); SCM_API SCM scm_hash_for_each (SCM proc, SCM hash); SCM_API SCM scm_hash_for_each_handle (SCM proc, SCM hash); SCM_API SCM scm_hash_map_to_list (SCM proc, SCM hash); -SCM_API void scm_hashtab_prehistory (void); -SCM_API void scm_init_hashtab (void); +SCM_INTERNAL void scm_hashtab_prehistory (void); +SCM_INTERNAL void scm_init_hashtab (void); #endif /* SCM_HASHTAB_H */ diff --git a/libguile/hooks.c b/libguile/hooks.c index 78adec0cd..787382983 100644 --- a/libguile/hooks.c +++ b/libguile/hooks.c @@ -50,7 +50,7 @@ scm_c_hook_init (scm_t_c_hook *hook, void *hook_data, scm_t_c_hook_type type) void scm_c_hook_add (scm_t_c_hook *hook, scm_t_c_hook_function func, - void *func_data, + void *fn_data, int appendp) { scm_t_c_hook_entry *entry = scm_malloc (sizeof (scm_t_c_hook_entry)); @@ -60,19 +60,19 @@ scm_c_hook_add (scm_t_c_hook *hook, loc = &(*loc)->next; entry->next = *loc; entry->func = func; - entry->data = func_data; + entry->data = fn_data; *loc = entry; } void scm_c_hook_remove (scm_t_c_hook *hook, scm_t_c_hook_function func, - void *func_data) + void *fn_data) { scm_t_c_hook_entry **loc = &hook->first; while (*loc) { - if ((*loc)->func == func && (*loc)->data == func_data) + if ((*loc)->func == func && (*loc)->data == fn_data) { scm_t_c_hook_entry *entry = *loc; *loc = (*loc)->next; diff --git a/libguile/hooks.h b/libguile/hooks.h index e6598cabf..49ea55350 100644 --- a/libguile/hooks.h +++ b/libguile/hooks.h @@ -3,7 +3,7 @@ #ifndef SCM_HOOKS_H #define SCM_HOOKS_H -/* Copyright (C) 1995,1996,1999,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2008 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 @@ -40,7 +40,7 @@ typedef enum scm_t_c_hook_type { } scm_t_c_hook_type; typedef void *(*scm_t_c_hook_function) (void *hook_data, - void *func_data, + void *fn_data, void *data); typedef struct scm_t_c_hook_entry { @@ -60,11 +60,11 @@ SCM_API void scm_c_hook_init (scm_t_c_hook *hook, scm_t_c_hook_type type); SCM_API void scm_c_hook_add (scm_t_c_hook *hook, scm_t_c_hook_function func, - void *func_data, + void *fn_data, int appendp); SCM_API void scm_c_hook_remove (scm_t_c_hook *hook, scm_t_c_hook_function func, - void *func_data); + void *fn_data); SCM_API void *scm_c_hook_run (scm_t_c_hook *hook, void *data); /* @@ -87,7 +87,7 @@ SCM_API SCM scm_reset_hook_x (SCM hook); SCM_API SCM scm_run_hook (SCM hook, SCM args); SCM_API void scm_c_run_hook (SCM hook, SCM args); SCM_API SCM scm_hook_to_list (SCM hook); -SCM_API void scm_init_hooks (void); +SCM_INTERNAL void scm_init_hooks (void); #endif /* SCM_HOOKS_H */ diff --git a/libguile/i18n.c b/libguile/i18n.c index 43381f4ed..5d2d976fd 100644 --- a/libguile/i18n.c +++ b/libguile/i18n.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 2006, 2007, 2008 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 @@ -769,7 +769,7 @@ static inline void str_upcase (register char *dst, register const char *src) { for (; *src != '\0'; src++, dst++) - *dst = toupper (*src); + *dst = toupper ((int) *src); *dst = '\0'; } @@ -777,7 +777,7 @@ static inline void str_downcase (register char *dst, register const char *src) { for (; *src != '\0'; src++, dst++) - *dst = tolower (*src); + *dst = tolower ((int) *src); *dst = '\0'; } @@ -1120,13 +1120,13 @@ SCM_DEFINE (scm_char_locale_downcase, "char-locale-downcase", 1, 1, 0, if (c_locale != NULL) { #ifdef USE_GNU_LOCALE_API - c_result = tolower_l (c_chr, c_locale); + c_result = tolower_l ((int) c_chr, c_locale); #else - RUN_IN_LOCALE_SECTION (c_locale, c_result = tolower (c_chr)); + RUN_IN_LOCALE_SECTION (c_locale, c_result = tolower ((int) c_chr)); #endif } else - c_result = tolower (c_chr); + c_result = tolower ((int) c_chr); return (SCM_MAKE_CHAR (c_result)); } @@ -1150,13 +1150,13 @@ SCM_DEFINE (scm_char_locale_upcase, "char-locale-upcase", 1, 1, 0, if (c_locale != NULL) { #ifdef USE_GNU_LOCALE_API - c_result = toupper_l (c_chr, c_locale); + c_result = toupper_l ((int) c_chr, c_locale); #else - RUN_IN_LOCALE_SECTION (c_locale, c_result = toupper (c_chr)); + RUN_IN_LOCALE_SECTION (c_locale, c_result = toupper ((int) c_chr)); #endif } else - c_result = toupper (c_chr); + c_result = toupper ((int) c_chr); return (SCM_MAKE_CHAR (c_result)); } diff --git a/libguile/i18n.h b/libguile/i18n.h index 17dc240d8..57f1654a3 100644 --- a/libguile/i18n.h +++ b/libguile/i18n.h @@ -3,7 +3,7 @@ #ifndef SCM_I18N_H #define SCM_I18N_H -/* Copyright (C) 2006 Free Software Foundation, Inc. +/* Copyright (C) 2006, 2008 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 diff --git a/libguile/init.h b/libguile/init.h index ec083da52..3ae27d8cc 100644 --- a/libguile/init.h +++ b/libguile/init.h @@ -3,7 +3,7 @@ #ifndef SCM_INIT_H #define SCM_INIT_H -/* Copyright (C) 1995,1996,1997,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,2000, 2006, 2008 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 @@ -26,7 +26,7 @@ #include "libguile/threads.h" -SCM_API scm_i_pthread_mutex_t scm_i_init_mutex; +SCM_INTERNAL scm_i_pthread_mutex_t scm_i_init_mutex; SCM_API int scm_initialized_p; SCM_API void scm_init_guile (void); @@ -37,7 +37,7 @@ SCM_API void scm_boot_guile (int argc, char **argv, char **argv), void *closure); -SCM_API void scm_i_init_guile (SCM_STACKITEM *base); +SCM_INTERNAL void scm_i_init_guile (SCM_STACKITEM *base); SCM_API void scm_load_startup_files (void); diff --git a/libguile/inline.h b/libguile/inline.h index 75a7cc95c..3fae97c17 100644 --- a/libguile/inline.h +++ b/libguile/inline.h @@ -3,7 +3,7 @@ #ifndef SCM_INLINE_H #define SCM_INLINE_H -/* Copyright (C) 2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2002, 2003, 2004, 2006, 2008 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 @@ -25,18 +25,56 @@ "inline.c". */ -#include "libguile/__scm.h" - -#if (SCM_DEBUG_CELL_ACCESSES == 1) #include <stdio.h> -#endif +#include <string.h> + +#include "libguile/__scm.h" #include "libguile/pairs.h" #include "libguile/gc.h" #include "libguile/threads.h" #include "libguile/unif.h" -#include "libguile/pairs.h" +#include "libguile/ports.h" +#include "libguile/error.h" + + +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H + +/* GCC has `__inline__' in all modes, including strict ansi. GCC 4.3 and + above with `-std=c99' or `-std=gnu99' implements ISO C99 inline semantics, + unless `-fgnu89-inline' is used. Here we want GNU "extern inline" + semantics, hence the `__gnu_inline__' attribute, in accordance with: + http://gcc.gnu.org/gcc-4.3/porting_to.html . + + With GCC 4.2, `__GNUC_STDC_INLINE__' is never defined (because C99 inline + semantics are not supported), but a warning is issued in C99 mode if + `__gnu_inline__' is not used. + + Apple's GCC build >5400 (since Xcode 3.0) doesn't support GNU inline in + C99 mode and doesn't define `__GNUC_STDC_INLINE__'. Fall back to "static + inline" in that case. */ + +# if (defined __GNUC__) && (!(__APPLE_CC__ > 5400 && __STDC_VERSION__ >= 199901L)) +# define SCM_C_USE_EXTERN_INLINE 1 +# if (defined __GNUC_STDC_INLINE__) || (__GNUC__ == 4 && __GNUC_MINOR__ == 2) +# define SCM_C_EXTERN_INLINE \ + extern __inline__ __attribute__ ((__gnu_inline__)) +# else +# define SCM_C_EXTERN_INLINE extern __inline__ +# endif +# elif (defined SCM_C_INLINE) +# define SCM_C_EXTERN_INLINE static SCM_C_INLINE +# endif + +#endif /* SCM_INLINE_C_INCLUDING_INLINE_H */ + + +#if (!defined SCM_C_INLINE) || (defined SCM_INLINE_C_INCLUDING_INLINE_H) \ + || (defined SCM_C_USE_EXTERN_INLINE) +/* The `extern' declarations. They should only appear when used from + "inline.c", when `inline' is not supported at all or when "extern inline" + is used. */ #include "libguile/boehm-gc.h" @@ -48,8 +86,16 @@ SCM_API SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr, SCM_API SCM scm_array_handle_ref (scm_t_array_handle *h, ssize_t pos); SCM_API void scm_array_handle_set (scm_t_array_handle *h, ssize_t pos, SCM val); +SCM_API int scm_is_pair (SCM x); -#if defined SCM_C_INLINE || defined SCM_INLINE_C_INCLUDING_INLINE_H +SCM_API int scm_getc (SCM port); +SCM_API void scm_putc (char c, SCM port); +SCM_API void scm_puts (const char *str_data, SCM port); + +#endif + + +#if defined SCM_C_EXTERN_INLINE || defined SCM_INLINE_C_INCLUDING_INLINE_H /* either inlining, or being included from inline.c. We use (and repeat) this long #if test here and below so that we don't have to introduce any extraneous symbols into the public namespace. We @@ -58,14 +104,9 @@ SCM_API void scm_array_handle_set (scm_t_array_handle *h, ssize_t pos, SCM val); extern unsigned scm_newcell2_count; extern unsigned scm_newcell_count; -#if defined SCM_C_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H -/* definitely inlining */ -#ifdef __GNUC__ -extern -#else -static -#endif -SCM_C_INLINE + +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE #endif SCM @@ -83,14 +124,8 @@ scm_cell (scm_t_bits car, scm_t_bits cdr) return cell; } -#if defined SCM_C_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H -/* definitely inlining */ -#ifdef __GNUC__ -extern -#else -static -#endif -SCM_C_INLINE +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE #endif SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr, @@ -132,14 +167,8 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr, return z; } -#if defined SCM_C_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H -/* definitely inlining */ -#ifdef __GNUC__ -extern -#else -static -#endif -SCM_C_INLINE +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE #endif SCM scm_array_handle_ref (scm_t_array_handle *h, ssize_t p) @@ -147,14 +176,8 @@ scm_array_handle_ref (scm_t_array_handle *h, ssize_t p) return h->ref (h, p); } -#if defined SCM_C_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H -/* definitely inlining */ -#ifdef __GNUC__ -extern -#else -static -#endif -SCM_C_INLINE +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE #endif void scm_array_handle_set (scm_t_array_handle *h, ssize_t p, SCM v) @@ -162,14 +185,8 @@ scm_array_handle_set (scm_t_array_handle *h, ssize_t p, SCM v) h->set (h, p, v); } -#if defined SCM_C_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H -/* definitely inlining */ -#ifdef __GNUC__ -extern -#else -static -#endif -SCM_C_INLINE +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE #endif int scm_is_pair (SCM x) @@ -198,5 +215,77 @@ scm_is_pair (SCM x) return SCM_I_CONSP (x); } + +/* Port I/O. */ + +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE +#endif +int +scm_getc (SCM port) +{ + int c; + scm_t_port *pt = SCM_PTAB_ENTRY (port); + + if (pt->rw_active == SCM_PORT_WRITE) + /* may be marginally faster than calling scm_flush. */ + scm_ptobs[SCM_PTOBNUM (port)].flush (port); + + if (pt->rw_random) + pt->rw_active = SCM_PORT_READ; + + if (pt->read_pos >= pt->read_end) + { + if (scm_fill_input (port) == EOF) + return EOF; + } + + c = *(pt->read_pos++); + + switch (c) + { + case '\a': + break; + case '\b': + SCM_DECCOL (port); + break; + case '\n': + SCM_INCLINE (port); + break; + case '\r': + SCM_ZEROCOL (port); + break; + case '\t': + SCM_TABCOL (port); + break; + default: + SCM_INCCOL (port); + break; + } + + return c; +} + +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE +#endif +void +scm_putc (char c, SCM port) +{ + SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port"); + scm_lfwrite (&c, 1, port); +} + +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE +#endif +void +scm_puts (const char *s, SCM port) +{ + SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port"); + scm_lfwrite (s, strlen (s), port); +} + + #endif #endif diff --git a/libguile/ioext.h b/libguile/ioext.h index 7ced2af32..18289ea3c 100644 --- a/libguile/ioext.h +++ b/libguile/ioext.h @@ -3,7 +3,7 @@ #ifndef SCM_IOEXT_H #define SCM_IOEXT_H -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006, 2008 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 @@ -35,7 +35,7 @@ SCM_API SCM scm_isatty_p (SCM port); SCM_API SCM scm_fdopen (SCM fdes, SCM modes); SCM_API SCM scm_primitive_move_to_fdes (SCM port, SCM fd); SCM_API SCM scm_fdes_to_ports (SCM fd); -SCM_API void scm_init_ioext (void); +SCM_INTERNAL void scm_init_ioext (void); #endif /* SCM_IOEXT_H */ diff --git a/libguile/keywords.h b/libguile/keywords.h index d11c0e334..a80e31bff 100644 --- a/libguile/keywords.h +++ b/libguile/keywords.h @@ -3,7 +3,7 @@ #ifndef SCM_KEYWORDS_H #define SCM_KEYWORDS_H -/* Copyright (C) 1995,1996,1999,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2008 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 @@ -38,7 +38,7 @@ SCM_API int scm_is_keyword (SCM val); SCM_API SCM scm_from_locale_keyword (const char *str); SCM_API SCM scm_from_locale_keywordn (const char *str, size_t len); -SCM_API void scm_init_keywords (void); +SCM_INTERNAL void scm_init_keywords (void); #endif /* SCM_KEYWORDS_H */ diff --git a/libguile/lang.h b/libguile/lang.h index 886bb34ce..991e9ca76 100644 --- a/libguile/lang.h +++ b/libguile/lang.h @@ -3,7 +3,7 @@ #ifndef SCM_LANG_H #define SCM_LANG_H -/* Copyright (C) 1998, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1998, 2004, 2006, 2008 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 @@ -30,7 +30,7 @@ #define SCM_NILP(x) (scm_is_eq ((x), SCM_ELISP_NIL)) -SCM_API void scm_init_lang (void); +SCM_INTERNAL void scm_init_lang (void); #else /* ! SCM_ENABLE_ELISP */ diff --git a/libguile/list.h b/libguile/list.h index 749e65d50..733432d76 100644 --- a/libguile/list.h +++ b/libguile/list.h @@ -3,7 +3,7 @@ #ifndef SCM_LIST_H #define SCM_LIST_H -/* Copyright (C) 1995,1996,1997,2000,2001,2003,2004,2005,2006 +/* Copyright (C) 1995,1996,1997,2000,2001,2003,2004,2005,2006,2008 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -71,8 +71,8 @@ SCM_API SCM scm_filter_x (SCM pred, SCM list); /* Guile internal functions */ -SCM_API SCM scm_i_finite_list_copy (SCM /* a list known to be finite */); -SCM_API void scm_init_list (void); +SCM_INTERNAL SCM scm_i_finite_list_copy (SCM /* a list known to be finite */); +SCM_INTERNAL void scm_init_list (void); #endif /* SCM_LIST_H */ diff --git a/libguile/load.h b/libguile/load.h index 9b45d409a..57cc7e8ac 100644 --- a/libguile/load.h +++ b/libguile/load.h @@ -3,7 +3,7 @@ #ifndef SCM_LOAD_H #define SCM_LOAD_H -/* Copyright (C) 1995,1996,1998,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008 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 @@ -26,7 +26,6 @@ SCM_API SCM scm_parse_path (SCM path, SCM tail); -SCM_API void scm_init_load_path (void); SCM_API SCM scm_primitive_load (SCM filename); SCM_API SCM scm_c_primitive_load (const char *filename); SCM_API SCM scm_sys_package_data_dir (void); @@ -36,7 +35,8 @@ SCM_API SCM scm_search_path (SCM path, SCM filename, SCM exts); SCM_API SCM scm_sys_search_load_path (SCM filename); SCM_API SCM scm_primitive_load_path (SCM filename); SCM_API SCM scm_c_primitive_load_path (const char *filename); -SCM_API void scm_init_load (void); +SCM_INTERNAL void scm_init_load_path (void); +SCM_INTERNAL void scm_init_load (void); #endif /* SCM_LOAD_H */ diff --git a/libguile/locale-categories.h b/libguile/locale-categories.h index cec91fb91..cbe9684a3 100644 --- a/libguile/locale-categories.h +++ b/libguile/locale-categories.h @@ -1,4 +1,4 @@ -/* Copyright (C) 2006 Free Software Foundation, Inc. +/* Copyright (C) 2006, 2008 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,7 +21,12 @@ /* The six standard categories, as defined in IEEE Std 1003.1-2001. */ SCM_DEFINE_LOCALE_CATEGORY (COLLATE) SCM_DEFINE_LOCALE_CATEGORY (CTYPE) + +#ifdef LC_MESSAGES +/* MinGW doesn't have `LC_MESSAGES'. */ SCM_DEFINE_LOCALE_CATEGORY (MESSAGES) +#endif + SCM_DEFINE_LOCALE_CATEGORY (MONETARY) SCM_DEFINE_LOCALE_CATEGORY (NUMERIC) SCM_DEFINE_LOCALE_CATEGORY (TIME) diff --git a/libguile/macros.h b/libguile/macros.h index 0ad8757de..e1de77ff9 100644 --- a/libguile/macros.h +++ b/libguile/macros.h @@ -3,7 +3,7 @@ #ifndef SCM_MACROS_H #define SCM_MACROS_H -/* Copyright (C) 1998,2000,2001,2002,2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1998,2000,2001,2002,2003, 2006, 2008 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 @@ -36,7 +36,7 @@ SCM_API scm_t_bits scm_tc16_macro; -SCM_API SCM scm_i_makbimacro (SCM code); +SCM_INTERNAL SCM scm_i_makbimacro (SCM code); SCM_API SCM scm_makmmacro (SCM code); SCM_API SCM scm_makacro (SCM code); SCM_API SCM scm_macro_p (SCM obj); @@ -46,7 +46,7 @@ SCM_API SCM scm_macro_transformer (SCM m); SCM_API SCM scm_make_synt (const char *name, SCM (*macroizer) (SCM), SCM (*fcn) ()); -SCM_API void scm_init_macros (void); +SCM_INTERNAL void scm_init_macros (void); #if SCM_ENABLE_DEPRECATED == 1 SCM_API SCM scm_makmacro (SCM code); diff --git a/libguile/mallocs.h b/libguile/mallocs.h index cae4d1f6b..f711ddb94 100644 --- a/libguile/mallocs.h +++ b/libguile/mallocs.h @@ -3,7 +3,7 @@ #ifndef SCM_MALLOCS_H #define SCM_MALLOCS_H -/* Copyright (C) 1995,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,2000, 2006, 2008 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 @@ -34,7 +34,7 @@ SCM_API scm_t_bits scm_tc16_malloc; SCM_API SCM scm_malloc_obj (size_t n); -SCM_API void scm_init_mallocs (void); +SCM_INTERNAL void scm_init_mallocs (void); #endif /* SCM_MALLOCS_H */ diff --git a/libguile/modules.c b/libguile/modules.c index e4a2df037..e524eb518 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1998,2000,2001,2002,2003,2004,2006,2007 Free Software Foundation, Inc. +/* Copyright (C) 1998,2000,2001,2002,2003,2004,2006,2007,2008 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 @@ -40,12 +40,25 @@ scm_t_bits scm_module_tag; static SCM the_module; +static SCM the_root_module_var; + +static SCM +the_root_module () +{ + if (scm_module_system_booted_p) + return SCM_VARIABLE_REF (the_root_module_var); + else + return SCM_BOOL_F; +} + SCM_DEFINE (scm_current_module, "current-module", 0, 0, 0, (), "Return the current module.") #define FUNC_NAME s_scm_current_module { - return scm_fluid_ref (the_module); + SCM curr = scm_fluid_ref (the_module); + + return scm_is_true (curr) ? curr : the_root_module (); } #undef FUNC_NAME @@ -230,17 +243,6 @@ scm_env_top_level (SCM env) SCM_SYMBOL (sym_module, "module"); -static SCM the_root_module_var; - -static SCM -the_root_module () -{ - if (scm_module_system_booted_p) - return SCM_VARIABLE_REF (the_root_module_var); - else - return SCM_BOOL_F; -} - SCM scm_lookup_closure_module (SCM proc) { diff --git a/libguile/modules.h b/libguile/modules.h index 6e4f4d970..afac9f4e4 100644 --- a/libguile/modules.h +++ b/libguile/modules.h @@ -3,7 +3,7 @@ #ifndef SCM_MODULES_H #define SCM_MODULES_H -/* Copyright (C) 1998, 2000, 2001, 2002, 2003, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1998, 2000, 2001, 2002, 2003, 2006, 2007, 2008 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 @@ -116,8 +116,8 @@ SCM_API SCM scm_env_module (SCM env); SCM_API SCM scm_top_level_env (SCM thunk); SCM_API SCM scm_system_module_env_p (SCM env); -SCM_API void scm_modules_prehistory (void); -SCM_API void scm_init_modules (void); +SCM_INTERNAL void scm_modules_prehistory (void); +SCM_INTERNAL void scm_init_modules (void); #endif /* SCM_MODULES_H */ diff --git a/libguile/net_db.h b/libguile/net_db.h index ae8e8aa11..df1f03067 100644 --- a/libguile/net_db.h +++ b/libguile/net_db.h @@ -3,7 +3,7 @@ #ifndef SCM_NET_DB_H #define SCM_NET_DB_H -/* Copyright (C) 1995,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,2000,2001, 2006, 2008 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 @@ -34,7 +34,7 @@ SCM_API SCM scm_sethost (SCM arg); SCM_API SCM scm_setnet (SCM arg); SCM_API SCM scm_setproto (SCM arg); SCM_API SCM scm_setserv (SCM arg); -SCM_API void scm_init_net_db (void); +SCM_INTERNAL void scm_init_net_db (void); #endif /* SCM_NET_DB_H */ diff --git a/libguile/numbers.c b/libguile/numbers.c index 57cf5d266..3c54f61ed 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005, 2006, 2007, 2008 Free Software Foundation, Inc. * * Portions Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories * and Bellcore. See scm_divide. @@ -40,9 +40,6 @@ */ -/* tell glibc (2.3) to give prototype for C99 trunc(), csqrt(), etc */ -#define _GNU_SOURCE - #if HAVE_CONFIG_H # include <config.h> #endif @@ -162,20 +159,25 @@ xisnan (double x) #endif } +#if defined (GUILE_I) +#if HAVE_COMPLEX_DOUBLE /* For an SCM object Z which is a complex number (ie. satisfies SCM_COMPLEXP), return its value as a C level "complex double". */ #define SCM_COMPLEX_VALUE(z) \ - (SCM_COMPLEX_REAL (z) + _Complex_I * SCM_COMPLEX_IMAG (z)) + (SCM_COMPLEX_REAL (z) + GUILE_I * SCM_COMPLEX_IMAG (z)) + +static inline SCM scm_from_complex_double (complex double z) SCM_UNUSED; /* Convert a C "complex double" to an SCM value. */ -#if HAVE_COMPLEX_DOUBLE -static SCM +static inline SCM scm_from_complex_double (complex double z) { return scm_c_make_rectangular (creal (z), cimag (z)); } + #endif /* HAVE_COMPLEX_DOUBLE */ +#endif /* GUILE_I */ @@ -183,7 +185,7 @@ static mpz_t z_negative_one; -SCM_C_INLINE_KEYWORD SCM +SCM scm_i_mkbig () { /* Return a newly created bignum. */ @@ -192,7 +194,7 @@ scm_i_mkbig () return z; } -SCM_C_INLINE_KEYWORD SCM +SCM scm_i_long2big (long x) { /* Return a newly created bignum initialized to X. */ @@ -201,7 +203,7 @@ scm_i_long2big (long x) return z; } -SCM_C_INLINE_KEYWORD SCM +SCM scm_i_ulong2big (unsigned long x) { /* Return a newly created bignum initialized to X. */ @@ -210,7 +212,7 @@ scm_i_ulong2big (unsigned long x) return z; } -SCM_C_INLINE_KEYWORD SCM +SCM scm_i_clonebig (SCM src_big, int same_sign_p) { /* Copy src_big's value, negate it if same_sign_p is false, and return. */ @@ -221,7 +223,7 @@ scm_i_clonebig (SCM src_big, int same_sign_p) return z; } -SCM_C_INLINE_KEYWORD int +int scm_i_bigcmp (SCM x, SCM y) { /* Return neg if x < y, pos if x > y, and 0 if x == y */ @@ -231,7 +233,7 @@ scm_i_bigcmp (SCM x, SCM y) return result; } -SCM_C_INLINE_KEYWORD SCM +SCM scm_i_dbl2big (double d) { /* results are only defined if d is an integer */ @@ -242,7 +244,7 @@ scm_i_dbl2big (double d) /* Convert a integer in double representation to a SCM number. */ -SCM_C_INLINE_KEYWORD SCM +SCM scm_i_dbl2num (double u) { /* SCM_MOST_POSITIVE_FIXNUM+1 and SCM_MOST_NEGATIVE_FIXNUM are both @@ -339,7 +341,7 @@ scm_i_big2dbl (SCM b) return result; } -SCM_C_INLINE_KEYWORD SCM +SCM scm_i_normbig (SCM b) { /* convert a big back to a fixnum if it'll fit */ @@ -3950,16 +3952,16 @@ SCM_GPROC1 (s_sum, "+", scm_tc7_asubr, scm_sum, g_sum); SCM scm_sum (SCM x, SCM y) { - if (SCM_UNBNDP (y)) + if (SCM_UNLIKELY (SCM_UNBNDP (y))) { if (SCM_NUMBERP (x)) return x; if (SCM_UNBNDP (x)) return SCM_INUM0; SCM_WTA_DISPATCH_1 (g_sum, x, SCM_ARG1, s_sum); } - if (SCM_I_INUMP (x)) + if (SCM_LIKELY (SCM_I_INUMP (x))) { - if (SCM_I_INUMP (y)) + if (SCM_LIKELY (SCM_I_INUMP (y))) { long xx = SCM_I_INUM (x); long yy = SCM_I_INUM (y); @@ -4144,7 +4146,7 @@ SCM_GPROC1 (s_difference, "-", scm_tc7_asubr, scm_difference, g_difference); SCM scm_difference (SCM x, SCM y) { - if (SCM_UNBNDP (y)) + if (SCM_UNLIKELY (SCM_UNBNDP (y))) { if (SCM_UNBNDP (x)) SCM_WTA_DISPATCH_0 (g_difference, s_difference); @@ -4173,9 +4175,9 @@ scm_difference (SCM x, SCM y) SCM_WTA_DISPATCH_1 (g_difference, x, SCM_ARG1, s_difference); } - if (SCM_I_INUMP (x)) + if (SCM_LIKELY (SCM_I_INUMP (x))) { - if (SCM_I_INUMP (y)) + if (SCM_LIKELY (SCM_I_INUMP (y))) { long int xx = SCM_I_INUM (x); long int yy = SCM_I_INUM (y); @@ -4388,7 +4390,7 @@ SCM_GPROC1 (s_product, "*", scm_tc7_asubr, scm_product, g_product); SCM scm_product (SCM x, SCM y) { - if (SCM_UNBNDP (y)) + if (SCM_UNLIKELY (SCM_UNBNDP (y))) { if (SCM_UNBNDP (x)) return SCM_I_MAKINUM (1L); @@ -4398,7 +4400,7 @@ scm_product (SCM x, SCM y) SCM_WTA_DISPATCH_1 (g_product, x, SCM_ARG1, s_product); } - if (SCM_I_INUMP (x)) + if (SCM_LIKELY (SCM_I_INUMP (x))) { long xx; @@ -4411,7 +4413,7 @@ scm_product (SCM x, SCM y) case 1: return y; break; } - if (SCM_I_INUMP (y)) + if (SCM_LIKELY (SCM_I_INUMP (y))) { long yy = SCM_I_INUM (y); long kk = xx * yy; @@ -4611,7 +4613,7 @@ scm_i_divide (SCM x, SCM y, int inexact) { double a; - if (SCM_UNBNDP (y)) + if (SCM_UNLIKELY (SCM_UNBNDP (y))) { if (SCM_UNBNDP (x)) SCM_WTA_DISPATCH_0 (g_divide, s_divide); @@ -4671,10 +4673,10 @@ scm_i_divide (SCM x, SCM y, int inexact) SCM_WTA_DISPATCH_1 (g_divide, x, SCM_ARG1, s_divide); } - if (SCM_I_INUMP (x)) + if (SCM_LIKELY (SCM_I_INUMP (x))) { long xx = SCM_I_INUM (x); - if (SCM_I_INUMP (y)) + if (SCM_LIKELY (SCM_I_INUMP (y))) { long yy = SCM_I_INUM (y); if (yy == 0) @@ -5336,13 +5338,13 @@ scm_c_make_rectangular (double re, double im) } SCM_DEFINE (scm_make_rectangular, "make-rectangular", 2, 0, 0, - (SCM real, SCM imaginary), - "Return a complex number constructed of the given @var{real} and\n" - "@var{imaginary} parts.") + (SCM real_part, SCM imaginary_part), + "Return a complex number constructed of the given @var{real-part} " + "and @var{imaginary-part} parts.") #define FUNC_NAME s_scm_make_rectangular { struct dpair xy; - scm_two_doubles (real, imaginary, FUNC_NAME, &xy); + scm_two_doubles (real_part, imaginary_part, FUNC_NAME, &xy); return scm_c_make_rectangular (xy.x, xy.y); } #undef FUNC_NAME @@ -5595,8 +5597,18 @@ SCM_DEFINE (scm_inexact_to_exact, "inexact->exact", 1, 0, 0, #undef FUNC_NAME SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, - (SCM x, SCM err), - "Return an exact number that is within @var{err} of @var{x}.") + (SCM x, SCM eps), + "Returns the @emph{simplest} rational number differing\n" + "from @var{x} by no more than @var{eps}.\n" + "\n" + "As required by @acronym{R5RS}, @code{rationalize} only returns an\n" + "exact result when both its arguments are exact. Thus, you might need\n" + "to use @code{inexact->exact} on the arguments.\n" + "\n" + "@lisp\n" + "(rationalize (inexact->exact 1.2) 1/100)\n" + "@result{} 6/5\n" + "@end lisp") #define FUNC_NAME s_scm_rationalize { if (SCM_I_INUMP (x)) @@ -5628,7 +5640,7 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, converges after less than a dozen iterations. */ - err = scm_abs (err); + eps = scm_abs (eps); while (++i < 1000000) { a = scm_sum (scm_product (a1, tt), a2); /* a = a1*tt + a2 */ @@ -5636,11 +5648,11 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, if (scm_is_false (scm_zero_p (b)) && /* b != 0 */ scm_is_false (scm_gr_p (scm_abs (scm_difference (ex, scm_divide (a, b))), - err))) /* abs(x-a/b) <= err */ + eps))) /* abs(x-a/b) <= eps */ { SCM res = scm_sum (int_part, scm_divide (a, b)); if (scm_is_false (scm_exact_p (x)) - || scm_is_false (scm_exact_p (err))) + || scm_is_false (scm_exact_p (eps))) return scm_exact_to_inexact (res); else return res; @@ -6012,7 +6024,7 @@ SCM_DEFINE (scm_log, "log", 1, 0, 0, { if (SCM_COMPLEXP (z)) { -#if HAVE_COMPLEX_DOUBLE && HAVE_CLOG +#if HAVE_COMPLEX_DOUBLE && HAVE_CLOG && defined (SCM_COMPLEX_VALUE) return scm_from_complex_double (clog (SCM_COMPLEX_VALUE (z))); #else double re = SCM_COMPLEX_REAL (z); @@ -6046,7 +6058,7 @@ SCM_DEFINE (scm_log10, "log10", 1, 0, 0, /* Mingw has clog() but not clog10(). (Maybe it'd be worth using clog() and a multiply by M_LOG10E, rather than the fallback log10+hypot+atan2.) */ -#if HAVE_COMPLEX_DOUBLE && HAVE_CLOG10 +#if HAVE_COMPLEX_DOUBLE && HAVE_CLOG10 && defined (SCM_COMPLEX_VALUE) return scm_from_complex_double (clog10 (SCM_COMPLEX_VALUE (z))); #else double re = SCM_COMPLEX_REAL (z); @@ -6078,7 +6090,7 @@ SCM_DEFINE (scm_exp, "exp", 1, 0, 0, { if (SCM_COMPLEXP (z)) { -#if HAVE_COMPLEX_DOUBLE && HAVE_CEXP +#if HAVE_COMPLEX_DOUBLE && HAVE_CEXP && defined (SCM_COMPLEX_VALUE) return scm_from_complex_double (cexp (SCM_COMPLEX_VALUE (z))); #else return scm_c_make_polar (exp (SCM_COMPLEX_REAL (z)), @@ -6112,7 +6124,7 @@ SCM_DEFINE (scm_sqrt, "sqrt", 1, 0, 0, { if (SCM_COMPLEXP (x)) { -#if HAVE_COMPLEX_DOUBLE && HAVE_USABLE_CSQRT +#if HAVE_COMPLEX_DOUBLE && HAVE_USABLE_CSQRT && defined (SCM_COMPLEX_VALUE) return scm_from_complex_double (csqrt (SCM_COMPLEX_VALUE (x))); #else double re = SCM_COMPLEX_REAL (x); diff --git a/libguile/numbers.h b/libguile/numbers.h index 2c2fdcf07..e139dac7b 100644 --- a/libguile/numbers.h +++ b/libguile/numbers.h @@ -3,7 +3,7 @@ #ifndef SCM_NUMBERS_H #define SCM_NUMBERS_H -/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004,2005, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004,2005, 2006, 2008 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 @@ -261,15 +261,15 @@ SCM_API SCM scm_exp (SCM z); SCM_API SCM scm_sqrt (SCM z); /* bignum internal functions */ -SCM_API SCM scm_i_mkbig (void); -SCM_API SCM scm_i_normbig (SCM x); -SCM_API int scm_i_bigcmp (SCM a, SCM b); -SCM_API SCM scm_i_dbl2big (double d); -SCM_API SCM scm_i_dbl2num (double d); -SCM_API double scm_i_big2dbl (SCM b); -SCM_API SCM scm_i_long2big (long n); -SCM_API SCM scm_i_ulong2big (unsigned long n); -SCM_API SCM scm_i_clonebig (SCM src_big, int same_sign_p); +SCM_INTERNAL SCM scm_i_mkbig (void); +SCM_API /* FIXME: not internal */ SCM scm_i_normbig (SCM x); +SCM_INTERNAL int scm_i_bigcmp (SCM a, SCM b); +SCM_INTERNAL SCM scm_i_dbl2big (double d); +SCM_INTERNAL SCM scm_i_dbl2num (double d); +SCM_API /* FIXME: not internal */ double scm_i_big2dbl (SCM b); +SCM_API /* FIXME: not internal */ SCM scm_i_long2big (long n); +SCM_API /* FIXME: not internal */ SCM scm_i_ulong2big (unsigned long n); +SCM_API /* FIXME: not internal */ SCM scm_i_clonebig (SCM src_big, int same_sign_p); /* ratio functions */ SCM_API SCM scm_rationalize (SCM x, SCM err); @@ -277,13 +277,13 @@ SCM_API SCM scm_numerator (SCM z); SCM_API SCM scm_denominator (SCM z); /* fraction internal functions */ -SCM_API double scm_i_fraction2double (SCM z); -SCM_API SCM scm_i_fraction_equalp (SCM x, SCM y); -SCM_API int scm_i_print_fraction (SCM sexp, SCM port, scm_print_state *pstate); +SCM_INTERNAL double scm_i_fraction2double (SCM z); +SCM_INTERNAL SCM scm_i_fraction_equalp (SCM x, SCM y); +SCM_INTERNAL int scm_i_print_fraction (SCM sexp, SCM port, scm_print_state *pstate); /* general internal functions */ -SCM_API void scm_i_print_double (double val, SCM port); -SCM_API void scm_i_print_complex (double real, double imag, SCM port); +SCM_INTERNAL void scm_i_print_double (double val, SCM port); +SCM_INTERNAL void scm_i_print_complex (double real, double imag, SCM port); /* conversion functions for integers */ @@ -480,7 +480,7 @@ SCM_API double scm_c_angle (SCM z); SCM_API int scm_is_number (SCM val); -SCM_API void scm_init_numbers (void); +SCM_INTERNAL void scm_init_numbers (void); #endif /* SCM_NUMBERS_H */ diff --git a/libguile/objects.h b/libguile/objects.h index fdd8e2891..68996d2a0 100644 --- a/libguile/objects.h +++ b/libguile/objects.h @@ -3,7 +3,7 @@ #ifndef SCM_OBJECTS_H #define SCM_OBJECTS_H -/* Copyright (C) 1996,1999,2000,2001, 2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1996,1999,2000,2001, 2003, 2006, 2008 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 @@ -181,7 +181,7 @@ SCM_API SCM scm_metaclass_operator; /* Goops functions. */ SCM_API SCM scm_make_extended_class (char const *type_name, int applicablep); -SCM_API void scm_i_inherit_applicable (SCM c); +SCM_INTERNAL void scm_i_inherit_applicable (SCM c); SCM_API void scm_make_port_classes (long ptobnum, char *type_name); SCM_API void scm_change_object_class (SCM, SCM, SCM); SCM_API SCM scm_memoize_method (SCM x, SCM args); @@ -205,9 +205,9 @@ SCM_API SCM scm_object_procedure (SCM obj); SCM_API SCM scm_make_class_object (SCM metaclass, SCM layout); SCM_API SCM scm_make_subclass_object (SCM c, SCM layout); -SCM_API SCM scm_i_make_class_object (SCM metaclass, SCM layout_string, - unsigned long flags); -SCM_API void scm_init_objects (void); +SCM_INTERNAL SCM scm_i_make_class_object (SCM metaclass, SCM layout_string, + unsigned long flags); +SCM_INTERNAL void scm_init_objects (void); #endif /* SCM_OBJECTS_H */ diff --git a/libguile/objprop.h b/libguile/objprop.h index edf2d9573..7e5365a74 100644 --- a/libguile/objprop.h +++ b/libguile/objprop.h @@ -3,7 +3,7 @@ #ifndef SCM_OBJPROP_H #define SCM_OBJPROP_H -/* Copyright (C) 1995,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,2000,2001, 2006, 2008 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 @@ -30,7 +30,7 @@ SCM_API SCM scm_object_properties (SCM obj); SCM_API SCM scm_set_object_properties_x (SCM obj, SCM plist); SCM_API SCM scm_object_property (SCM obj, SCM key); SCM_API SCM scm_set_object_property_x (SCM obj, SCM key, SCM val); -SCM_API void scm_init_objprop (void); +SCM_INTERNAL void scm_init_objprop (void); #endif /* SCM_OBJPROP_H */ diff --git a/libguile/options.h b/libguile/options.h index 5b9664958..4facdce01 100644 --- a/libguile/options.h +++ b/libguile/options.h @@ -3,7 +3,7 @@ #ifndef SCM_OPTIONS_H #define SCM_OPTIONS_H -/* Copyright (C) 1995,1996,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001, 2006, 2008 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 @@ -43,7 +43,7 @@ typedef struct scm_t_option SCM_API SCM scm_options_try (SCM args, scm_t_option options[], const char *s, int dry_run); SCM_API SCM scm_options (SCM, scm_t_option [], const char*); SCM_API void scm_init_opts (SCM (*) (SCM), scm_t_option []); -SCM_API void scm_init_options (void); +SCM_INTERNAL void scm_init_options (void); #endif /* SCM_OPTIONS_H */ diff --git a/libguile/pairs.h b/libguile/pairs.h index c30f4c564..61af24efe 100644 --- a/libguile/pairs.h +++ b/libguile/pairs.h @@ -3,7 +3,7 @@ #ifndef SCM_PAIRS_H #define SCM_PAIRS_H -/* Copyright (C) 1995,1996,2000,2001, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001, 2004, 2006, 2008 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 @@ -78,8 +78,6 @@ SCM_API void scm_error_pair_access (SCM); #endif -SCM_API int scm_is_pair (SCM x); - SCM_API SCM scm_cons (SCM x, SCM y); SCM_API SCM scm_cons2 (SCM w, SCM x, SCM y); SCM_API SCM scm_pair_p (SCM x); @@ -150,7 +148,7 @@ SCM_API SCM scm_i_chase_pairs (SCM x, scm_t_uint32 pattern); #define scm_caaadr(x) scm_i_chase_pairs ((x), SCM_I_AAAD_PAT) #define scm_caaaar(x) scm_i_chase_pairs ((x), SCM_I_AAAA_PAT) -SCM_API void scm_init_pairs (void); +SCM_INTERNAL void scm_init_pairs (void); #endif /* SCM_PAIRS_H */ diff --git a/libguile/ports.c b/libguile/ports.c index 9c6129d11..04cb83ad0 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008 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 @@ -1026,64 +1026,6 @@ scm_fill_input (SCM port) return scm_ptobs[SCM_PTOBNUM (port)].fill_input (port); } -int -scm_getc (SCM port) -{ - int c; - scm_t_port *pt = SCM_PTAB_ENTRY (port); - - if (pt->rw_active == SCM_PORT_WRITE) - /* may be marginally faster than calling scm_flush. */ - scm_ptobs[SCM_PTOBNUM (port)].flush (port); - - if (pt->rw_random) - pt->rw_active = SCM_PORT_READ; - - if (pt->read_pos >= pt->read_end) - { - if (scm_fill_input (port) == EOF) - return EOF; - } - - c = *(pt->read_pos++); - - switch (c) - { - case '\a': - break; - case '\b': - SCM_DECCOL (port); - break; - case '\n': - SCM_INCLINE (port); - break; - case '\r': - SCM_ZEROCOL (port); - break; - case '\t': - SCM_TABCOL (port); - break; - default: - SCM_INCCOL (port); - break; - } - - return c; -} - -void -scm_putc (char c, SCM port) -{ - SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port"); - scm_lfwrite (&c, 1, port); -} - -void -scm_puts (const char *s, SCM port) -{ - SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port"); - scm_lfwrite (s, strlen (s), port); -} /* scm_lfwrite * @@ -1135,10 +1077,14 @@ scm_lfwrite (const char *ptr, size_t size, SCM port) size_t scm_c_read (SCM port, void *buffer, size_t size) +#define FUNC_NAME "scm_c_read" { - scm_t_port *pt = SCM_PTAB_ENTRY (port); + scm_t_port *pt; size_t n_read = 0, n_available; + SCM_VALIDATE_OPINPORT (1, port); + + pt = SCM_PTAB_ENTRY (port); if (pt->rw_active == SCM_PORT_WRITE) scm_ptobs[SCM_PTOBNUM (port)].flush (port); @@ -1175,6 +1121,7 @@ scm_c_read (SCM port, void *buffer, size_t size) return n_read + size; } +#undef FUNC_NAME /* scm_c_write * @@ -1186,11 +1133,17 @@ scm_c_read (SCM port, void *buffer, size_t size) * Warning: Doesn't update port line and column counts! */ -void +void scm_c_write (SCM port, const void *ptr, size_t size) +#define FUNC_NAME "scm_c_write" { - scm_t_port *pt = SCM_PTAB_ENTRY (port); - scm_t_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)]; + scm_t_port *pt; + scm_t_ptob_descriptor *ptob; + + SCM_VALIDATE_OPOUTPORT (1, port); + + pt = SCM_PTAB_ENTRY (port); + ptob = &scm_ptobs[SCM_PTOBNUM (port)]; if (pt->rw_active == SCM_PORT_READ) scm_end_input (port); @@ -1200,6 +1153,7 @@ scm_c_write (SCM port, const void *ptr, size_t size) if (pt->rw_random) pt->rw_active = SCM_PORT_WRITE; } +#undef FUNC_NAME void scm_flush (SCM port) diff --git a/libguile/ports.h b/libguile/ports.h index b93135e6f..084a55500 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -3,7 +3,7 @@ #ifndef SCM_PORTS_H #define SCM_PORTS_H -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2008 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 @@ -109,8 +109,8 @@ typedef struct } scm_t_port; -SCM_API scm_i_pthread_mutex_t scm_i_port_table_mutex; -SCM_API SCM scm_i_port_weak_hash; +SCM_INTERNAL scm_i_pthread_mutex_t scm_i_port_table_mutex; +SCM_INTERNAL SCM scm_i_port_weak_hash; #define SCM_READ_BUFFER_EMPTY_P(c_port) (c_port->read_pos >= c_port->read_end) @@ -195,7 +195,7 @@ typedef struct scm_t_ptob_descriptor SCM_API scm_t_ptob_descriptor *scm_ptobs; SCM_API long scm_numptob; -SCM_API long scm_i_port_table_room; +SCM_INTERNAL long scm_i_port_table_room; @@ -241,7 +241,7 @@ SCM_API void scm_dynwind_current_input_port (SCM port); SCM_API void scm_dynwind_current_output_port (SCM port); SCM_API void scm_dynwind_current_error_port (SCM port); SCM_API SCM scm_new_port_table_entry (scm_t_bits tag); -SCM_API void scm_i_remove_port (SCM port); +SCM_INTERNAL void scm_i_remove_port (SCM port); SCM_API void scm_grow_port_cbuf (SCM port, size_t requested); SCM_API SCM scm_pt_size (void); SCM_API SCM scm_pt_member (SCM member); @@ -264,15 +264,12 @@ SCM_API SCM scm_eof_object_p (SCM x); SCM_API SCM scm_force_output (SCM port); SCM_API SCM scm_flush_all_ports (void); SCM_API SCM scm_read_char (SCM port); -SCM_API void scm_putc (char c, SCM port); -SCM_API void scm_puts (const char *str_data, SCM port); SCM_API size_t scm_c_read (SCM port, void *buffer, size_t size); SCM_API void scm_c_write (SCM port, const void *buffer, size_t size); SCM_API void scm_lfwrite (const char *ptr, size_t size, SCM port); SCM_API void scm_flush (SCM port); SCM_API void scm_end_input (SCM port); SCM_API int scm_fill_input (SCM port); -SCM_API int scm_getc (SCM port); SCM_API void scm_ungetc (int c, SCM port); SCM_API void scm_ungets (const char *s, int n, SCM port); SCM_API SCM scm_peek_char (SCM port); @@ -291,7 +288,7 @@ SCM_API void scm_print_port_mode (SCM exp, SCM port); SCM_API void scm_ports_prehistory (void); SCM_API SCM scm_void_port (char * mode_str); SCM_API SCM scm_sys_make_void_port (SCM mode); -SCM_API void scm_init_ports (void); +SCM_INTERNAL void scm_init_ports (void); #if SCM_ENABLE_DEPRECATED==1 @@ -305,8 +302,8 @@ SCM_API SCM scm_pt_member (SCM member); /* internal */ -SCM_API long scm_i_mode_bits (SCM modes); -SCM_API void scm_i_dynwind_current_load_port (SCM port); +SCM_INTERNAL long scm_i_mode_bits (SCM modes); +SCM_INTERNAL void scm_i_dynwind_current_load_port (SCM port); #endif /* SCM_PORTS_H */ diff --git a/libguile/posix.c b/libguile/posix.c index 76dcd3d10..0bad2ee20 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 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 diff --git a/libguile/posix.h b/libguile/posix.h index 871bba850..34e1fc77f 100644 --- a/libguile/posix.h +++ b/libguile/posix.h @@ -3,7 +3,7 @@ #ifndef SCM_POSIX_H #define SCM_POSIX_H -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2006, 2008 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 @@ -84,7 +84,7 @@ SCM_API SCM scm_getpass (SCM prompt); SCM_API SCM scm_flock (SCM file, SCM operation); SCM_API SCM scm_sethostname (SCM name); SCM_API SCM scm_gethostname (void); -SCM_API void scm_init_posix (void); +SCM_INTERNAL void scm_init_posix (void); SCM_API scm_i_pthread_mutex_t scm_i_locale_mutex; diff --git a/libguile/print.h b/libguile/print.h index 740aa281f..8974a7554 100644 --- a/libguile/print.h +++ b/libguile/print.h @@ -3,7 +3,7 @@ #ifndef SCM_PRINT_H #define SCM_PRINT_H -/* Copyright (C) 1995,1996,1998,2000,2001, 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000,2001, 2003, 2004, 2006, 2008 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 @@ -75,7 +75,7 @@ SCM_API scm_t_bits scm_tc16_port_with_ps; SCM_API SCM scm_print_options (SCM setting); SCM_API SCM scm_make_print_state (void); SCM_API void scm_free_print_state (SCM print_state); -SCM scm_i_port_with_print_state (SCM port, SCM print_state); +SCM_INTERNAL SCM scm_i_port_with_print_state (SCM port, SCM print_state); SCM_API void scm_intprint (scm_t_intmax n, int radix, SCM port); SCM_API void scm_uintprint (scm_t_uintmax n, int radix, SCM port); SCM_API void scm_ipruk (char *hdr, SCM ptr, SCM port); @@ -92,7 +92,7 @@ SCM_API SCM scm_printer_apply (SCM proc, SCM exp, SCM port, scm_print_state *); SCM_API SCM scm_port_with_print_state (SCM port, SCM pstate); SCM_API SCM scm_get_print_state (SCM port); SCM_API int scm_valid_oport_value_p (SCM val); -SCM_API void scm_init_print (void); +SCM_INTERNAL void scm_init_print (void); #ifdef GUILE_DEBUG SCM_API SCM scm_current_pstate (void); diff --git a/libguile/private-gc.h b/libguile/private-gc.h index fe9b35505..00bef9d2e 100644 --- a/libguile/private-gc.h +++ b/libguile/private-gc.h @@ -1,7 +1,7 @@ /* * private-gc.h - private declarations for garbage collection. * - * Copyright (C) 2002, 03, 04, 05, 06, 07 Free Software Foundation, Inc. + * Copyright (C) 2002, 03, 04, 05, 06, 07, 08 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 @@ -32,18 +32,6 @@ * 64 bit machine. The units of the _SIZE parameters are bytes. * Cons pairs and object headers occupy one heap cell. * - * SCM_INIT_HEAP_SIZE is the initial size of heap. If this much heap is - * allocated initially the heap will grow by half its current size - * each subsequent time more heap is needed. - * - * If SCM_INIT_HEAP_SIZE heap cannot be allocated initially, SCM_HEAP_SEG_SIZE - * will be used, and the heap will grow by SCM_HEAP_SEG_SIZE when more - * heap is needed. SCM_HEAP_SEG_SIZE must fit into type size_t. This code - * is in scm_init_storage() and alloc_some_heap() in sys.c - * - * If SCM_INIT_HEAP_SIZE can be allocated initially, the heap will grow by - * SCM_EXPHEAP(scm_heap_size) when more heap is needed. - * * SCM_MIN_HEAP_SEG_SIZE is minimum size of heap to accept when more heap * is needed. */ @@ -66,6 +54,12 @@ #define SCM_DEFAULT_MIN_YIELD_1 40 #define SCM_DEFAULT_INIT_HEAP_SIZE_2 32*1024 +/* + How many cells to collect during one sweep call. This is the pool + size of each thread. + */ +#define DEFAULT_SWEEP_AMOUNT 512 + /* The following value may seem large, but note that if we get to GC at * all, this means that we have a numerically intensive application */ @@ -73,12 +67,9 @@ #define SCM_DEFAULT_MAX_SEGMENT_SIZE (20*1024*1024L) - - #define SCM_MIN_HEAP_SEG_SIZE (8 * SCM_GC_SIZEOF_CARD) #define SCM_HEAP_SEG_SIZE (16384L * sizeof (scm_t_cell)) - #define SCM_DOUBLECELL_ALIGNED_P(x) (((2 * sizeof (scm_t_cell) - 1) & SCM_UNPACK (x)) == 0) @@ -87,7 +78,6 @@ #define SCM_GC_IN_CARD_HEADERP(x) \ (scm_t_cell *) (x) < SCM_GC_CELL_CARD (x) + SCM_GC_CARD_N_HEADER_CELLS - int scm_getenv_int (const char *var, int def); @@ -113,15 +103,14 @@ typedef enum { return_on_error, abort_on_error } policy_on_error; gc-mark */ +/* this can be used to ensure that set/clear gc marks only happen when + allowed. */ +int scm_i_marking; void scm_mark_all (void); - -char const *scm_i_tag_name (scm_t_bits tag); /* MOVEME */ - - extern long int scm_i_deprecated_memory_return; - +extern long int scm_i_find_heap_calls; /* global init funcs. diff --git a/libguile/procprop.h b/libguile/procprop.h index dffdfd7bc..bf27dba0a 100644 --- a/libguile/procprop.h +++ b/libguile/procprop.h @@ -3,7 +3,7 @@ #ifndef SCM_PROCPROP_H #define SCM_PROCPROP_H -/* Copyright (C) 1995,1996,1998,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000, 2006, 2008 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 @@ -32,12 +32,12 @@ SCM_API SCM scm_sym_system_procedure; -SCM_API SCM scm_i_procedure_arity (SCM proc); +SCM_INTERNAL SCM scm_i_procedure_arity (SCM proc); SCM_API SCM scm_procedure_properties (SCM proc); SCM_API SCM scm_set_procedure_properties_x (SCM proc, SCM new_val); SCM_API SCM scm_procedure_property (SCM p, SCM k); SCM_API SCM scm_set_procedure_property_x (SCM p, SCM k, SCM v); -SCM_API void scm_init_procprop (void); +SCM_INTERNAL void scm_init_procprop (void); #endif /* SCM_PROCPROP_H */ diff --git a/libguile/procs.h b/libguile/procs.h index 74627254a..e8d69cb14 100644 --- a/libguile/procs.h +++ b/libguile/procs.h @@ -3,7 +3,7 @@ #ifndef SCM_PROCS_H #define SCM_PROCS_H -/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008 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 @@ -153,8 +153,8 @@ SCM_API SCM scm_procedure_with_setter_p (SCM obj); SCM_API SCM scm_make_procedure_with_setter (SCM procedure, SCM setter); SCM_API SCM scm_procedure (SCM proc); SCM_API SCM scm_setter (SCM proc); -SCM_API void scm_init_subr_table (void); -SCM_API void scm_init_procs (void); +SCM_INTERNAL void scm_init_subr_table (void); +SCM_INTERNAL void scm_init_procs (void); #ifdef GUILE_DEBUG SCM_API SCM scm_make_cclo (SCM proc, SCM len); diff --git a/libguile/properties.h b/libguile/properties.h index 3f8cb6d75..54feb01d9 100644 --- a/libguile/properties.h +++ b/libguile/properties.h @@ -3,7 +3,7 @@ #ifndef SCM_PROPERTIES_H #define SCM_PROPERTIES_H -/* Copyright (C) 1995,1996,1998,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000, 2006, 2008 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 @@ -29,7 +29,7 @@ SCM_API SCM scm_primitive_property_ref (SCM prop, SCM obj); SCM_API SCM scm_primitive_property_set_x (SCM prop, SCM obj, SCM val); SCM_API SCM scm_primitive_property_del_x (SCM prop, SCM obj); -SCM_API void scm_init_properties (void); +SCM_INTERNAL void scm_init_properties (void); #endif /* SCM_PROPERTIES_H */ diff --git a/libguile/ramap.h b/libguile/ramap.h index 8383649c9..9d870389a 100644 --- a/libguile/ramap.h +++ b/libguile/ramap.h @@ -3,7 +3,7 @@ #ifndef SCM_RAMAP_H #define SCM_RAMAP_H -/* Copyright (C) 1995,1996,1997,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,2000, 2006, 2008 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 @@ -47,7 +47,7 @@ SCM_API SCM scm_array_for_each (SCM proc, SCM ra0, SCM lra); SCM_API SCM scm_array_index_map_x (SCM ra, SCM proc); SCM_API SCM scm_raequal (SCM ra0, SCM ra1); SCM_API SCM scm_array_equal_p (SCM ra0, SCM ra1); -SCM_API void scm_init_ramap (void); +SCM_INTERNAL void scm_init_ramap (void); #endif /* SCM_RAMAP_H */ diff --git a/libguile/random.h b/libguile/random.h index 6ec43ff53..ae44092ab 100644 --- a/libguile/random.h +++ b/libguile/random.h @@ -3,7 +3,7 @@ #ifndef SCM_RANDOM_H #define SCM_RANDOM_H -/* Copyright (C) 1999,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1999,2000,2001, 2006, 2008 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 @@ -62,9 +62,9 @@ typedef struct scm_t_i_rstate { unsigned long c; } scm_t_i_rstate; -SCM_API unsigned long scm_i_uniform32 (scm_t_i_rstate *); -SCM_API void scm_i_init_rstate (scm_t_i_rstate *, const char *seed, int n); -SCM_API scm_t_i_rstate *scm_i_copy_rstate (scm_t_i_rstate *); +SCM_INTERNAL unsigned long scm_i_uniform32 (scm_t_i_rstate *); +SCM_INTERNAL void scm_i_init_rstate (scm_t_i_rstate *, const char *seed, int n); +SCM_INTERNAL scm_t_i_rstate *scm_i_copy_rstate (scm_t_i_rstate *); /* @@ -99,7 +99,7 @@ SCM_API SCM scm_random_hollow_sphere_x (SCM v, SCM state); SCM_API SCM scm_random_normal (SCM state); SCM_API SCM scm_random_normal_vector_x (SCM v, SCM state); SCM_API SCM scm_random_exp (SCM state); -SCM_API void scm_init_random (void); +SCM_INTERNAL void scm_init_random (void); #endif /* SCM_RANDOM_H */ diff --git a/libguile/rdelim.h b/libguile/rdelim.h index b211bb208..17efb4fe5 100644 --- a/libguile/rdelim.h +++ b/libguile/rdelim.h @@ -3,7 +3,7 @@ #ifndef SCM_RDELIM_H #define SCM_RDELIM_H -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006, 2008 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 @@ -30,7 +30,7 @@ SCM_API SCM scm_read_line (SCM port); SCM_API SCM scm_write_line (SCM obj, SCM port); SCM_API SCM scm_init_rdelim_builtins (void); -SCM_API void scm_init_rdelim (void); +SCM_INTERNAL void scm_init_rdelim (void); #endif /* SCM_RDELIM_H */ diff --git a/libguile/read.c b/libguile/read.c index 53715f2b5..47b80041e 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1999,2000,2001,2003, 2004, 2006, 2007 Free Software +/* Copyright (C) 1995,1996,1997,1999,2000,2001,2003, 2004, 2006, 2007, 2008 Free Software * Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -53,6 +53,7 @@ SCM_GLOBAL_SYMBOL (scm_sym_dot, "."); SCM_SYMBOL (scm_keyword_prefix, "prefix"); +SCM_SYMBOL (scm_keyword_postfix, "postfix"); scm_t_option scm_read_opts[] = { { SCM_OPTION_BOOLEAN, "copy", 0, @@ -62,7 +63,7 @@ scm_t_option scm_read_opts[] = { { SCM_OPTION_BOOLEAN, "case-insensitive", 0, "Convert symbols to lower case."}, { SCM_OPTION_SCM, "keywords", SCM_UNPACK (SCM_BOOL_F), - "Style of keyword recognition: #f or 'prefix."}, + "Style of keyword recognition: #f, 'prefix or 'postfix."}, #if SCM_ENABLE_ELISP { SCM_OPTION_BOOLEAN, "elisp-vectors", 0, "Support Elisp vector syntax, namely `[...]'."}, @@ -291,7 +292,7 @@ scm_read_sexp (int chr, SCM port) register int c; register SCM tmp; register SCM tl, ans = SCM_EOL; - SCM tl2 = SCM_EOL, ans2 = SCM_EOL, copy = SCM_BOOL_F;; + SCM tl2 = SCM_EOL, ans2 = SCM_EOL, copy = SCM_BOOL_F; static const int terminating_char = ')'; /* Need to capture line and column numbers here. */ @@ -531,15 +532,19 @@ static SCM scm_read_mixed_case_symbol (int chr, SCM port) { SCM result, str = SCM_EOL; - int overflow = 0; + int overflow = 0, ends_with_colon = 0; char buffer[READER_BUFFER_SIZE]; size_t read = 0; + int postfix = scm_is_eq (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_postfix); scm_ungetc (chr, port); do { overflow = read_token (port, buffer, sizeof (buffer), &read); + if (read > 0) + ends_with_colon = (buffer[read - 1] == ':'); + if ((overflow) || (scm_is_pair (str))) str = scm_cons (scm_from_locale_stringn (buffer, read), str); } @@ -549,12 +554,21 @@ scm_read_mixed_case_symbol (int chr, SCM port) { str = scm_string_concatenate (scm_reverse_x (str, SCM_EOL)); result = scm_string_to_symbol (str); + + /* Per SRFI-88, `:' alone is an identifier, not a keyword. */ + if (postfix && ends_with_colon && (scm_c_string_length (result) > 1)) + result = scm_symbol_to_keyword (result); } else - /* For symbols smaller than `sizeof (buffer)', we don't need to recur to - Scheme strings. Therefore, we only create one Scheme object (a - symbol) per symbol read. */ - result = scm_from_locale_symboln (buffer, read); + { + /* For symbols smaller than `sizeof (buffer)', we don't need to recur + to Scheme strings. Therefore, we only create one Scheme object (a + symbol) per symbol read. */ + if (postfix && ends_with_colon && (read > 1)) + result = scm_from_locale_keywordn (buffer, read - 1); + else + result = scm_from_locale_symboln (buffer, read); + } return result; } @@ -657,7 +671,7 @@ scm_read_quote (int chr, SCM port) default: fprintf (stderr, "%s: unhandled quote character (%i)\n", - __FUNCTION__, chr); + "scm_read_quote", chr); abort (); } @@ -772,7 +786,7 @@ scm_read_keyword (int chr, SCM port) XXX: This implementation allows sloppy syntaxes like `#: key'. */ symbol = scm_read_expression (port); if (!scm_is_symbol (symbol)) - scm_i_input_error (__FUNCTION__, port, + scm_i_input_error ("scm_read_keyword", port, "keyword prefix `~a' not followed by a symbol: ~s", scm_list_2 (SCM_MAKE_CHAR (chr), symbol)); diff --git a/libguile/read.h b/libguile/read.h index 128ba3d34..4253622da 100644 --- a/libguile/read.h +++ b/libguile/read.h @@ -3,7 +3,7 @@ #ifndef SCM_READ_H #define SCM_READ_H -/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000, 2006, 2008 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 @@ -56,11 +56,11 @@ SCM_API SCM scm_read (SCM port); SCM_API size_t scm_read_token (int ic, SCM * tok_buf, SCM port, int weird); SCM_API SCM scm_read_hash_extend (SCM chr, SCM proc); -SCM_API void scm_i_input_error (const char *func, SCM port, - const char *message, SCM arg) +SCM_INTERNAL void scm_i_input_error (const char *func, SCM port, + const char *message, SCM arg) SCM_NORETURN; -SCM_API void scm_init_read (void); +SCM_INTERNAL void scm_init_read (void); #endif /* SCM_READ_H */ diff --git a/libguile/regex-posix.h b/libguile/regex-posix.h index c3821362a..2863b0562 100644 --- a/libguile/regex-posix.h +++ b/libguile/regex-posix.h @@ -3,7 +3,7 @@ #ifndef SCM_REGEX_POSIX_H #define SCM_REGEX_POSIX_H -/* Copyright (C) 1997,1998,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1997,1998,2000,2001, 2006, 2008 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 @@ -31,7 +31,7 @@ SCM_API scm_t_bits scm_tc16_regex; SCM_API SCM scm_make_regexp (SCM pat, SCM flags); SCM_API SCM scm_regexp_p (SCM x); SCM_API SCM scm_regexp_exec (SCM rx, SCM str, SCM start, SCM flags); -SCM_API void scm_init_regex_posix (void); +SCM_INTERNAL void scm_init_regex_posix (void); #endif /* SCM_REGEX_POSIX_H */ diff --git a/libguile/root.h b/libguile/root.h index 21cd8a380..a8116c879 100644 --- a/libguile/root.h +++ b/libguile/root.h @@ -3,7 +3,7 @@ #ifndef SCM_ROOT_H #define SCM_ROOT_H -/* Copyright (C) 1996,1998,2000,2001, 2002, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1996,1998,2000,2001, 2002, 2006, 2008 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 @@ -53,7 +53,7 @@ SCM_API SCM scm_internal_cwdr (scm_t_catch_body body, SCM_API SCM scm_call_with_dynamic_root (SCM thunk, SCM handler); SCM_API SCM scm_dynamic_root (void); SCM_API SCM scm_apply_with_dynamic_root (SCM proc, SCM a1, SCM args, SCM handler); -SCM_API void scm_init_root (void); +SCM_INTERNAL void scm_init_root (void); #endif /* SCM_ROOT_H */ diff --git a/libguile/rw.h b/libguile/rw.h index 108104c33..b526051fc 100644 --- a/libguile/rw.h +++ b/libguile/rw.h @@ -3,7 +3,7 @@ #ifndef SCM_RW_H #define SCM_RW_H -/* Copyright (C) 2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2006, 2008 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 @@ -29,8 +29,8 @@ SCM_API SCM scm_read_string_x_partial (SCM str, SCM port_or_fdes, SCM start, SCM_API SCM scm_write_string_partial (SCM str, SCM port_or_fdes, SCM start, SCM end); -SCM_API SCM scm_init_rw_builtins (void); -SCM_API void scm_init_rw (void); +SCM_INTERNAL SCM scm_init_rw_builtins (void); +SCM_INTERNAL void scm_init_rw (void); #endif /* SCM_RW_H */ diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c index d05bdac67..3a8596a6d 100644 --- a/libguile/scmsigs.c +++ b/libguile/scmsigs.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2007, 2008 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 @@ -680,8 +680,10 @@ scm_i_close_signal_pipe() been launched at this point, it never will be before shutdown. */ scm_i_pthread_mutex_lock (&signal_delivery_thread_mutex); +#if SCM_USE_PTHREAD_THREADS if (scm_i_signal_delivery_thread != NULL) close (signal_pipe[1]); +#endif scm_i_pthread_mutex_unlock (&signal_delivery_thread_mutex); } diff --git a/libguile/scmsigs.h b/libguile/scmsigs.h index 2aced3a3c..bcbf825d4 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, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000, 2002, 2006, 2007, 2008 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 @@ -40,12 +40,12 @@ SCM_API SCM scm_pause (void); SCM_API SCM scm_sleep (SCM i); SCM_API SCM scm_usleep (SCM i); SCM_API SCM scm_raise (SCM sig); -SCM_API void scm_init_scmsigs (void); +SCM_INTERNAL 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_INTERNAL void scm_i_close_signal_pipe (void); +SCM_INTERNAL void scm_i_ensure_signal_delivery_thread (void); -SCM_API scm_i_thread *scm_i_signal_delivery_thread; +SCM_INTERNAL scm_i_thread *scm_i_signal_delivery_thread; #endif /* SCM_SCMSIGS_H */ diff --git a/libguile/script.c b/libguile/script.c index b024378c1..2e45d8756 100644 --- a/libguile/script.c +++ b/libguile/script.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 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 * License as published by the Free Software Foundation; either @@ -635,7 +635,7 @@ scm_compile_shell_switches (int argc, char **argv) { /* Print version number. */ printf ("Guile %s\n" - "Copyright (c) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation\n" + "Copyright (c) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation\n" "Guile may be distributed under the terms of the GNU General Public Licence;\n" "certain other uses are permitted as well. For details, see the file\n" "`COPYING', which is included in the Guile distribution.\n" diff --git a/libguile/script.h b/libguile/script.h index 37ebddebc..6c02f8d8d 100644 --- a/libguile/script.h +++ b/libguile/script.h @@ -3,7 +3,7 @@ #ifndef SCM_SCRIPT_H #define SCM_SCRIPT_H -/* Copyright (C) 1997,1998,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1997,1998,2000, 2006, 2008 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 @@ -36,7 +36,7 @@ SCM_API void scm_shell_usage (int fatal, char *message); SCM_API SCM scm_compile_shell_switches (int argc, char **argv); SCM_API void scm_shell (int argc, char **argv); SCM_API char *scm_usage_name; -SCM_API void scm_init_script (void); +SCM_INTERNAL void scm_init_script (void); #endif /* SCM_SCRIPT_H */ diff --git a/libguile/simpos.h b/libguile/simpos.h index 1ce207b1d..6df8bb1d2 100644 --- a/libguile/simpos.h +++ b/libguile/simpos.h @@ -3,7 +3,7 @@ #ifndef SCM_SIMPOS_H #define SCM_SIMPOS_H -/* Copyright (C) 1995,1996,1997,1998,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000, 2006, 2008 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 @@ -31,7 +31,7 @@ SCM_API SCM scm_system_star (SCM cmds); SCM_API SCM scm_getenv (SCM nam); SCM_API SCM scm_primitive_exit (SCM status); SCM_API SCM scm_primitive__exit (SCM status); -SCM_API void scm_init_simpos (void); +SCM_INTERNAL void scm_init_simpos (void); #endif /* SCM_SIMPOS_H */ diff --git a/libguile/socket.c b/libguile/socket.c index 1e839e0d1..bfac45207 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -36,6 +36,8 @@ #include "libguile/validate.h" #include "libguile/socket.h" +#include "libguile/iselect.h" + #ifdef __MINGW32__ #include "win32-socket.h" #endif @@ -1321,16 +1323,30 @@ SCM_DEFINE (scm_accept, "accept", 1, 0, 0, "connection and will continue to accept new requests.") #define FUNC_NAME s_scm_accept { - int fd; + int fd, selected; int newfd; SCM address; SCM newsock; + SELECT_TYPE readfds, exceptfds; socklen_t addr_size = MAX_ADDR_SIZE; scm_t_max_sockaddr addr; sock = SCM_COERCE_OUTPORT (sock); SCM_VALIDATE_OPFPORT (1, sock); fd = SCM_FPORT_FDES (sock); + + FD_ZERO (&readfds); + FD_ZERO (&exceptfds); + FD_SET (fd, &readfds); + FD_SET (fd, &exceptfds); + + /* Block until something happens on FD, leaving guile mode while + waiting. */ + selected = scm_std_select (fd + 1, &readfds, NULL, &exceptfds, + NULL); + if (selected < 0) + SCM_SYSERROR; + newfd = accept (fd, (struct sockaddr *) &addr, &addr_size); if (newfd == -1) SCM_SYSERROR; diff --git a/libguile/socket.h b/libguile/socket.h index 146d283dc..133dbf7c6 100644 --- a/libguile/socket.h +++ b/libguile/socket.h @@ -3,7 +3,7 @@ #ifndef SCM_SOCKET_H #define SCM_SOCKET_H -/* Copyright (C) 1995,1996,1997,2000,2001, 2004, 2005, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,2000,2001, 2004, 2005, 2006, 2008 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 @@ -52,7 +52,7 @@ SCM_API SCM scm_recv (SCM sockfd, SCM buff_or_size, SCM flags); SCM_API SCM scm_send (SCM sockfd, SCM message, SCM flags); SCM_API SCM scm_recvfrom (SCM sockfd, SCM buff_or_size, SCM flags, SCM offset, SCM length); SCM_API SCM scm_sendto (SCM sockfd, SCM message, SCM fam, SCM address, SCM args_and_flags); -SCM_API void scm_init_socket (void); +SCM_INTERNAL void scm_init_socket (void); /* Wrapping/unwrapping address objects. */ struct sockaddr; diff --git a/libguile/sort.h b/libguile/sort.h index b8bf4ce57..51f292a5c 100644 --- a/libguile/sort.h +++ b/libguile/sort.h @@ -3,7 +3,7 @@ #ifndef SCM_SORT_H #define SCM_SORT_H -/* Copyright (C) 1999,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1999,2000, 2006, 2008 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 @@ -39,7 +39,7 @@ SCM_API SCM scm_stable_sort (SCM ls, SCM less); SCM_API SCM scm_stable_sort_x (SCM ls, SCM less); SCM_API SCM scm_sort_list (SCM ls, SCM less); SCM_API SCM scm_sort_list_x (SCM ls, SCM less); -SCM_API void scm_init_sort (void); +SCM_INTERNAL void scm_init_sort (void); #endif /* SCM_SORT_H */ diff --git a/libguile/srcprop.c b/libguile/srcprop.c index e3691d4fb..ed3612781 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -85,6 +85,8 @@ SCM_GLOBAL_SYMBOL (scm_sym_breakpoint, "breakpoint"); #define SETSRCPROPPOS(p, l, c) (SCM_SET_CELL_WORD(p,1, SRCPROPMAKPOS (l, c))) #define SETSRCPROPLINE(p, l) SETSRCPROPPOS (p, l, SRCPROPCOL (p)) #define SETSRCPROPCOL(p, c) SETSRCPROPPOS (p, SRCPROPLINE (p), c) +#define SETSRCPROPCOPY(p, c) (SCM_SET_CELL_WORD(p, 2, c)) +#define SETSRCPROPPLIST(p, l) (SCM_SET_CELL_WORD(p, 3, l)) @@ -303,14 +305,14 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, else if (scm_is_eq (scm_sym_copy, key)) { if (SRCPROPSP (p)) - SRCPROPCOPY (p) = datum; + SETSRCPROPCOPY (p, datum); else SCM_WHASHSET (scm_source_whash, h, scm_make_srcprops (0, 0, SCM_UNDEFINED, datum, p)); } else { if (SRCPROPSP (p)) - SRCPROPPLIST (p) = scm_acons (key, datum, SRCPROPPLIST (p)); + SETSRCPROPPLIST (p, scm_acons (key, datum, SRCPROPPLIST (p))); else SCM_WHASHSET (scm_source_whash, h, scm_acons (key, datum, p)); } diff --git a/libguile/srcprop.h b/libguile/srcprop.h index 87e5fde0f..a467aa34e 100644 --- a/libguile/srcprop.h +++ b/libguile/srcprop.h @@ -3,7 +3,7 @@ #ifndef SCM_SRCPROP_H #define SCM_SRCPROP_H -/* Copyright (C) 1995,1996,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001, 2006, 2008 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 @@ -70,7 +70,7 @@ SCM_API SCM scm_set_source_property_x (SCM obj, SCM key, SCM datum); SCM_API SCM scm_source_properties (SCM obj); SCM_API SCM scm_set_source_properties_x (SCM obj, SCM props); SCM_API void scm_finish_srcprop (void); -SCM_API void scm_init_srcprop (void); +SCM_INTERNAL void scm_init_srcprop (void); #if SCM_ENABLE_DEPRECATED == 1 #define SRCBRKP(x) (scm_source_property_breakpoint_p (x)) diff --git a/libguile/srfi-13.h b/libguile/srfi-13.h index 833586adc..f8221ddc6 100644 --- a/libguile/srfi-13.h +++ b/libguile/srfi-13.h @@ -3,7 +3,7 @@ /* srfi-13.c --- SRFI-13 procedures for Guile * - * Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc. + * Copyright (C) 2001, 2004, 2006, 2008 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 @@ -113,7 +113,7 @@ SCM_API SCM scm_string_split (SCM s, SCM chr); SCM_API SCM scm_string_filter (SCM s, SCM char_pred, SCM start, SCM end); SCM_API SCM scm_string_delete (SCM s, SCM char_pred, SCM start, SCM end); -SCM_API void scm_init_srfi_13 (void); -SCM_API void scm_init_srfi_13_14 (void); +SCM_INTERNAL void scm_init_srfi_13 (void); +SCM_INTERNAL void scm_init_srfi_13_14 (void); #endif /* SCM_SRFI_13_H */ diff --git a/libguile/srfi-14.h b/libguile/srfi-14.h index 516c51044..ea8027aac 100644 --- a/libguile/srfi-14.h +++ b/libguile/srfi-14.h @@ -3,7 +3,7 @@ /* srfi-14.c --- SRFI-14 procedures for Guile * - * Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc. + * Copyright (C) 2001, 2004, 2006, 2008 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 @@ -106,7 +106,7 @@ SCM_API SCM scm_char_set_ascii; SCM_API SCM scm_char_set_empty; SCM_API SCM scm_char_set_full; -SCM_API void scm_srfi_14_compute_char_sets (void); -SCM_API void scm_init_srfi_14 (void); +SCM_INTERNAL void scm_srfi_14_compute_char_sets (void); +SCM_INTERNAL void scm_init_srfi_14 (void); #endif /* SCM_SRFI_14_H */ diff --git a/libguile/srfi-4.h b/libguile/srfi-4.h index 7abbac8a4..3c340d91e 100644 --- a/libguile/srfi-4.h +++ b/libguile/srfi-4.h @@ -2,7 +2,7 @@ #define SCM_SRFI_4_H /* srfi-4.c --- Homogeneous numeric vector datatypes. * - * Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc. + * Copyright (C) 2001, 2004, 2006, 2008 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 @@ -303,10 +303,10 @@ SCM_API double *scm_c64vector_writable_elements (SCM uvec, size_t *lenp, ssize_t *incp); -SCM_API SCM scm_i_generalized_vector_type (SCM vec); -SCM_API const char *scm_i_uniform_vector_tag (SCM uvec); -SCM_API scm_i_t_array_ref scm_i_uniform_vector_ref_proc (SCM uvec); -SCM_API scm_i_t_array_set scm_i_uniform_vector_set_proc (SCM uvec); +SCM_INTERNAL SCM scm_i_generalized_vector_type (SCM vec); +SCM_INTERNAL const char *scm_i_uniform_vector_tag (SCM uvec); +SCM_INTERNAL scm_i_t_array_ref scm_i_uniform_vector_ref_proc (SCM uvec); +SCM_INTERNAL scm_i_t_array_set scm_i_uniform_vector_set_proc (SCM uvec); #if SCM_ENABLE_DEPRECATED @@ -318,6 +318,6 @@ SCM_API size_t scm_uniform_element_size (SCM obj); #endif -SCM_API void scm_init_srfi_4 (void); +SCM_INTERNAL void scm_init_srfi_4 (void); #endif /* SCM_SRFI_4_H */ diff --git a/libguile/stackchk.h b/libguile/stackchk.h index 9a5c59f71..66582e929 100644 --- a/libguile/stackchk.h +++ b/libguile/stackchk.h @@ -3,7 +3,7 @@ #ifndef SCM_STACKCHK_H #define SCM_STACKCHK_H -/* Copyright (C) 1995,1996,1998,2000, 2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000, 2003, 2006, 2008 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 @@ -60,7 +60,7 @@ SCM_API int scm_stack_checking_enabled_p; SCM_API void scm_report_stack_overflow (void); SCM_API long scm_stack_size (SCM_STACKITEM *start); SCM_API void scm_stack_report (void); -SCM_API void scm_init_stackchk (void); +SCM_INTERNAL void scm_init_stackchk (void); #endif /* SCM_STACKCHK_H */ diff --git a/libguile/stacks.h b/libguile/stacks.h index e44bb1cdf..53633bc14 100644 --- a/libguile/stacks.h +++ b/libguile/stacks.h @@ -3,7 +3,7 @@ #ifndef SCM_STACKS_H #define SCM_STACKS_H -/* Copyright (C) 1995,1996,2000,2001, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001, 2004, 2006, 2008 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 @@ -106,7 +106,7 @@ SCM_API SCM scm_frame_procedure_p (SCM frame); SCM_API SCM scm_frame_evaluating_args_p (SCM frame); SCM_API SCM scm_frame_overflow_p (SCM frame); -SCM_API void scm_init_stacks (void); +SCM_INTERNAL void scm_init_stacks (void); #endif /* SCM_STACKS_H */ diff --git a/libguile/stime.c b/libguile/stime.c index 8487b91ca..be5bf65af 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2005, 2006, 2007, 2008 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 @@ -31,7 +31,6 @@ what it takes away, and decide from that whether to use it, instead of hard coding __hpux. */ -#define _GNU_SOURCE /* ask glibc for everything, in particular strptime */ #ifndef _REENTRANT # define _REENTRANT /* ask solaris for gmtime_r prototype */ #endif @@ -45,6 +44,7 @@ #include <stdio.h> #include <errno.h> +#include <strftime.h> #include "libguile/_scm.h" #include "libguile/async.h" @@ -690,10 +690,9 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0, tzset (); #endif - /* POSIX says strftime returns 0 on buffer overrun, but old - systems (i.e. libc 4 on GNU/Linux) might return `size' in that - case. */ - while ((len = strftime (tbuf, size, myfmt, &t)) == 0 || len == size) + /* Use `nstrftime ()' from Gnulib, which supports all GNU extensions + supported by glibc. */ + while ((len = nstrftime (tbuf, size, myfmt, &t, 0, 0)) == 0) { free (tbuf); size *= 2; diff --git a/libguile/stime.h b/libguile/stime.h index 52acc2f80..c64c60ea9 100644 --- a/libguile/stime.h +++ b/libguile/stime.h @@ -3,7 +3,7 @@ #ifndef SCM_STIME_H #define SCM_STIME_H -/* Copyright (C) 1995,1996,1997,1998,2000, 2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000, 2003, 2006, 2008 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 @@ -64,7 +64,7 @@ SCM_API SCM scm_tzset (void); SCM_API SCM scm_times (void); SCM_API SCM scm_strftime (SCM format, SCM stime); SCM_API SCM scm_strptime (SCM format, SCM string); -SCM_API void scm_init_stime (void); +SCM_INTERNAL void scm_init_stime (void); #endif /* SCM_STIME_H */ diff --git a/libguile/strings.c b/libguile/strings.c index 1684604df..90051bd1b 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1998,2000,2001, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000,2001, 2004, 2006, 2008 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 @@ -124,7 +124,7 @@ make_stringbuf (size_t len) /* Return a new stringbuf whose underlying storage consists of the LEN+1 octets pointed to by STR (the last octet is zero). */ -SCM_C_INLINE_KEYWORD SCM +SCM scm_i_take_stringbufn (char *str, size_t len) { scm_gc_register_collectable_memory (str, len + 1, "stringbuf"); @@ -452,6 +452,16 @@ scm_i_symbol_length (SCM sym) return STRINGBUF_LENGTH (SYMBOL_STRINGBUF (sym)); } +size_t +scm_c_symbol_length (SCM sym) +#define FUNC_NAME "scm_c_symbol_length" +{ + SCM_VALIDATE_SYMBOL (1, sym); + + return STRINGBUF_LENGTH (SYMBOL_STRINGBUF (sym)); +} +#undef FUNC_NAME + const char * scm_i_symbol_chars (SCM sym) { diff --git a/libguile/strings.h b/libguile/strings.h index f96457eb9..ca5f52cd2 100644 --- a/libguile/strings.h +++ b/libguile/strings.h @@ -3,7 +3,7 @@ #ifndef SCM_STRINGS_H #define SCM_STRINGS_H -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2004, 2005, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2004, 2005, 2006, 2008 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 @@ -90,6 +90,7 @@ SCM_API SCM scm_string_append (SCM args); SCM_API SCM scm_c_make_string (size_t len, SCM chr); SCM_API size_t scm_c_string_length (SCM str); +SCM_API size_t scm_c_symbol_length (SCM sym); SCM_API SCM scm_c_string_ref (SCM str, size_t pos); SCM_API void scm_c_string_set_x (SCM str, size_t pos, SCM chr); SCM_API SCM scm_c_substring (SCM str, size_t start, size_t end); @@ -110,47 +111,47 @@ SCM_API SCM scm_makfromstrs (int argc, char **argv); /* internal accessor functions. Arguments must be valid. */ -SCM_API SCM scm_i_make_string (size_t len, char **datap); -SCM_API SCM scm_i_substring (SCM str, size_t start, size_t end); -SCM_API SCM scm_i_substring_read_only (SCM str, size_t start, size_t end); -SCM_API SCM scm_i_substring_shared (SCM str, size_t start, size_t end); -SCM_API SCM scm_i_substring_copy (SCM str, size_t start, size_t end); -SCM_API size_t scm_i_string_length (SCM str); -SCM_API const char *scm_i_string_chars (SCM str); -SCM_API char *scm_i_string_writable_chars (SCM str); -SCM_API void scm_i_string_stop_writing (void); +SCM_INTERNAL SCM scm_i_make_string (size_t len, char **datap); +SCM_INTERNAL SCM scm_i_substring (SCM str, size_t start, size_t end); +SCM_INTERNAL SCM scm_i_substring_read_only (SCM str, size_t start, size_t end); +SCM_INTERNAL SCM scm_i_substring_shared (SCM str, size_t start, size_t end); +SCM_INTERNAL SCM scm_i_substring_copy (SCM str, size_t start, size_t end); +SCM_INTERNAL size_t scm_i_string_length (SCM str); +SCM_API /* FIXME: not internal */ const char *scm_i_string_chars (SCM str); +SCM_API /* FIXME: not internal */ char *scm_i_string_writable_chars (SCM str); +SCM_INTERNAL void scm_i_string_stop_writing (void); /* internal functions related to symbols. */ -SCM_API SCM scm_i_make_symbol (SCM name, scm_t_bits flags, - unsigned long hash, SCM props); -SCM_API SCM +SCM_INTERNAL SCM scm_i_make_symbol (SCM name, scm_t_bits flags, + unsigned long hash, SCM props); +SCM_INTERNAL SCM scm_i_c_make_symbol (const char *name, size_t len, scm_t_bits flags, unsigned long hash, SCM props); -SCM_API SCM +SCM_INTERNAL SCM scm_i_c_take_symbol (char *name, size_t len, scm_t_bits flags, unsigned long hash, SCM props); -SCM_API const char *scm_i_symbol_chars (SCM sym); -SCM_API size_t scm_i_symbol_length (SCM sym); -SCM_API SCM scm_i_symbol_substring (SCM sym, size_t start, size_t end); +SCM_INTERNAL const char *scm_i_symbol_chars (SCM sym); +SCM_INTERNAL size_t scm_i_symbol_length (SCM sym); +SCM_INTERNAL SCM scm_i_symbol_substring (SCM sym, size_t start, size_t end); /* internal GC functions. */ -SCM_API SCM scm_i_string_mark (SCM str); -SCM_API SCM scm_i_stringbuf_mark (SCM buf); -SCM_API SCM scm_i_symbol_mark (SCM buf); -SCM_API void scm_i_string_free (SCM str); -SCM_API void scm_i_stringbuf_free (SCM buf); -SCM_API void scm_i_symbol_free (SCM sym); +SCM_INTERNAL SCM scm_i_string_mark (SCM str); +SCM_INTERNAL SCM scm_i_stringbuf_mark (SCM buf); +SCM_INTERNAL SCM scm_i_symbol_mark (SCM buf); +SCM_INTERNAL void scm_i_string_free (SCM str); +SCM_INTERNAL void scm_i_stringbuf_free (SCM buf); +SCM_INTERNAL void scm_i_symbol_free (SCM sym); /* internal utility functions. */ -SCM_API char **scm_i_allocate_string_pointers (SCM list); -SCM_API void scm_i_free_string_pointers (char **pointers); -SCM_API void scm_i_get_substring_spec (size_t len, - SCM start, size_t *cstart, - SCM end, size_t *cend); -SCM_API SCM scm_i_take_stringbufn (char *str, size_t len); +SCM_INTERNAL char **scm_i_allocate_string_pointers (SCM list); +SCM_INTERNAL void scm_i_free_string_pointers (char **pointers); +SCM_INTERNAL void scm_i_get_substring_spec (size_t len, + SCM start, size_t *cstart, + SCM end, size_t *cend); +SCM_INTERNAL SCM scm_i_take_stringbufn (char *str, size_t len); /* deprecated stuff */ @@ -167,7 +168,7 @@ SCM_API size_t scm_i_deprecated_string_length (SCM str); #endif -SCM_API void scm_init_strings (void); +SCM_INTERNAL void scm_init_strings (void); #endif /* SCM_STRINGS_H */ diff --git a/libguile/strorder.h b/libguile/strorder.h index 51168e05f..17118634e 100644 --- a/libguile/strorder.h +++ b/libguile/strorder.h @@ -3,7 +3,7 @@ #ifndef SCM_STRORDER_H #define SCM_STRORDER_H -/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000, 2006, 2008 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 @@ -36,7 +36,7 @@ SCM_API SCM scm_string_ci_less_p (SCM s1, SCM s2); SCM_API SCM scm_string_ci_leq_p (SCM s1, SCM s2); SCM_API SCM scm_string_ci_gr_p (SCM s1, SCM s2); SCM_API SCM scm_string_ci_geq_p (SCM s1, SCM s2); -SCM_API void scm_init_strorder (void); +SCM_INTERNAL void scm_init_strorder (void); #endif /* SCM_STRORDER_H */ diff --git a/libguile/strports.h b/libguile/strports.h index 2ca5fb572..58ca71f57 100644 --- a/libguile/strports.h +++ b/libguile/strports.h @@ -3,7 +3,7 @@ #ifndef SCM_STRPORTS_H #define SCM_STRPORTS_H -/* Copyright (C) 1995,1996,2000,2001,2002, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001,2002, 2006, 2008 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 @@ -55,7 +55,7 @@ SCM_API SCM scm_c_eval_string (const char *expr); SCM_API SCM scm_c_eval_string_in_module (const char *expr, SCM module); SCM_API SCM scm_eval_string (SCM string); SCM_API SCM scm_eval_string_in_module (SCM string, SCM module); -SCM_API void scm_init_strports (void); +SCM_INTERNAL void scm_init_strports (void); #endif /* SCM_STRPORTS_H */ diff --git a/libguile/struct.c b/libguile/struct.c index a263f9667..e3afd51d7 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008 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 @@ -635,7 +635,11 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0, fields_desc = scm_i_symbol_chars (layout); layout_len = scm_i_symbol_length (layout); - n_fields = data[scm_struct_i_n_words]; + if (SCM_STRUCT_VTABLE_FLAGS (handle) & SCM_STRUCTF_LIGHT) + /* no extra words */ + n_fields = layout_len / 2; + else + n_fields = data[scm_struct_i_n_words]; SCM_ASSERT_RANGE(1, pos, p < n_fields); @@ -712,7 +716,11 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0, fields_desc = scm_i_symbol_chars (layout); layout_len = scm_i_symbol_length (layout); - n_fields = data[scm_struct_i_n_words]; + if (SCM_STRUCT_VTABLE_FLAGS (handle) & SCM_STRUCTF_LIGHT) + /* no extra words */ + n_fields = layout_len / 2; + else + n_fields = data[scm_struct_i_n_words]; SCM_ASSERT_RANGE (1, pos, p < n_fields); diff --git a/libguile/struct.h b/libguile/struct.h index 215f99331..cccf429ec 100644 --- a/libguile/struct.h +++ b/libguile/struct.h @@ -3,7 +3,7 @@ #ifndef SCM_STRUCT_H #define SCM_STRUCT_H -/* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007, 2008 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 @@ -90,7 +90,7 @@ SCM_API SCM scm_struct_vtable_p (SCM x); SCM_API SCM scm_make_struct (SCM vtable, SCM tail_array_size, SCM init); SCM_API SCM scm_make_vtable (SCM fields, SCM printer); SCM_API SCM scm_make_vtable_vtable (SCM extra_fields, SCM tail_array_size, SCM init); -SCM_API SCM scm_i_struct_equalp (SCM s1, SCM s2); +SCM_INTERNAL SCM scm_i_struct_equalp (SCM s1, SCM s2); SCM_API SCM scm_struct_ref (SCM handle, SCM pos); SCM_API SCM scm_struct_set_x (SCM handle, SCM pos, SCM val); SCM_API SCM scm_struct_vtable (SCM handle); @@ -101,7 +101,7 @@ SCM_API SCM scm_struct_vtable_name (SCM vtable); SCM_API SCM scm_set_struct_vtable_name_x (SCM vtable, SCM name); SCM_API void scm_print_struct (SCM exp, SCM port, scm_print_state *); SCM_API void scm_struct_prehistory (void); -SCM_API void scm_init_struct (void); +SCM_INTERNAL void scm_init_struct (void); #endif /* SCM_STRUCT_H */ diff --git a/libguile/symbols.h b/libguile/symbols.h index f70d65578..c2dc18363 100644 --- a/libguile/symbols.h +++ b/libguile/symbols.h @@ -3,7 +3,7 @@ #ifndef SCM_SYMBOLS_H #define SCM_SYMBOLS_H -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008 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 @@ -61,11 +61,11 @@ SCM_API SCM scm_take_locale_symboln (char *sym, size_t len); /* internal functions. */ -SCM_API unsigned long scm_i_hash_symbol (SCM obj, unsigned long n, +SCM_INTERNAL unsigned long scm_i_hash_symbol (SCM obj, unsigned long n, void *closure); -SCM_API void scm_symbols_prehistory (void); -SCM_API void scm_init_symbols (void); +SCM_INTERNAL void scm_symbols_prehistory (void); +SCM_INTERNAL void scm_init_symbols (void); #endif /* SCM_SYMBOLS_H */ diff --git a/libguile/tags.h b/libguile/tags.h index 3f5483f3c..4e0700b52 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -3,7 +3,7 @@ #ifndef SCM_TAGS_H #define SCM_TAGS_H -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004 +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -113,8 +113,14 @@ typedef unsigned long scm_t_bits; and that there is no performance hit. However, the alternative is compiled, and does generate a warning when used with the wrong pointer type. - */ + + The Tru64 and ia64-hp-hpux11.23 compilers fail on `case (0?0=0:x)' + statements, so for them type-checking is disabled. */ +#if defined __DECC || defined __HP_cc +# define SCM_UNPACK(x) ((scm_t_bits) (x)) +#else # define SCM_UNPACK(x) ((scm_t_bits) (0? (*(SCM*)0=(x)): x)) +#endif /* There is no typechecking on SCM_PACK, since all kinds of types diff --git a/libguile/threads.c b/libguile/threads.c index 02e6948b2..1ccfdca97 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -1,5 +1,5 @@ -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. - * +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 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 * License as published by the Free Software Foundation; either @@ -18,8 +18,6 @@ -#define _GNU_SOURCE - #include "libguile/boehm-gc.h" #include "libguile/_scm.h" @@ -50,6 +48,7 @@ #include "libguile/gc.h" #include "libguile/init.h" #include "libguile/scmsigs.h" +#include "libguile/strings.h" #ifdef __MINGW32__ #ifndef ETIMEDOUT @@ -60,6 +59,24 @@ # define pipe(fd) _pipe (fd, 256, O_BINARY) #endif /* __MINGW32__ */ +static void +to_timespec (SCM t, scm_t_timespec *waittime) +{ + if (scm_is_pair (t)) + { + waittime->tv_sec = scm_to_ulong (SCM_CAR (t)); + waittime->tv_nsec = scm_to_ulong (SCM_CDR (t)) * 1000; + } + else + { + double time = scm_to_double (t); + double sec = scm_c_truncate (time); + + waittime->tv_sec = (long) sec; + waittime->tv_nsec = (long) ((time - sec) * 1000000000); + } +} + /*** Queues */ /* Make an empty queue data structure. @@ -407,6 +424,7 @@ guilify_self_1 (SCM_STACKITEM *base) t->handle = SCM_BOOL_F; t->result = SCM_BOOL_F; t->cleanup_handler = SCM_BOOL_F; + t->mutexes = SCM_EOL; t->join_queue = SCM_EOL; t->dynamic_state = SCM_BOOL_F; t->dynwinds = SCM_EOL; @@ -415,6 +433,22 @@ guilify_self_1 (SCM_STACKITEM *base) t->pending_asyncs = 1; t->last_debug_frame = NULL; t->base = base; +#ifdef __ia64__ + /* Calculate and store off the base of this thread's register + backing store (RBS). Unfortunately our implementation(s) of + scm_ia64_register_backing_store_base are only reliable for the + main thread. For other threads, therefore, find out the current + top of the RBS, and use that as a maximum. */ + t->register_backing_store_base = scm_ia64_register_backing_store_base (); + { + ucontext_t ctx; + void *bsp; + getcontext (&ctx); + bsp = scm_ia64_ar_bsp (&ctx); + if (t->register_backing_store_base > bsp) + t->register_backing_store_base = bsp; + } +#endif t->continuation_root = SCM_EOL; t->continuation_base = base; scm_i_pthread_cond_init (&t->sleep_cond, NULL); @@ -424,6 +458,7 @@ guilify_self_1 (SCM_STACKITEM *base) /* XXX - check for errors. */ pipe (t->sleep_pipe); scm_i_pthread_mutex_init (&t->heap_mutex, NULL); + scm_i_pthread_mutex_init (&t->admin_mutex, NULL); t->clear_freelists_p = 0; t->gc_running_p = 0; t->current_mark_stack_ptr = NULL; @@ -468,6 +503,31 @@ guilify_self_2 (SCM parent) t->block_asyncs = 0; } + +/*** Fat mutexes */ + +/* We implement our own mutex type since we want them to be 'fair', we + want to do fancy things while waiting for them (like running + asyncs) and we might want to add things that are nice for + debugging. +*/ + +typedef struct { + scm_i_pthread_mutex_t lock; + SCM owner; + int level; /* how much the owner owns us. <= 1 for non-recursive mutexes */ + + int recursive; /* allow recursive locking? */ + int unchecked_unlock; /* is it an error to unlock an unlocked mutex? */ + int allow_external_unlock; /* is it an error to unlock a mutex that is not + owned by the current thread? */ + + SCM waiting; /* the threads waiting for this mutex. */ +} fat_mutex; + +#define SCM_MUTEXP(x) SCM_SMOB_PREDICATE (scm_tc16_mutex, x) +#define SCM_MUTEX_DATA(x) ((fat_mutex *) SCM_SMOB_DATA (x)) + /* Perform thread tear-down, in guile mode. */ static void * @@ -485,7 +545,7 @@ do_thread_exit (void *v) scm_handle_by_message_noexit, NULL); } - scm_i_scm_pthread_mutex_lock (&thread_admin_mutex); + scm_i_scm_pthread_mutex_lock (&t->admin_mutex); t->exited = 1; close (t->sleep_pipe[0]); @@ -493,7 +553,19 @@ do_thread_exit (void *v) while (scm_is_true (unblock_from_queue (t->join_queue))) ; - scm_i_pthread_mutex_unlock (&thread_admin_mutex); + while (!scm_is_null (t->mutexes)) + { + SCM mutex = SCM_CAR (t->mutexes); + fat_mutex *m = SCM_MUTEX_DATA (mutex); + scm_i_pthread_mutex_lock (&m->lock); + + unblock_from_queue (m->waiting); + + scm_i_pthread_mutex_unlock (&m->lock); + t->mutexes = SCM_CDR (t->mutexes); + } + + scm_i_pthread_mutex_unlock (&t->admin_mutex); return NULL; } @@ -605,7 +677,7 @@ scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM parent) { /* This thread is already guilified but not in guile mode, just resume it. - + XXX - base might be lower than when this thread was first guilified. */ @@ -713,7 +785,7 @@ scm_with_guile (void *(*func)(void *), void *data) scm_i_default_dynamic_state); } -static void +SCM_UNUSED static void scm_leave_guile_cleanup (void *x) { scm_leave_guile (); @@ -734,7 +806,7 @@ scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent) scm_i_pthread_cleanup_pop (0); scm_leave_guile (); } - else + else res = scm_c_with_continuation_barrier (func, data); return res; @@ -832,7 +904,7 @@ SCM_DEFINE (scm_call_with_new_thread, "call-with-new-thread", 1, 1, 0, } scm_i_scm_pthread_cond_wait (&data.cond, &data.mutex); scm_i_pthread_mutex_unlock (&data.mutex); - + return data.thread; } #undef FUNC_NAME @@ -909,7 +981,7 @@ scm_spawn_thread (scm_t_catch_body body, void *body_data, } scm_i_scm_pthread_cond_wait (&data.cond, &data.mutex); scm_i_pthread_mutex_unlock (&data.mutex); - + return data.thread; } @@ -933,15 +1005,15 @@ SCM_DEFINE (scm_cancel_thread, "cancel-thread", 1, 0, 0, SCM_VALIDATE_THREAD (1, thread); t = SCM_I_THREAD_DATA (thread); - scm_i_scm_pthread_mutex_lock (&thread_admin_mutex); + scm_i_scm_pthread_mutex_lock (&t->admin_mutex); if (!t->canceled) { t->canceled = 1; - scm_i_pthread_mutex_unlock (&thread_admin_mutex); + scm_i_pthread_mutex_unlock (&t->admin_mutex); scm_i_pthread_cancel (t->pthread); } else - scm_i_pthread_mutex_unlock (&thread_admin_mutex); + scm_i_pthread_mutex_unlock (&t->admin_mutex); return SCM_UNSPECIFIED; } @@ -959,13 +1031,13 @@ SCM_DEFINE (scm_set_thread_cleanup_x, "set-thread-cleanup!", 2, 0, 0, if (!scm_is_false (proc)) SCM_VALIDATE_THUNK (2, proc); - scm_i_pthread_mutex_lock (&thread_admin_mutex); - t = SCM_I_THREAD_DATA (thread); + scm_i_pthread_mutex_lock (&t->admin_mutex); + if (!(t->exited || t->canceled)) t->cleanup_handler = proc; - scm_i_pthread_mutex_unlock (&thread_admin_mutex); + scm_i_pthread_mutex_unlock (&t->admin_mutex); return SCM_UNSPECIFIED; } @@ -981,71 +1053,85 @@ SCM_DEFINE (scm_thread_cleanup, "thread-cleanup", 1, 0, 0, SCM_VALIDATE_THREAD (1, thread); - scm_i_pthread_mutex_lock (&thread_admin_mutex); t = SCM_I_THREAD_DATA (thread); + scm_i_pthread_mutex_lock (&t->admin_mutex); ret = (t->exited || t->canceled) ? SCM_BOOL_F : t->cleanup_handler; - scm_i_pthread_mutex_unlock (&thread_admin_mutex); + scm_i_pthread_mutex_unlock (&t->admin_mutex); return ret; } #undef FUNC_NAME -SCM_DEFINE (scm_join_thread, "join-thread", 1, 0, 0, - (SCM thread), +SCM scm_join_thread (SCM thread) +{ + return scm_join_thread_timed (thread, SCM_UNDEFINED, SCM_UNDEFINED); +} + +SCM_DEFINE (scm_join_thread_timed, "join-thread", 1, 2, 0, + (SCM thread, SCM timeout, SCM timeoutval), "Suspend execution of the calling thread until the target @var{thread} " "terminates, unless the target @var{thread} has already terminated. ") -#define FUNC_NAME s_scm_join_thread +#define FUNC_NAME s_scm_join_thread_timed { scm_i_thread *t; - SCM res; + scm_t_timespec ctimeout, *timeout_ptr = NULL; + SCM res = SCM_BOOL_F; + + if (! (SCM_UNBNDP (timeoutval))) + res = timeoutval; SCM_VALIDATE_THREAD (1, thread); if (scm_is_eq (scm_current_thread (), thread)) SCM_MISC_ERROR ("cannot join the current thread", SCM_EOL); - scm_i_scm_pthread_mutex_lock (&thread_admin_mutex); - t = SCM_I_THREAD_DATA (thread); - if (!t->exited) + scm_i_scm_pthread_mutex_lock (&t->admin_mutex); + + if (! SCM_UNBNDP (timeout)) + { + to_timespec (timeout, &ctimeout); + timeout_ptr = &ctimeout; + } + + if (t->exited) + res = t->result; + else { while (1) { - block_self (t->join_queue, thread, &thread_admin_mutex, NULL); - if (t->exited) + int err = block_self (t->join_queue, thread, &t->admin_mutex, + timeout_ptr); + if (err == 0) + { + if (t->exited) + { + res = t->result; + break; + } + } + else if (err == ETIMEDOUT) break; - scm_i_pthread_mutex_unlock (&thread_admin_mutex); + + scm_i_pthread_mutex_unlock (&t->admin_mutex); SCM_TICK; - scm_i_scm_pthread_mutex_lock (&thread_admin_mutex); + scm_i_scm_pthread_mutex_lock (&t->admin_mutex); } } - res = t->result; - scm_i_pthread_mutex_unlock (&thread_admin_mutex); + scm_i_pthread_mutex_unlock (&t->admin_mutex); return res; } #undef FUNC_NAME - - -/*** Fat mutexes */ - -/* We implement our own mutex type since we want them to be 'fair', we - want to do fancy things while waiting for them (like running - asyncs) and we might want to add things that are nice for - debugging. -*/ - -typedef struct { - scm_i_pthread_mutex_t lock; - SCM owner; - int level; /* how much the owner owns us. - < 0 for non-recursive mutexes */ - SCM waiting; /* the threads waiting for this mutex. */ -} fat_mutex; - -#define SCM_MUTEXP(x) SCM_SMOB_PREDICATE (scm_tc16_mutex, x) -#define SCM_MUTEX_DATA(x) ((fat_mutex *) SCM_SMOB_DATA (x)) +SCM_DEFINE (scm_thread_p, "thread?", 1, 0, 0, + (SCM obj), + "Return @code{#t} if @var{obj} is a thread.") +#define FUNC_NAME s_scm_thread_p +{ + return SCM_I_IS_THREAD(obj) ? SCM_BOOL_T : SCM_BOOL_F; +} +#undef FUNC_NAME static size_t @@ -1068,7 +1154,7 @@ fat_mutex_print (SCM mx, SCM port, scm_print_state *pstate SCM_UNUSED) } static SCM -make_fat_mutex (int recursive) +make_fat_mutex (int recursive, int unchecked_unlock, int external_unlock) { fat_mutex *m; SCM mx; @@ -1076,19 +1162,49 @@ make_fat_mutex (int recursive) m = scm_gc_malloc (sizeof (fat_mutex), "mutex"); scm_i_pthread_mutex_init (&m->lock, NULL); m->owner = SCM_BOOL_F; - m->level = recursive? 0 : -1; + m->level = 0; + + m->recursive = recursive; + m->unchecked_unlock = unchecked_unlock; + m->allow_external_unlock = external_unlock; + m->waiting = SCM_EOL; SCM_NEWSMOB (mx, scm_tc16_mutex, (scm_t_bits) m); m->waiting = make_queue (); return mx; } -SCM_DEFINE (scm_make_mutex, "make-mutex", 0, 0, 0, - (void), +SCM scm_make_mutex (void) +{ + return scm_make_mutex_with_flags (SCM_EOL); +} + +SCM_SYMBOL (unchecked_unlock_sym, "unchecked-unlock"); +SCM_SYMBOL (allow_external_unlock_sym, "allow-external-unlock"); +SCM_SYMBOL (recursive_sym, "recursive"); + +SCM_DEFINE (scm_make_mutex_with_flags, "make-mutex", 0, 0, 1, + (SCM flags), "Create a new mutex. ") -#define FUNC_NAME s_scm_make_mutex +#define FUNC_NAME s_scm_make_mutex_with_flags { - return make_fat_mutex (0); + int unchecked_unlock = 0, external_unlock = 0, recursive = 0; + + SCM ptr = flags; + while (! scm_is_null (ptr)) + { + SCM flag = SCM_CAR (ptr); + if (scm_is_eq (flag, unchecked_unlock_sym)) + unchecked_unlock = 1; + else if (scm_is_eq (flag, allow_external_unlock_sym)) + external_unlock = 1; + else if (scm_is_eq (flag, recursive_sym)) + recursive = 1; + else + SCM_MISC_ERROR ("unsupported mutex option: ~a", scm_list_1 (flag)); + ptr = SCM_CDR (ptr); + } + return make_fat_mutex (recursive, unchecked_unlock, external_unlock); } #undef FUNC_NAME @@ -1097,59 +1213,119 @@ SCM_DEFINE (scm_make_recursive_mutex, "make-recursive-mutex", 0, 0, 0, "Create a new recursive mutex. ") #define FUNC_NAME s_scm_make_recursive_mutex { - return make_fat_mutex (1); + return make_fat_mutex (1, 0, 0); } #undef FUNC_NAME -static char * -fat_mutex_lock (SCM mutex) +SCM_SYMBOL (scm_abandoned_mutex_error_key, "abandoned-mutex-error"); + +static SCM +fat_mutex_lock (SCM mutex, scm_t_timespec *timeout, SCM owner, int *ret) { fat_mutex *m = SCM_MUTEX_DATA (mutex); - SCM thread = scm_current_thread (); - char *msg = NULL; + + SCM new_owner = SCM_UNBNDP (owner) ? scm_current_thread() : owner; + SCM err = SCM_BOOL_F; + + struct timeval current_time; scm_i_scm_pthread_mutex_lock (&m->lock); - if (scm_is_false (m->owner)) - m->owner = thread; - else if (scm_is_eq (m->owner, thread)) + + while (1) { - if (m->level >= 0) - m->level++; + if (m->level == 0) + { + m->owner = new_owner; + m->level++; + + if (SCM_I_IS_THREAD (new_owner)) + { + scm_i_thread *t = SCM_I_THREAD_DATA (new_owner); + scm_i_pthread_mutex_lock (&t->admin_mutex); + t->mutexes = scm_cons (mutex, t->mutexes); + scm_i_pthread_mutex_unlock (&t->admin_mutex); + } + *ret = 1; + break; + } + else if (SCM_I_IS_THREAD (m->owner) && scm_c_thread_exited_p (m->owner)) + { + m->owner = new_owner; + err = scm_cons (scm_abandoned_mutex_error_key, + scm_from_locale_string ("lock obtained on abandoned " + "mutex")); + *ret = 1; + break; + } + else if (scm_is_eq (m->owner, new_owner)) + { + if (m->recursive) + { + m->level++; + *ret = 1; + } + else + { + err = scm_cons (scm_misc_error_key, + scm_from_locale_string ("mutex already locked " + "by thread")); + *ret = 0; + } + break; + } else - msg = "mutex already locked by current thread"; - } - else - { - while (1) { - block_self (m->waiting, mutex, &m->lock, NULL); - if (scm_is_eq (m->owner, thread)) - break; + if (timeout != NULL) + { + gettimeofday (¤t_time, NULL); + if (current_time.tv_sec > timeout->tv_sec || + (current_time.tv_sec == timeout->tv_sec && + current_time.tv_usec * 1000 > timeout->tv_nsec)) + { + *ret = 0; + break; + } + } + block_self (m->waiting, mutex, &m->lock, timeout); scm_i_pthread_mutex_unlock (&m->lock); SCM_TICK; scm_i_scm_pthread_mutex_lock (&m->lock); } } scm_i_pthread_mutex_unlock (&m->lock); - return msg; + return err; } -SCM_DEFINE (scm_lock_mutex, "lock-mutex", 1, 0, 0, - (SCM mx), +SCM scm_lock_mutex (SCM mx) +{ + return scm_lock_mutex_timed (mx, SCM_UNDEFINED, SCM_UNDEFINED); +} + +SCM_DEFINE (scm_lock_mutex_timed, "lock-mutex", 1, 2, 0, + (SCM m, SCM timeout, SCM owner), "Lock @var{mutex}. If the mutex is already locked, the calling thread " "blocks until the mutex becomes available. The function returns when " "the calling thread owns the lock on @var{mutex}. Locking a mutex that " "a thread already owns will succeed right away and will not block the " "thread. That is, Guile's mutexes are @emph{recursive}. ") -#define FUNC_NAME s_scm_lock_mutex +#define FUNC_NAME s_scm_lock_mutex_timed { - char *msg; + SCM exception; + int ret = 0; + scm_t_timespec cwaittime, *waittime = NULL; - SCM_VALIDATE_MUTEX (1, mx); - msg = fat_mutex_lock (mx); - if (msg) - scm_misc_error (NULL, msg, SCM_EOL); - return SCM_BOOL_T; + SCM_VALIDATE_MUTEX (1, m); + + if (! SCM_UNBNDP (timeout) && ! scm_is_false (timeout)) + { + to_timespec (timeout, &cwaittime); + waittime = &cwaittime; + } + + exception = fat_mutex_lock (m, waittime, owner, &ret); + if (!scm_is_false (exception)) + scm_ithrow (SCM_CAR (exception), scm_list_1 (SCM_CDR (exception)), 1); + return ret ? SCM_BOOL_T : SCM_BOOL_F; } #undef FUNC_NAME @@ -1162,71 +1338,144 @@ scm_dynwind_lock_mutex (SCM mutex) SCM_F_WIND_EXPLICITLY); } -static char * -fat_mutex_trylock (fat_mutex *m, int *resp) -{ - char *msg = NULL; - SCM thread = scm_current_thread (); - - *resp = 1; - scm_i_pthread_mutex_lock (&m->lock); - if (scm_is_false (m->owner)) - m->owner = thread; - else if (scm_is_eq (m->owner, thread)) - { - if (m->level >= 0) - m->level++; - else - msg = "mutex already locked by current thread"; - } - else - *resp = 0; - scm_i_pthread_mutex_unlock (&m->lock); - return msg; -} - SCM_DEFINE (scm_try_mutex, "try-mutex", 1, 0, 0, (SCM mutex), "Try to lock @var{mutex}. If the mutex is already locked by someone " "else, return @code{#f}. Else lock the mutex and return @code{#t}. ") #define FUNC_NAME s_scm_try_mutex { - char *msg; - int res; + SCM exception; + int ret = 0; + scm_t_timespec cwaittime, *waittime = NULL; SCM_VALIDATE_MUTEX (1, mutex); - - msg = fat_mutex_trylock (SCM_MUTEX_DATA (mutex), &res); - if (msg) - scm_misc_error (NULL, msg, SCM_EOL); - return scm_from_bool (res); + + to_timespec (scm_from_int(0), &cwaittime); + waittime = &cwaittime; + + exception = fat_mutex_lock (mutex, waittime, SCM_UNDEFINED, &ret); + if (!scm_is_false (exception)) + scm_ithrow (SCM_CAR (exception), scm_list_1 (SCM_CDR (exception)), 1); + return ret ? SCM_BOOL_T : SCM_BOOL_F; } #undef FUNC_NAME -static char * -fat_mutex_unlock (fat_mutex *m) +/*** Fat condition variables */ + +typedef struct { + scm_i_pthread_mutex_t lock; + SCM waiting; /* the threads waiting for this condition. */ +} fat_cond; + +#define SCM_CONDVARP(x) SCM_SMOB_PREDICATE (scm_tc16_condvar, x) +#define SCM_CONDVAR_DATA(x) ((fat_cond *) SCM_SMOB_DATA (x)) + +static int +fat_mutex_unlock (SCM mutex, SCM cond, + const scm_t_timespec *waittime, int relock) { - char *msg = NULL; + fat_mutex *m = SCM_MUTEX_DATA (mutex); + fat_cond *c = NULL; + scm_i_thread *t = SCM_I_CURRENT_THREAD; + int err = 0, ret = 0; scm_i_scm_pthread_mutex_lock (&m->lock); - if (!scm_is_eq (m->owner, scm_current_thread ())) + + SCM owner = m->owner; + + if (!scm_is_eq (owner, scm_current_thread ())) { - if (scm_is_false (m->owner)) - msg = "mutex not locked"; - else - msg = "mutex not locked by current thread"; + if (m->level == 0) + { + if (!m->unchecked_unlock) + { + scm_i_pthread_mutex_unlock (&m->lock); + scm_misc_error (NULL, "mutex not locked", SCM_EOL); + } + owner = scm_current_thread (); + } + else if (!m->allow_external_unlock) + { + scm_i_pthread_mutex_unlock (&m->lock); + scm_misc_error (NULL, "mutex not locked by current thread", SCM_EOL); + } + } + + if (! (SCM_UNBNDP (cond))) + { + c = SCM_CONDVAR_DATA (cond); + while (1) + { + int brk = 0; + + scm_i_scm_pthread_mutex_lock (&c->lock); + if (m->level > 0) + m->level--; + if (m->level == 0) + m->owner = unblock_from_queue (m->waiting); + + scm_i_pthread_mutex_unlock (&m->lock); + + t->block_asyncs++; + + err = block_self (c->waiting, cond, &c->lock, waittime); + + if (err == 0) + { + ret = 1; + brk = 1; + } + else if (err == ETIMEDOUT) + { + ret = 0; + brk = 1; + } + else if (err != EINTR) + { + errno = err; + scm_i_pthread_mutex_unlock (&c->lock); + scm_syserror (NULL); + } + + if (brk) + { + if (relock) + scm_lock_mutex_timed (mutex, SCM_UNDEFINED, owner); + scm_i_pthread_mutex_unlock (&c->lock); + break; + } + + scm_i_pthread_mutex_unlock (&c->lock); + + t->block_asyncs--; + scm_async_click (); + + scm_remember_upto_here_2 (cond, mutex); + + scm_i_scm_pthread_mutex_lock (&m->lock); + } } - else if (m->level > 0) - m->level--; else - m->owner = unblock_from_queue (m->waiting); - scm_i_pthread_mutex_unlock (&m->lock); + { + if (m->level > 0) + m->level--; + if (m->level == 0) + m->owner = unblock_from_queue (m->waiting); + + scm_i_pthread_mutex_unlock (&m->lock); + ret = 1; + } - return msg; + return ret; } -SCM_DEFINE (scm_unlock_mutex, "unlock-mutex", 1, 0, 0, - (SCM mx), +SCM scm_unlock_mutex (SCM mx) +{ + return scm_unlock_mutex_timed (mx, SCM_UNDEFINED, SCM_UNDEFINED); +} + +SCM_DEFINE (scm_unlock_mutex_timed, "unlock-mutex", 1, 2, 0, + (SCM mx, SCM cond, SCM timeout), "Unlocks @var{mutex} if the calling thread owns the lock on " "@var{mutex}. Calling unlock-mutex on a mutex not owned by the current " "thread results in undefined behaviour. Once a mutex has been unlocked, " @@ -1234,34 +1483,56 @@ SCM_DEFINE (scm_unlock_mutex, "unlock-mutex", 1, 0, 0, "lock. Every call to @code{lock-mutex} by this thread must be matched " "with a call to @code{unlock-mutex}. Only the last call to " "@code{unlock-mutex} will actually unlock the mutex. ") -#define FUNC_NAME s_scm_unlock_mutex +#define FUNC_NAME s_scm_unlock_mutex_timed { - char *msg; + scm_t_timespec cwaittime, *waittime = NULL; + SCM_VALIDATE_MUTEX (1, mx); - - msg = fat_mutex_unlock (SCM_MUTEX_DATA (mx)); - if (msg) - scm_misc_error (NULL, msg, SCM_EOL); - return SCM_BOOL_T; + if (! (SCM_UNBNDP (cond))) + { + SCM_VALIDATE_CONDVAR (2, cond); + + if (! (SCM_UNBNDP (timeout))) + { + to_timespec (timeout, &cwaittime); + waittime = &cwaittime; + } + } + + return fat_mutex_unlock (mx, cond, waittime, 0) ? SCM_BOOL_T : SCM_BOOL_F; } #undef FUNC_NAME -#if 0 +SCM_DEFINE (scm_mutex_p, "mutex?", 1, 0, 0, + (SCM obj), + "Return @code{#t} if @var{obj} is a mutex.") +#define FUNC_NAME s_scm_mutex_p +{ + return SCM_MUTEXP (obj) ? SCM_BOOL_T : SCM_BOOL_F; +} +#undef FUNC_NAME SCM_DEFINE (scm_mutex_owner, "mutex-owner", 1, 0, 0, (SCM mx), "Return the thread owning @var{mx}, or @code{#f}.") #define FUNC_NAME s_scm_mutex_owner { + SCM owner; + fat_mutex *m = NULL; + SCM_VALIDATE_MUTEX (1, mx); - return (SCM_MUTEX_DATA(mx))->owner; + m = SCM_MUTEX_DATA (mx); + scm_i_pthread_mutex_lock (&m->lock); + owner = m->owner; + scm_i_pthread_mutex_unlock (&m->lock); + + return owner; } #undef FUNC_NAME SCM_DEFINE (scm_mutex_level, "mutex-level", 1, 0, 0, (SCM mx), - "Return the lock level of a recursive mutex, or -1\n" - "for a standard mutex.") + "Return the lock level of mutex @var{mx}.") #define FUNC_NAME s_scm_mutex_level { SCM_VALIDATE_MUTEX (1, mx); @@ -1269,17 +1540,15 @@ SCM_DEFINE (scm_mutex_level, "mutex-level", 1, 0, 0, } #undef FUNC_NAME -#endif - -/*** Fat condition variables */ - -typedef struct { - scm_i_pthread_mutex_t lock; - SCM waiting; /* the threads waiting for this condition. */ -} fat_cond; - -#define SCM_CONDVARP(x) SCM_SMOB_PREDICATE (scm_tc16_condvar, x) -#define SCM_CONDVAR_DATA(x) ((fat_cond *) SCM_SMOB_DATA (x)) +SCM_DEFINE (scm_mutex_locked_p, "mutex-locked?", 1, 0, 0, + (SCM mx), + "Returns @code{#t} if the mutex @var{mx} is locked.") +#define FUNC_NAME s_scm_mutex_locked_p +{ + SCM_VALIDATE_MUTEX (1, mx); + return SCM_MUTEX_DATA (mx)->level > 0 ? SCM_BOOL_T : SCM_BOOL_F; +} +#undef FUNC_NAME static size_t fat_cond_free (SCM mx) @@ -1317,49 +1586,6 @@ SCM_DEFINE (scm_make_condition_variable, "make-condition-variable", 0, 0, 0, } #undef FUNC_NAME -static int -fat_cond_timedwait (SCM cond, SCM mutex, - const scm_t_timespec *waittime) -{ - scm_i_thread *t = SCM_I_CURRENT_THREAD; - fat_cond *c = SCM_CONDVAR_DATA (cond); - fat_mutex *m = SCM_MUTEX_DATA (mutex); - const char *msg; - int err = 0; - - while (1) - { - scm_i_scm_pthread_mutex_lock (&c->lock); - msg = fat_mutex_unlock (m); - t->block_asyncs++; - if (msg == NULL) - { - err = block_self (c->waiting, cond, &c->lock, waittime); - scm_i_pthread_mutex_unlock (&c->lock); - fat_mutex_lock (mutex); - } - else - scm_i_pthread_mutex_unlock (&c->lock); - t->block_asyncs--; - scm_async_click (); - - if (msg) - scm_misc_error (NULL, msg, SCM_EOL); - - scm_remember_upto_here_2 (cond, mutex); - - if (err == 0) - return 1; - if (err == ETIMEDOUT) - return 0; - if (err != EINTR) - { - errno = err; - scm_syserror (NULL); - } - } -} - SCM_DEFINE (scm_timed_wait_condition_variable, "wait-condition-variable", 2, 1, 0, (SCM cv, SCM mx, SCM t), "Wait until @var{cond-var} has been signalled. While waiting, " @@ -1377,23 +1603,14 @@ SCM_DEFINE (scm_timed_wait_condition_variable, "wait-condition-variable", 2, 1, SCM_VALIDATE_CONDVAR (1, cv); SCM_VALIDATE_MUTEX (2, mx); - + if (!SCM_UNBNDP (t)) { - if (scm_is_pair (t)) - { - waittime.tv_sec = scm_to_ulong (SCM_CAR (t)); - waittime.tv_nsec = scm_to_ulong (SCM_CAR (t)) * 1000; - } - else - { - waittime.tv_sec = scm_to_ulong (t); - waittime.tv_nsec = 0; - } + to_timespec (t, &waittime); waitptr = &waittime; } - return scm_from_bool (fat_cond_timedwait (cv, mx, waitptr)); + return fat_mutex_unlock (mx, cv, waitptr, 1) ? SCM_BOOL_T : SCM_BOOL_F; } #undef FUNC_NAME @@ -1436,6 +1653,15 @@ SCM_DEFINE (scm_broadcast_condition_variable, "broadcast-condition-variable", 1, } #undef FUNC_NAME +SCM_DEFINE (scm_condition_variable_p, "condition-variable?", 1, 0, 0, + (SCM obj), + "Return @code{#t} if @var{obj} is a condition variable.") +#define FUNC_NAME s_scm_condition_variable_p +{ + return SCM_CONDVARP(obj) ? SCM_BOOL_T : SCM_BOOL_F; +} +#undef FUNC_NAME + /*** Marking stacks */ /* XXX - what to do with this? Do we need to handle this for blocked @@ -1449,7 +1675,7 @@ SCM_DEFINE (scm_broadcast_condition_variable, "broadcast-condition-variable", 1, scm_mark_locations ((SCM_STACKITEM *) &ctx.uc_mcontext, \ ((size_t) (sizeof (SCM_STACKITEM) - 1 + sizeof ctx.uc_mcontext) \ / sizeof (SCM_STACKITEM))); \ - bot = (SCM_STACKITEM *) scm_ia64_register_backing_store_base (); \ + bot = (SCM_STACKITEM *) SCM_I_CURRENT_THREAD->register_backing_store_base; \ top = (SCM_STACKITEM *) scm_ia64_ar_bsp (&ctx); \ scm_mark_locations (bot, top - bot); } while (0) #else @@ -1660,7 +1886,7 @@ scm_i_thread_put_to_sleep () scm_leave_guile (); scm_i_pthread_mutex_lock (&thread_admin_mutex); - /* Signal all threads to go to sleep + /* Signal all threads to go to sleep */ scm_i_thread_go_to_sleep = 1; for (t = all_threads; t; t = t->next_thread) @@ -1743,7 +1969,7 @@ scm_threads_prehistory (SCM_STACKITEM *base) scm_i_pthread_cond_init (&wake_up_cond, NULL); scm_i_pthread_key_create (&scm_i_freelist, NULL); scm_i_pthread_key_create (&scm_i_freelist2, NULL); - + guilify_self_1 (base); } diff --git a/libguile/threads.h b/libguile/threads.h index 834f38525..00fca92e4 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, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008 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 @@ -28,6 +28,7 @@ #include "libguile/root.h" #include "libguile/iselect.h" #include "libguile/dynwind.h" +#include "libguile/continuations.h" #if SCM_USE_PTHREAD_THREADS #include "libguile/pthread-threads.h" @@ -52,6 +53,10 @@ typedef struct scm_i_thread { SCM cleanup_handler; SCM join_queue; + + scm_i_pthread_mutex_t admin_mutex; + SCM mutexes; + SCM result; int canceled; int exited; @@ -62,7 +67,7 @@ typedef struct scm_i_thread { int sleep_fd, sleep_pipe[2]; /* This mutex represents this threads right to access the heap. - That right can temporarily be taken away by the GC. + That right can temporarily be taken away by the GC. */ scm_i_pthread_mutex_t heap_mutex; @@ -89,7 +94,7 @@ typedef struct scm_i_thread { */ SCM active_asyncs; /* The thunks to be run at the next safe point */ - unsigned int block_asyncs; /* Non-zero means that asyncs should + unsigned int block_asyncs; /* Non-zero means that asyncs should not be run. */ unsigned int pending_asyncs; /* Non-zero means that asyncs might be pending. */ @@ -114,6 +119,10 @@ typedef struct scm_i_thread { SCM_STACKITEM *base; SCM_STACKITEM *top; jmp_buf regs; +#ifdef __ia64__ + void *register_backing_store_base; + scm_t_contregs *pending_rbs_continuation; +#endif } scm_i_thread; @@ -133,23 +142,23 @@ SCM_API SCM scm_spawn_thread (scm_t_catch_body body, void *body_data, SCM_API void *scm_without_guile (void *(*func)(void *), void *data); SCM_API void *scm_with_guile (void *(*func)(void *), void *data); -SCM_API void *scm_i_with_guile_and_parent (void *(*func)(void *), void *data, - SCM parent); +SCM_INTERNAL void *scm_i_with_guile_and_parent (void *(*func)(void *), + void *data, SCM parent); extern int scm_i_thread_go_to_sleep; -void scm_i_thread_put_to_sleep (void); -void scm_i_thread_wake_up (void); -void scm_i_thread_invalidate_freelists (void); +SCM_INTERNAL void scm_i_thread_put_to_sleep (void); +SCM_INTERNAL void scm_i_thread_wake_up (void); +SCM_INTERNAL void scm_i_thread_invalidate_freelists (void); void scm_i_thread_sleep_for_gc (void); void scm_threads_prehistory (SCM_STACKITEM *); void scm_threads_init_first_thread (void); -SCM_API void scm_init_threads (void); -SCM_API void scm_init_thread_procs (void); -SCM_API void scm_init_threads_default_dynamic_state (void); +SCM_INTERNAL void scm_init_threads (void); +SCM_INTERNAL void scm_init_thread_procs (void); +SCM_INTERNAL void scm_init_threads_default_dynamic_state (void); #define SCM_THREAD_SWITCHING_CODE \ @@ -164,13 +173,22 @@ 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_join_thread_timed (SCM t, SCM timeout, SCM timeoutval); +SCM_API SCM scm_thread_p (SCM t); SCM_API SCM scm_make_mutex (void); SCM_API SCM scm_make_recursive_mutex (void); +SCM_API SCM scm_make_mutex_with_flags (SCM flags); SCM_API SCM scm_lock_mutex (SCM m); +SCM_API SCM scm_lock_mutex_timed (SCM m, SCM timeout, SCM owner); SCM_API void scm_dynwind_lock_mutex (SCM mutex); SCM_API SCM scm_try_mutex (SCM m); SCM_API SCM scm_unlock_mutex (SCM m); +SCM_API SCM scm_unlock_mutex_timed (SCM m, SCM cond, SCM timeout); +SCM_API SCM scm_mutex_p (SCM o); +SCM_API SCM scm_mutex_locked_p (SCM m); +SCM_API SCM scm_mutex_owner (SCM m); +SCM_API SCM scm_mutex_level (SCM m); SCM_API SCM scm_make_condition_variable (void); SCM_API SCM scm_wait_condition_variable (SCM cond, SCM mutex); @@ -178,6 +196,7 @@ SCM_API SCM scm_timed_wait_condition_variable (SCM cond, SCM mutex, SCM abstime); SCM_API SCM scm_signal_condition_variable (SCM cond); SCM_API SCM scm_broadcast_condition_variable (SCM cond); +SCM_API SCM scm_condition_variable_p (SCM o); SCM_API SCM scm_current_thread (void); SCM_API SCM scm_all_threads (void); @@ -197,7 +216,7 @@ SCM_API scm_i_pthread_key_t scm_i_thread_key; #define scm_i_set_last_debug_frame(f) \ (SCM_I_CURRENT_THREAD->last_debug_frame = (f)) -SCM_API scm_i_pthread_mutex_t scm_i_misc_mutex; +SCM_INTERNAL scm_i_pthread_mutex_t scm_i_misc_mutex; /* Convenience functions for working with the pthread API in guile mode. diff --git a/libguile/throw.c b/libguile/throw.c index 02503c36a..f605af7ae 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008 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 @@ -75,13 +75,9 @@ static SCM make_jmpbuf (void) { SCM answer; - SCM_CRITICAL_SECTION_START; - { - SCM_NEWSMOB2 (answer, tc16_jmpbuffer, 0, 0); - SETJBJMPBUF(answer, (jmp_buf *)0); - DEACTIVATEJB(answer); - } - SCM_CRITICAL_SECTION_END; + SCM_NEWSMOB2 (answer, tc16_jmpbuffer, 0, 0); + SETJBJMPBUF(answer, (jmp_buf *)0); + DEACTIVATEJB(answer); return answer; } @@ -856,6 +852,12 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED) /* Otherwise, it's some random piece of junk. */ else abort (); + +#ifdef __ia64__ + /* On IA64, we #define longjmp as setcontext, and GCC appears not to + know that that doesn't return. */ + return SCM_UNSPECIFIED; +#endif } diff --git a/libguile/throw.h b/libguile/throw.h index 84b0aa9e4..3cd557285 100644 --- a/libguile/throw.h +++ b/libguile/throw.h @@ -3,7 +3,7 @@ #ifndef SCM_THROW_H #define SCM_THROW_H -/* Copyright (C) 1995,1996,1998,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000, 2006, 2008 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 @@ -94,7 +94,7 @@ SCM_API SCM scm_lazy_catch (SCM tag, SCM thunk, SCM handler); SCM_API SCM scm_ithrow (SCM key, SCM args, int noreturn); SCM_API SCM scm_throw (SCM key, SCM args); -SCM_API void scm_init_throw (void); +SCM_INTERNAL void scm_init_throw (void); #endif /* SCM_THROW_H */ diff --git a/libguile/unif.h b/libguile/unif.h index 1ce3a8fa1..a09bfc921 100644 --- a/libguile/unif.h +++ b/libguile/unif.h @@ -3,7 +3,7 @@ #ifndef SCM_UNIF_H #define SCM_UNIF_H -/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008 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 @@ -162,9 +162,9 @@ SCM_API scm_t_bits scm_i_tc16_enclosed_array; #define SCM_I_ARRAY_DIMS(a) \ ((scm_t_array_dim *)((char *) SCM_I_ARRAY_MEM (a) + sizeof (scm_i_t_array))) -SCM_API SCM scm_i_make_ra (int ndim, int enclosed); -SCM_API SCM scm_i_cvref (SCM v, size_t p, int enclosed); -SCM_API SCM scm_i_read_array (SCM port, int c); +SCM_INTERNAL SCM scm_i_make_ra (int ndim, int enclosed); +SCM_INTERNAL SCM scm_i_cvref (SCM v, size_t p, int enclosed); +SCM_INTERNAL SCM scm_i_read_array (SCM port, int c); /* deprecated. */ @@ -183,7 +183,7 @@ SCM_API int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate); #endif -SCM_API void scm_init_unif (void); +SCM_INTERNAL void scm_init_unif (void); #endif /* SCM_UNIF_H */ diff --git a/libguile/validate.h b/libguile/validate.h index e23e83ad8..365db3693 100644 --- a/libguile/validate.h +++ b/libguile/validate.h @@ -3,7 +3,7 @@ #ifndef SCM_VALIDATE_H #define SCM_VALIDATE_H -/* Copyright (C) 1999,2000,2001, 2002, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1999,2000,2001, 2002, 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 @@ -99,8 +99,10 @@ #define SCM_OUT_OF_RANGE(pos, arg) \ do { scm_out_of_range_pos (FUNC_NAME, arg, scm_from_int (pos)); } while (0) -#define SCM_ASSERT_RANGE(pos, arg, f) \ - do { if (!(f)) scm_out_of_range_pos (FUNC_NAME, arg, scm_from_int (pos)); } while (0) +#define SCM_ASSERT_RANGE(pos, arg, f) \ + do { if (SCM_UNLIKELY (!(f))) \ + scm_out_of_range_pos (FUNC_NAME, arg, scm_from_int (pos)); } \ + while (0) #define SCM_MUST_MALLOC_TYPE(type) \ ((type *) scm_must_malloc (sizeof (type), FUNC_NAME)) diff --git a/libguile/values.h b/libguile/values.h index bc603c16b..f05ce9f8f 100644 --- a/libguile/values.h +++ b/libguile/values.h @@ -3,7 +3,7 @@ #ifndef SCM_VALUES_H #define SCM_VALUES_H -/* Copyright (C) 2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2000,2001, 2006, 2008 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 @@ -30,7 +30,7 @@ SCM_API SCM scm_values_vtable; && scm_is_eq (scm_struct_vtable (x), scm_values_vtable)) SCM_API SCM scm_values (SCM args); -SCM_API void scm_init_values (void); +SCM_INTERNAL void scm_init_values (void); #endif /* SCM_VALUES_H */ diff --git a/libguile/variable.h b/libguile/variable.h index 2f2e1a5c9..3f6398b9c 100644 --- a/libguile/variable.h +++ b/libguile/variable.h @@ -3,7 +3,7 @@ #ifndef SCM_VARIABLE_H #define SCM_VARIABLE_H -/* Copyright (C) 1995,1996,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001, 2006, 2008 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 @@ -43,9 +43,9 @@ SCM_API SCM scm_variable_ref (SCM var); SCM_API SCM scm_variable_set_x (SCM var, SCM val); SCM_API SCM scm_variable_bound_p (SCM var); -SCM_API void scm_i_variable_print (SCM var, SCM port, scm_print_state *pstate); +SCM_INTERNAL void scm_i_variable_print (SCM var, SCM port, scm_print_state *pstate); -SCM_API void scm_init_variable (void); +SCM_INTERNAL void scm_init_variable (void); #endif /* SCM_VARIABLE_H */ diff --git a/libguile/vectors.h b/libguile/vectors.h index db43a86d0..7a508c77b 100644 --- a/libguile/vectors.h +++ b/libguile/vectors.h @@ -3,7 +3,7 @@ #ifndef SCM_VECTORS_H #define SCM_VECTORS_H -/* Copyright (C) 1995,1996,1998,2000,2001,2002,2004,2005, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000,2001,2002,2004,2005, 2006, 2008 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 @@ -82,8 +82,8 @@ SCM_API void scm_generalized_vector_get_handle (SCM vec, #define SCM_I_VECTOR_WELTS(x) ((SCM *) SCM_CELL_WORD_1 (x)) #define SCM_I_VECTOR_LENGTH(x) (((size_t) SCM_CELL_WORD_0 (x)) >> 8) -SCM_API void scm_i_vector_free (SCM vec); -SCM_API SCM scm_i_vector_equal_p (SCM x, SCM y); +SCM_INTERNAL void scm_i_vector_free (SCM vec); +SCM_INTERNAL SCM scm_i_vector_equal_p (SCM x, SCM y); /* Weak vectors share implementation details with ordinary vectors, but no one else should. @@ -99,10 +99,10 @@ SCM_API SCM scm_i_vector_equal_p (SCM x, SCM y); #define SCM_I_WVECT_GC_CHAIN(x) (SCM_CELL_OBJECT_3 (x)) #define SCM_I_SET_WVECT_GC_CHAIN(x, o) (SCM_SET_CELL_OBJECT_3 ((x), (o))) -SCM_API SCM scm_i_make_weak_vector (scm_t_bits type, SCM size, SCM fill); -SCM_API SCM scm_i_make_weak_vector_from_list (scm_t_bits type, SCM lst); +SCM_INTERNAL SCM scm_i_make_weak_vector (scm_t_bits type, SCM size, SCM fill); +SCM_INTERNAL SCM scm_i_make_weak_vector_from_list (scm_t_bits type, SCM lst); -SCM_API void scm_init_vectors (void); +SCM_INTERNAL void scm_init_vectors (void); #endif /* SCM_VECTORS_H */ diff --git a/libguile/version.h.in b/libguile/version.h.in index 1d8f27750..b565efd96 100644 --- a/libguile/version.h.in +++ b/libguile/version.h.in @@ -3,7 +3,7 @@ #ifndef SCM_VERSION_H #define SCM_VERSION_H -/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008 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 @@ -35,7 +35,7 @@ SCM_API SCM scm_minor_version (void); SCM_API SCM scm_micro_version (void); SCM_API SCM scm_effective_version (void); SCM_API SCM scm_version (void); -SCM_API void scm_init_version (void); +SCM_INTERNAL void scm_init_version (void); #endif /* SCM_VERSION_H */ diff --git a/libguile/vports.h b/libguile/vports.h index c25f90f45..365303bc1 100644 --- a/libguile/vports.h +++ b/libguile/vports.h @@ -3,7 +3,7 @@ #ifndef SCM_VPORTS_H #define SCM_VPORTS_H -/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000, 2006, 2008 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 @@ -27,7 +27,7 @@ SCM_API SCM scm_make_soft_port (SCM pv, SCM modes); -SCM_API void scm_init_vports (void); +SCM_INTERNAL void scm_init_vports (void); #endif /* SCM_VPORTS_H */ diff --git a/libguile/weaks.c b/libguile/weaks.c index 5883dec1f..6d69f9718 100644 --- a/libguile/weaks.c +++ b/libguile/weaks.c @@ -1,43 +1,19 @@ -/* Copyright (C) 1995,1996,1998,2000,2001, 2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000,2001, 2003, 2006, 2008 Free Software Foundation, Inc. * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301 USA - * - * As a special exception, Free Software Foundation gives permission - * for additional uses of the text contained in its release of this library. + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. * - * The exception is that, if you link this library with other files - * to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking this library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by - * Free Software Foundation as part of this library. If you copy - * code from other releases distributed under the terms of the GPL into a copy of - * this library, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from such code. + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. * - * If you write modifications of your own for this library, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. */ + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + */ diff --git a/libguile/weaks.h b/libguile/weaks.h index de6ed9a1d..81c17749f 100644 --- a/libguile/weaks.h +++ b/libguile/weaks.h @@ -3,7 +3,7 @@ #ifndef SCM_WEAKS_H #define SCM_WEAKS_H -/* Copyright (C) 1995,1996,2000,2001, 2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001, 2003, 2006, 2008 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 @@ -90,14 +90,14 @@ SCM_API SCM scm_make_doubly_weak_alist_vector (SCM k); SCM_API SCM scm_weak_key_alist_vector_p (SCM x); SCM_API SCM scm_weak_value_alist_vector_p (SCM x); SCM_API SCM scm_doubly_weak_alist_vector_p (SCM x); -SCM_API SCM scm_init_weaks_builtins (void); -SCM_API void scm_weaks_prehistory (void); -SCM_API void scm_init_weaks (void); - -SCM_API void scm_i_init_weak_vectors_for_gc (void); -SCM_API void scm_i_mark_weak_vector (SCM w); -SCM_API int scm_i_mark_weak_vectors_non_weaks (void); -SCM_API void scm_i_remove_weaks_from_weak_vectors (void); +SCM_INTERNAL SCM scm_init_weaks_builtins (void); +SCM_INTERNAL void scm_weaks_prehistory (void); +SCM_INTERNAL void scm_init_weaks (void); + +SCM_INTERNAL void scm_i_init_weak_vectors_for_gc (void); +SCM_INTERNAL void scm_i_mark_weak_vector (SCM w); +SCM_INTERNAL int scm_i_mark_weak_vectors_non_weaks (void); +SCM_INTERNAL void scm_i_remove_weaks_from_weak_vectors (void); #endif /* SCM_WEAKS_H */ diff --git a/m4/.cvsignore b/m4/.cvsignore new file mode 100644 index 000000000..50f1b259d --- /dev/null +++ b/m4/.cvsignore @@ -0,0 +1,22 @@ +.deps +.dirstamp +alloca.m4 +extensions.m4 +gnulib-common.m4 +gnulib-comp.m4 +gnulib-tool.m4 +include_next.m4 +onceonly_2_57.m4 +strcase.m4 +string_h.m4 +strings_h.m4 +onceonly.m4 +mbstate_t.m4 +stdbool.m4 +strftime.m4 +time_h.m4 +time_r.m4 +tm_gmtoff.m4 +wchar.m4 +count-one-bits.m4 +inline.m4 diff --git a/m4/ChangeLog b/m4/ChangeLog index 769634bdb..fff185b7d 100644 --- a/m4/ChangeLog +++ b/m4/ChangeLog @@ -1,3 +1,17 @@ +2008-01-30 Ludovic Courtès <ludo@gnu.org> + + * gnulib-cache.m4 (gl_MODULES): Add `extensions' explicitly + since we rely on it, e.g., for `srfi-14.c'. + +2008-01-18 Neil Jerram <neil@ossau.uklinux.net> + + * gnulib-cache.m4: Recent gnulib adds gl_PO_BASE and gl_PO_DOMAIN + lines to this file. + +2007-10-24 Neil Jerram <neil@ossau.uklinux.net> + + * .cvsignore: Commit to CVS. + 2007-07-29 Ludovic Courtès <ludo@gnu.org> * gnulib-cache.m4: New file. diff --git a/m4/alloca.m4 b/m4/alloca.m4 new file mode 100644 index 000000000..95f54a6d4 --- /dev/null +++ b/m4/alloca.m4 @@ -0,0 +1,46 @@ +# alloca.m4 serial 8 +dnl Copyright (C) 2002-2004, 2006, 2007 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_FUNC_ALLOCA], +[ + dnl Work around a bug of AC_EGREP_CPP in autoconf-2.57. + AC_REQUIRE([AC_PROG_CPP]) + AC_REQUIRE([AC_PROG_EGREP]) + + AC_REQUIRE([AC_FUNC_ALLOCA]) + if test $ac_cv_func_alloca_works = no; then + gl_PREREQ_ALLOCA + fi + + # Define an additional variable used in the Makefile substitution. + if test $ac_cv_working_alloca_h = yes; then + AC_CACHE_CHECK([for alloca as a compiler built-in], [gl_cv_rpl_alloca], [ + AC_EGREP_CPP([Need own alloca], [ +#if defined __GNUC__ || defined _AIX || defined _MSC_VER + Need own alloca +#endif + ], [gl_cv_rpl_alloca=yes], [gl_cv_rpl_alloca=no]) + ]) + if test $gl_cv_rpl_alloca = yes; then + dnl OK, alloca can be implemented through a compiler built-in. + AC_DEFINE([HAVE_ALLOCA], 1, + [Define to 1 if you have 'alloca' after including <alloca.h>, + a header that may be supplied by this distribution.]) + ALLOCA_H=alloca.h + else + dnl alloca exists as a library function, i.e. it is slow and probably + dnl a memory leak. Don't define HAVE_ALLOCA in this case. + ALLOCA_H= + fi + else + ALLOCA_H=alloca.h + fi + AC_SUBST([ALLOCA_H]) +]) + +# Prerequisites of lib/alloca.c. +# STACK_DIRECTION is already handled by AC_FUNC_ALLOCA. +AC_DEFUN([gl_PREREQ_ALLOCA], [:]) diff --git a/m4/count-one-bits.m4 b/m4/count-one-bits.m4 new file mode 100644 index 000000000..8d1410a57 --- /dev/null +++ b/m4/count-one-bits.m4 @@ -0,0 +1,12 @@ +# count-one-bits.m4 serial 1 +dnl Copyright (C) 2007 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_COUNT_ONE_BITS], +[ + dnl We don't need (and can't compile) count_one_bits_ll + dnl unless the type 'unsigned long long int' exists. + AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT]) +]) diff --git a/m4/extensions.m4 b/m4/extensions.m4 new file mode 100644 index 000000000..917af9480 --- /dev/null +++ b/m4/extensions.m4 @@ -0,0 +1,82 @@ +# serial 5 -*- Autoconf -*- +# Enable extensions on systems that normally disable them. + +# Copyright (C) 2003, 2006-2008 Free Software Foundation, Inc. +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This definition of AC_USE_SYSTEM_EXTENSIONS is stolen from CVS +# Autoconf. Perhaps we can remove this once we can assume Autoconf +# 2.62 or later everywhere, but since CVS Autoconf mutates rapidly +# enough in this area it's likely we'll need to redefine +# AC_USE_SYSTEM_EXTENSIONS for quite some time. + +# AC_USE_SYSTEM_EXTENSIONS +# ------------------------ +# Enable extensions on systems that normally disable them, +# typically due to standards-conformance issues. +# Remember that #undef in AH_VERBATIM gets replaced with #define by +# AC_DEFINE. The goal here is to define all known feature-enabling +# macros, then, if reports of conflicts are made, disable macros that +# cause problems on some platforms (such as __EXTENSIONS__). +AC_DEFUN([AC_USE_SYSTEM_EXTENSIONS], +[AC_BEFORE([$0], [AC_COMPILE_IFELSE])dnl +AC_BEFORE([$0], [AC_RUN_IFELSE])dnl + + AC_CHECK_HEADER([minix/config.h], [MINIX=yes], [MINIX=]) + if test "$MINIX" = yes; then + AC_DEFINE([_POSIX_SOURCE], [1], + [Define to 1 if you need to in order for `stat' and other + things to work.]) + AC_DEFINE([_POSIX_1_SOURCE], [2], + [Define to 2 if the system does not provide POSIX.1 features + except with this defined.]) + AC_DEFINE([_MINIX], [1], + [Define to 1 if on MINIX.]) + fi + + AH_VERBATIM([__EXTENSIONS__], +[/* Enable extensions on AIX 3, Interix. */ +#ifndef _ALL_SOURCE +# undef _ALL_SOURCE +#endif +/* Enable GNU extensions on systems that have them. */ +#ifndef _GNU_SOURCE +# undef _GNU_SOURCE +#endif +/* Enable threading extensions on Solaris. */ +#ifndef _POSIX_PTHREAD_SEMANTICS +# undef _POSIX_PTHREAD_SEMANTICS +#endif +/* Enable extensions on HP NonStop. */ +#ifndef _TANDEM_SOURCE +# undef _TANDEM_SOURCE +#endif +/* Enable general extensions on Solaris. */ +#ifndef __EXTENSIONS__ +# undef __EXTENSIONS__ +#endif +]) + AC_CACHE_CHECK([whether it is safe to define __EXTENSIONS__], + [ac_cv_safe_to_define___extensions__], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[ +# define __EXTENSIONS__ 1 + ]AC_INCLUDES_DEFAULT])], + [ac_cv_safe_to_define___extensions__=yes], + [ac_cv_safe_to_define___extensions__=no])]) + test $ac_cv_safe_to_define___extensions__ = yes && + AC_DEFINE([__EXTENSIONS__]) + AC_DEFINE([_ALL_SOURCE]) + AC_DEFINE([_GNU_SOURCE]) + AC_DEFINE([_POSIX_PTHREAD_SEMANTICS]) + AC_DEFINE([_TANDEM_SOURCE]) +])# AC_USE_SYSTEM_EXTENSIONS + +# gl_USE_SYSTEM_EXTENSIONS +# ------------------------ +# Enable extensions on systems that normally disable them, +# typically due to standards-conformance issues. +AC_DEFUN([gl_USE_SYSTEM_EXTENSIONS], + [AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])]) diff --git a/m4/gnulib-cache.m4 b/m4/gnulib-cache.m4 index d921e6729..1c0308109 100644 --- a/m4/gnulib-cache.m4 +++ b/m4/gnulib-cache.m4 @@ -1,4 +1,4 @@ -# Copyright (C) 2004-2007 Free Software Foundation, Inc. +# Copyright (C) 2002-2008 Free Software Foundation, Inc. # # This file is free software, distributed under the terms of the GNU # General Public License. As a special exception to the GNU General @@ -15,14 +15,21 @@ # Specification in the form of a command-line invocation: -# gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --aux-dir=build-aux --lgpl --libtool --macro-prefix=gl alloca strcase +# gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --aux-dir=build-aux --lgpl --libtool --macro-prefix=gl alloca count-one-bits extensions strcase strftime # Specification in the form of a few gnulib-tool.m4 macro invocations: gl_LOCAL_DIR([]) -gl_MODULES([alloca strcase]) +gl_MODULES([ + alloca + count-one-bits + extensions + strcase + strftime +]) gl_AVOID([]) gl_SOURCE_BASE([lib]) gl_M4_BASE([m4]) +gl_PO_BASE([]) gl_DOC_BASE([doc]) gl_TESTS_BASE([tests]) gl_LIB([libgnu]) @@ -30,3 +37,4 @@ gl_LGPL gl_MAKEFILE_NAME([]) gl_LIBTOOL gl_MACRO_PREFIX([gl]) +gl_PO_DOMAIN([]) diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 new file mode 100644 index 000000000..34d91c728 --- /dev/null +++ b/m4/gnulib-common.m4 @@ -0,0 +1,91 @@ +# gnulib-common.m4 serial 5 +dnl Copyright (C) 2007-2008 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +# gl_COMMON +# is expanded unconditionally through gnulib-tool magic. +AC_DEFUN([gl_COMMON], [ + dnl Use AC_REQUIRE here, so that the code is expanded once only. + AC_REQUIRE([gl_COMMON_BODY]) +]) +AC_DEFUN([gl_COMMON_BODY], [ + AH_VERBATIM([isoc99_inline], +[/* Work around a bug in Apple GCC 4.0.1 build 5465: In C99 mode, it supports + the ISO C 99 semantics of 'extern inline' (unlike the GNU C semantics of + earlier versions), but does not display it by setting __GNUC_STDC_INLINE__. + __APPLE__ && __MACH__ test for MacOS X. + __APPLE_CC__ tests for the Apple compiler and its version. + __STDC_VERSION__ tests for the C99 mode. */ +#if defined __APPLE__ && defined __MACH__ && __APPLE_CC__ >= 5465 && !defined __cplusplus && __STDC_VERSION__ >= 199901L && !defined __GNUC_STDC_INLINE__ +# define __GNUC_STDC_INLINE__ 1 +#endif]) +]) + +# gl_MODULE_INDICATOR([modulename]) +# defines a C macro indicating the presence of the given module. +AC_DEFUN([gl_MODULE_INDICATOR], +[ + AC_DEFINE([GNULIB_]translit([$1],[abcdefghijklmnopqrstuvwxyz./-],[ABCDEFGHIJKLMNOPQRSTUVWXYZ___]), [1], + [Define to 1 when using the gnulib module ]$1[.]) +]) + +# m4_foreach_w +# is a backport of autoconf-2.59c's m4_foreach_w. +# Remove this macro when we can assume autoconf >= 2.60. +m4_ifndef([m4_foreach_w], + [m4_define([m4_foreach_w], + [m4_foreach([$1], m4_split(m4_normalize([$2]), [ ]), [$3])])]) + +# AC_PROG_MKDIR_P +# is a backport of autoconf-2.60's AC_PROG_MKDIR_P. +# Remove this macro when we can assume autoconf >= 2.60. +m4_ifdef([AC_PROG_MKDIR_P], [], [ + AC_DEFUN([AC_PROG_MKDIR_P], + [AC_REQUIRE([AM_PROG_MKDIR_P])dnl defined by automake + MKDIR_P='$(mkdir_p)' + AC_SUBST([MKDIR_P])])]) + +# AC_C_RESTRICT +# This definition overrides the AC_C_RESTRICT macro from autoconf 2.60..2.61, +# so that mixed use of GNU C and GNU C++ and mixed use of Sun C and Sun C++ +# works. +# This definition can be removed once autoconf >= 2.62 can be assumed. +AC_DEFUN([AC_C_RESTRICT], +[AC_CACHE_CHECK([for C/C++ restrict keyword], ac_cv_c_restrict, + [ac_cv_c_restrict=no + # The order here caters to the fact that C++ does not require restrict. + for ac_kw in __restrict __restrict__ _Restrict restrict; do + AC_COMPILE_IFELSE([AC_LANG_PROGRAM( + [[typedef int * int_ptr; + int foo (int_ptr $ac_kw ip) { + return ip[0]; + }]], + [[int s[1]; + int * $ac_kw t = s; + t[0] = 0; + return foo(t)]])], + [ac_cv_c_restrict=$ac_kw]) + test "$ac_cv_c_restrict" != no && break + done + ]) + AH_VERBATIM([restrict], +[/* Define to the equivalent of the C99 'restrict' keyword, or to + nothing if this is not supported. Do not define if restrict is + supported directly. */ +#undef restrict +/* Work around a bug in Sun C++: it does not support _Restrict, even + though the corresponding Sun C compiler does, which causes + "#define restrict _Restrict" in the previous line. Perhaps some future + version of Sun C++ will work with _Restrict; if so, it'll probably + define __RESTRICT, just as Sun C does. */ +#if defined __SUNPRO_CC && !defined __RESTRICT +# define _Restrict +#endif]) + case $ac_cv_c_restrict in + restrict) ;; + no) AC_DEFINE([restrict], []) ;; + *) AC_DEFINE_UNQUOTED([restrict], [$ac_cv_c_restrict]) ;; + esac +]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 new file mode 100644 index 000000000..cc9923d90 --- /dev/null +++ b/m4/gnulib-comp.m4 @@ -0,0 +1,216 @@ +# DO NOT EDIT! GENERATED AUTOMATICALLY! +# Copyright (C) 2002-2008 Free Software Foundation, Inc. +# +# This file is free software, distributed under the terms of the GNU +# General Public License. As a special exception to the GNU General +# Public License, this file may be distributed as part of a program +# that contains a configuration script generated by Autoconf, under +# the same distribution terms as the rest of that program. +# +# Generated by gnulib-tool. +# +# This file represents the compiled summary of the specification in +# gnulib-cache.m4. It lists the computed macro invocations that need +# to be invoked from configure.ac. +# In projects using CVS, this file can be treated like other built files. + + +# This macro should be invoked from ./configure.in, in the section +# "Checks for programs", right after AC_PROG_CC, and certainly before +# any checks for libraries, header files, types and library functions. +AC_DEFUN([gl_EARLY], +[ + m4_pattern_forbid([^gl_[A-Z]])dnl the gnulib macro namespace + m4_pattern_allow([^gl_ES$])dnl a valid locale name + m4_pattern_allow([^gl_LIBOBJS$])dnl a variable + m4_pattern_allow([^gl_LTLIBOBJS$])dnl a variable + AC_REQUIRE([AC_PROG_RANLIB]) + AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) +]) + +# This macro should be invoked from ./configure.in, in the section +# "Check for header files, types and library functions". +AC_DEFUN([gl_INIT], +[ + AM_CONDITIONAL([GL_COND_LIBTOOL], [true]) + gl_cond_libtool=true + m4_pushdef([AC_LIBOBJ], m4_defn([gl_LIBOBJ])) + m4_pushdef([AC_REPLACE_FUNCS], m4_defn([gl_REPLACE_FUNCS])) + m4_pushdef([AC_LIBSOURCES], m4_defn([gl_LIBSOURCES])) + m4_pushdef([gl_LIBSOURCES_LIST], []) + m4_pushdef([gl_LIBSOURCES_DIR], []) + gl_COMMON + gl_source_base='lib' +changequote(,)dnl +LTALLOCA=`echo "$ALLOCA" | sed 's/\.[^.]* /.lo /g;s/\.[^.]*$/.lo/'` +changequote([, ])dnl +AC_SUBST([LTALLOCA]) + gl_FUNC_ALLOCA + gl_COUNT_ONE_BITS + gl_INLINE + AM_STDBOOL_H + gl_STRCASE + gl_FUNC_GNU_STRFTIME + gl_HEADER_STRINGS_H + gl_HEADER_TIME_H + gl_TIME_R + gl_WCHAR_H + m4_ifval(gl_LIBSOURCES_LIST, [ + m4_syscmd([test ! -d ]m4_defn([gl_LIBSOURCES_DIR])[ || + for gl_file in ]gl_LIBSOURCES_LIST[ ; do + if test ! -r ]m4_defn([gl_LIBSOURCES_DIR])[/$gl_file ; then + echo "missing file ]m4_defn([gl_LIBSOURCES_DIR])[/$gl_file" >&2 + exit 1 + fi + done])dnl + m4_if(m4_sysval, [0], [], + [AC_FATAL([expected source file, required through AC_LIBSOURCES, not found])]) + ]) + m4_popdef([gl_LIBSOURCES_DIR]) + m4_popdef([gl_LIBSOURCES_LIST]) + m4_popdef([AC_LIBSOURCES]) + m4_popdef([AC_REPLACE_FUNCS]) + m4_popdef([AC_LIBOBJ]) + AC_CONFIG_COMMANDS_PRE([ + gl_libobjs= + gl_ltlibobjs= + if test -n "$gl_LIBOBJS"; then + # Remove the extension. + sed_drop_objext='s/\.o$//;s/\.obj$//' + for i in `for i in $gl_LIBOBJS; do echo "$i"; done | sed "$sed_drop_objext" | sort | uniq`; do + gl_libobjs="$gl_libobjs $i.$ac_objext" + gl_ltlibobjs="$gl_ltlibobjs $i.lo" + done + fi + AC_SUBST([gl_LIBOBJS], [$gl_libobjs]) + AC_SUBST([gl_LTLIBOBJS], [$gl_ltlibobjs]) + ]) + gltests_libdeps= + gltests_ltlibdeps= + m4_pushdef([AC_LIBOBJ], m4_defn([gltests_LIBOBJ])) + m4_pushdef([AC_REPLACE_FUNCS], m4_defn([gltests_REPLACE_FUNCS])) + m4_pushdef([AC_LIBSOURCES], m4_defn([gltests_LIBSOURCES])) + m4_pushdef([gltests_LIBSOURCES_LIST], []) + m4_pushdef([gltests_LIBSOURCES_DIR], []) + gl_COMMON + gl_source_base='tests' + m4_ifval(gltests_LIBSOURCES_LIST, [ + m4_syscmd([test ! -d ]m4_defn([gltests_LIBSOURCES_DIR])[ || + for gl_file in ]gltests_LIBSOURCES_LIST[ ; do + if test ! -r ]m4_defn([gltests_LIBSOURCES_DIR])[/$gl_file ; then + echo "missing file ]m4_defn([gltests_LIBSOURCES_DIR])[/$gl_file" >&2 + exit 1 + fi + done])dnl + m4_if(m4_sysval, [0], [], + [AC_FATAL([expected source file, required through AC_LIBSOURCES, not found])]) + ]) + m4_popdef([gltests_LIBSOURCES_DIR]) + m4_popdef([gltests_LIBSOURCES_LIST]) + m4_popdef([AC_LIBSOURCES]) + m4_popdef([AC_REPLACE_FUNCS]) + m4_popdef([AC_LIBOBJ]) + AC_CONFIG_COMMANDS_PRE([ + gltests_libobjs= + gltests_ltlibobjs= + if test -n "$gltests_LIBOBJS"; then + # Remove the extension. + sed_drop_objext='s/\.o$//;s/\.obj$//' + for i in `for i in $gltests_LIBOBJS; do echo "$i"; done | sed "$sed_drop_objext" | sort | uniq`; do + gltests_libobjs="$gltests_libobjs $i.$ac_objext" + gltests_ltlibobjs="$gltests_ltlibobjs $i.lo" + done + fi + AC_SUBST([gltests_LIBOBJS], [$gltests_libobjs]) + AC_SUBST([gltests_LTLIBOBJS], [$gltests_ltlibobjs]) + ]) +]) + +# Like AC_LIBOBJ, except that the module name goes +# into gl_LIBOBJS instead of into LIBOBJS. +AC_DEFUN([gl_LIBOBJ], [ + AS_LITERAL_IF([$1], [gl_LIBSOURCES([$1.c])])dnl + gl_LIBOBJS="$gl_LIBOBJS $1.$ac_objext" +]) + +# Like AC_REPLACE_FUNCS, except that the module name goes +# into gl_LIBOBJS instead of into LIBOBJS. +AC_DEFUN([gl_REPLACE_FUNCS], [ + m4_foreach_w([gl_NAME], [$1], [AC_LIBSOURCES(gl_NAME[.c])])dnl + AC_CHECK_FUNCS([$1], , [gl_LIBOBJ($ac_func)]) +]) + +# Like AC_LIBSOURCES, except the directory where the source file is +# expected is derived from the gnulib-tool parameterization, +# and alloca is special cased (for the alloca-opt module). +# We could also entirely rely on EXTRA_lib..._SOURCES. +AC_DEFUN([gl_LIBSOURCES], [ + m4_foreach([_gl_NAME], [$1], [ + m4_if(_gl_NAME, [alloca.c], [], [ + m4_define([gl_LIBSOURCES_DIR], [lib]) + m4_append([gl_LIBSOURCES_LIST], _gl_NAME, [ ]) + ]) + ]) +]) + +# Like AC_LIBOBJ, except that the module name goes +# into gltests_LIBOBJS instead of into LIBOBJS. +AC_DEFUN([gltests_LIBOBJ], [ + AS_LITERAL_IF([$1], [gltests_LIBSOURCES([$1.c])])dnl + gltests_LIBOBJS="$gltests_LIBOBJS $1.$ac_objext" +]) + +# Like AC_REPLACE_FUNCS, except that the module name goes +# into gltests_LIBOBJS instead of into LIBOBJS. +AC_DEFUN([gltests_REPLACE_FUNCS], [ + m4_foreach_w([gl_NAME], [$1], [AC_LIBSOURCES(gl_NAME[.c])])dnl + AC_CHECK_FUNCS([$1], , [gltests_LIBOBJ($ac_func)]) +]) + +# Like AC_LIBSOURCES, except the directory where the source file is +# expected is derived from the gnulib-tool parameterization, +# and alloca is special cased (for the alloca-opt module). +# We could also entirely rely on EXTRA_lib..._SOURCES. +AC_DEFUN([gltests_LIBSOURCES], [ + m4_foreach([_gl_NAME], [$1], [ + m4_if(_gl_NAME, [alloca.c], [], [ + m4_define([gltests_LIBSOURCES_DIR], [tests]) + m4_append([gltests_LIBSOURCES_LIST], _gl_NAME, [ ]) + ]) + ]) +]) + +# This macro records the list of files which have been installed by +# gnulib-tool and may be removed by future gnulib-tool invocations. +AC_DEFUN([gl_FILE_LIST], [ + build-aux/link-warning.h + lib/alloca.c + lib/alloca.in.h + lib/count-one-bits.h + lib/dummy.c + lib/stdbool.in.h + lib/strcasecmp.c + lib/strftime.c + lib/strftime.h + lib/strings.in.h + lib/strncasecmp.c + lib/time.in.h + lib/time_r.c + lib/verify.h + lib/wchar.in.h + m4/alloca.m4 + m4/count-one-bits.m4 + m4/extensions.m4 + m4/gnulib-common.m4 + m4/include_next.m4 + m4/inline.m4 + m4/mbstate_t.m4 + m4/stdbool.m4 + m4/strcase.m4 + m4/strftime.m4 + m4/strings_h.m4 + m4/time_h.m4 + m4/time_r.m4 + m4/tm_gmtoff.m4 + m4/wchar.m4 +]) diff --git a/m4/gnulib-tool.m4 b/m4/gnulib-tool.m4 new file mode 100644 index 000000000..4438d4886 --- /dev/null +++ b/m4/gnulib-tool.m4 @@ -0,0 +1,57 @@ +# gnulib-tool.m4 serial 2 +dnl Copyright (C) 2004-2005 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +dnl The following macros need not be invoked explicitly. +dnl Invoking them does nothing except to declare default arguments +dnl for "gnulib-tool --import". + +dnl Usage: gl_LOCAL_DIR([DIR]) +AC_DEFUN([gl_LOCAL_DIR], []) + +dnl Usage: gl_MODULES([module1 module2 ...]) +AC_DEFUN([gl_MODULES], []) + +dnl Usage: gl_AVOID([module1 module2 ...]) +AC_DEFUN([gl_AVOID], []) + +dnl Usage: gl_SOURCE_BASE([DIR]) +AC_DEFUN([gl_SOURCE_BASE], []) + +dnl Usage: gl_M4_BASE([DIR]) +AC_DEFUN([gl_M4_BASE], []) + +dnl Usage: gl_PO_BASE([DIR]) +AC_DEFUN([gl_PO_BASE], []) + +dnl Usage: gl_DOC_BASE([DIR]) +AC_DEFUN([gl_DOC_BASE], []) + +dnl Usage: gl_TESTS_BASE([DIR]) +AC_DEFUN([gl_TESTS_BASE], []) + +dnl Usage: gl_WITH_TESTS +AC_DEFUN([gl_WITH_TESTS], []) + +dnl Usage: gl_LIB([LIBNAME]) +AC_DEFUN([gl_LIB], []) + +dnl Usage: gl_LGPL or gl_LGPL([VERSION]) +AC_DEFUN([gl_LGPL], []) + +dnl Usage: gl_MAKEFILE_NAME([FILENAME]) +AC_DEFUN([gl_MAKEFILE_NAME], []) + +dnl Usage: gl_LIBTOOL +AC_DEFUN([gl_LIBTOOL], []) + +dnl Usage: gl_MACRO_PREFIX([PREFIX]) +AC_DEFUN([gl_MACRO_PREFIX], []) + +dnl Usage: gl_PO_DOMAIN([DOMAIN]) +AC_DEFUN([gl_PO_DOMAIN], []) + +dnl Usage: gl_VC_FILES([BOOLEAN]) +AC_DEFUN([gl_VC_FILES], []) diff --git a/m4/include_next.m4 b/m4/include_next.m4 new file mode 100644 index 000000000..08c63dbc2 --- /dev/null +++ b/m4/include_next.m4 @@ -0,0 +1,124 @@ +# include_next.m4 serial 7 +dnl Copyright (C) 2006-2008 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +dnl From Paul Eggert and Derek Price. + +dnl Sets INCLUDE_NEXT and PRAGMA_SYSTEM_HEADER. +dnl +dnl INCLUDE_NEXT expands to 'include_next' if the compiler supports it, or to +dnl 'include' otherwise. +dnl +dnl PRAGMA_SYSTEM_HEADER can be used in files that contain #include_next, +dnl so as to avoid GCC warnings when the gcc option -pedantic is used. +dnl '#pragma GCC system_header' has the same effect as if the file was found +dnl through the include search path specified with '-isystem' options (as +dnl opposed to the search path specified with '-I' options). Namely, gcc +dnl does not warn about some things, and on some systems (Solaris and Interix) +dnl __STDC__ evaluates to 0 instead of to 1. The latter is an undesired side +dnl effect; we are therefore careful to use 'defined __STDC__' or '1' instead +dnl of plain '__STDC__'. + +AC_DEFUN([gl_INCLUDE_NEXT], +[ + AC_LANG_PREPROC_REQUIRE() + AC_CACHE_CHECK([whether the preprocessor supports include_next], + [gl_cv_have_include_next], + [rm -rf conftestd1 conftestd2 + mkdir conftestd1 conftestd2 + cat <<EOF > conftestd1/conftest.h +#define DEFINED_IN_CONFTESTD1 +#include_next <conftest.h> +#ifdef DEFINED_IN_CONFTESTD2 +int foo; +#else +#error "include_next doesn't work" +#endif +EOF + cat <<EOF > conftestd2/conftest.h +#ifndef DEFINED_IN_CONFTESTD1 +#error "include_next test doesn't work" +#endif +#define DEFINED_IN_CONFTESTD2 +EOF + save_CPPFLAGS="$CPPFLAGS" + CPPFLAGS="$CPPFLAGS -Iconftestd1 -Iconftestd2" + AC_COMPILE_IFELSE([#include <conftest.h>], + [gl_cv_have_include_next=yes], + [gl_cv_have_include_next=no]) + CPPFLAGS="$save_CPPFLAGS" + rm -rf conftestd1 conftestd2 + ]) + PRAGMA_SYSTEM_HEADER= + if test $gl_cv_have_include_next = yes; then + INCLUDE_NEXT=include_next + if test -n "$GCC"; then + PRAGMA_SYSTEM_HEADER='#pragma GCC system_header' + fi + else + INCLUDE_NEXT=include + fi + AC_SUBST([INCLUDE_NEXT]) + AC_SUBST([PRAGMA_SYSTEM_HEADER]) +]) + +# gl_CHECK_NEXT_HEADERS(HEADER1 HEADER2 ...) +# ------------------------------------------ +# For each arg foo.h, if #include_next works, define NEXT_FOO_H to be +# '<foo.h>'; otherwise define it to be +# '"///usr/include/foo.h"', or whatever other absolute file name is suitable. +# That way, a header file with the following line: +# #@INCLUDE_NEXT@ @NEXT_FOO_H@ +# behaves (after sed substitution) as if it contained +# #include_next <foo.h> +# even if the compiler does not support include_next. +# The three "///" are to pacify Sun C 5.8, which otherwise would say +# "warning: #include of /usr/include/... may be non-portable". +# Use `""', not `<>', so that the /// cannot be confused with a C99 comment. +# Note: This macro assumes that the header file is not empty after +# preprocessing, i.e. it does not only define preprocessor macros but also +# provides some type/enum definitions or function/variable declarations. +AC_DEFUN([gl_CHECK_NEXT_HEADERS], +[ + AC_REQUIRE([gl_INCLUDE_NEXT]) + AC_CHECK_HEADERS_ONCE([$1]) + + m4_foreach_w([gl_HEADER_NAME], [$1], + [AS_VAR_PUSHDEF([gl_next_header], + [gl_cv_next_]m4_quote(m4_defn([gl_HEADER_NAME]))) + if test $gl_cv_have_include_next = yes; then + AS_VAR_SET([gl_next_header], ['<'gl_HEADER_NAME'>']) + else + AC_CACHE_CHECK( + [absolute name of <]m4_quote(m4_defn([gl_HEADER_NAME]))[>], + m4_quote(m4_defn([gl_next_header])), + [AS_VAR_PUSHDEF([gl_header_exists], + [ac_cv_header_]m4_quote(m4_defn([gl_HEADER_NAME]))) + if test AS_VAR_GET(gl_header_exists) = yes; then + AC_LANG_CONFTEST( + [AC_LANG_SOURCE( + [[#include <]]m4_dquote(m4_defn([gl_HEADER_NAME]))[[>]] + )]) + dnl eval is necessary to expand ac_cpp. + dnl Ultrix and Pyramid sh refuse to redirect output of eval, + dnl so use subshell. + AS_VAR_SET([gl_next_header], + ['"'`(eval "$ac_cpp conftest.$ac_ext") 2>&AS_MESSAGE_LOG_FD | + sed -n '\#/]m4_quote(m4_defn([gl_HEADER_NAME]))[#{ + s#.*"\(.*/]m4_quote(m4_defn([gl_HEADER_NAME]))[\)".*#\1# + s#^/[^/]#//&# + p + q + }'`'"']) + else + AS_VAR_SET([gl_next_header], ['<'gl_HEADER_NAME'>']) + fi + AS_VAR_POPDEF([gl_header_exists])]) + fi + AC_SUBST( + AS_TR_CPP([NEXT_]m4_quote(m4_defn([gl_HEADER_NAME]))), + [AS_VAR_GET([gl_next_header])]) + AS_VAR_POPDEF([gl_next_header])]) +]) diff --git a/m4/inline.m4 b/m4/inline.m4 new file mode 100644 index 000000000..a07076cd6 --- /dev/null +++ b/m4/inline.m4 @@ -0,0 +1,40 @@ +# inline.m4 serial 3 +dnl Copyright (C) 2006 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +dnl Test for the 'inline' keyword or equivalent. +dnl Define 'inline' to a supported equivalent, or to nothing if not supported, +dnl like AC_C_INLINE does. Also, define HAVE_INLINE if 'inline' or an +dnl equivalent is effectively supported, i.e. if the compiler is likely to +dnl drop unused 'static inline' functions. +AC_DEFUN([gl_INLINE], +[ + AC_REQUIRE([AC_C_INLINE]) + AC_CACHE_CHECK([whether the compiler generally respects inline], + [gl_cv_c_inline_effective], + [if test $ac_cv_c_inline = no; then + gl_cv_c_inline_effective=no + else + dnl GCC defines __NO_INLINE__ if not optimizing or if -fno-inline is + dnl specified. + dnl Use AC_COMPILE_IFELSE here, not AC_EGREP_CPP, because the result + dnl depends on optimization flags, which can be in CFLAGS. + dnl (AC_EGREP_CPP looks only at the CPPFLAGS.) + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[]], + [[#ifdef __NO_INLINE__ + #error "inline is not effective" + #endif]])], + [gl_cv_c_inline_effective=yes], + [gl_cv_c_inline_effective=no]) + fi + ]) + if test $gl_cv_c_inline_effective = yes; then + AC_DEFINE([HAVE_INLINE], 1, + [Define to 1 if the compiler supports one of the keywords + 'inline', '__inline__', '__inline' and effectively inlines + functions marked as such.]) + fi +]) diff --git a/m4/mbstate_t.m4 b/m4/mbstate_t.m4 new file mode 100644 index 000000000..0da32b6b4 --- /dev/null +++ b/m4/mbstate_t.m4 @@ -0,0 +1,30 @@ +# mbstate_t.m4 serial 10 +dnl Copyright (C) 2000-2002, 2008 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +# From Paul Eggert. + +# BeOS 5 has <wchar.h> but does not define mbstate_t, +# so you can't declare an object of that type. +# Check for this incompatibility with Standard C. + +# AC_TYPE_MBSTATE_T +# ----------------- +AC_DEFUN([AC_TYPE_MBSTATE_T], + [AC_CACHE_CHECK([for mbstate_t], ac_cv_type_mbstate_t, + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [AC_INCLUDES_DEFAULT[ +# include <wchar.h>]], + [[mbstate_t x; return sizeof x;]])], + [ac_cv_type_mbstate_t=yes], + [ac_cv_type_mbstate_t=no])]) + if test $ac_cv_type_mbstate_t = yes; then + AC_DEFINE([HAVE_MBSTATE_T], 1, + [Define to 1 if <wchar.h> declares mbstate_t.]) + else + AC_DEFINE([mbstate_t], int, + [Define to a type if <wchar.h> does not define.]) + fi]) diff --git a/m4/stdbool.m4 b/m4/stdbool.m4 new file mode 100644 index 000000000..2204ecd98 --- /dev/null +++ b/m4/stdbool.m4 @@ -0,0 +1,115 @@ +# Check for stdbool.h that conforms to C99. + +dnl Copyright (C) 2002-2006 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +# Prepare for substituting <stdbool.h> if it is not supported. + +AC_DEFUN([AM_STDBOOL_H], +[ + AC_REQUIRE([AC_HEADER_STDBOOL]) + + # Define two additional variables used in the Makefile substitution. + + if test "$ac_cv_header_stdbool_h" = yes; then + STDBOOL_H='' + else + STDBOOL_H='stdbool.h' + fi + AC_SUBST([STDBOOL_H]) + + if test "$ac_cv_type__Bool" = yes; then + HAVE__BOOL=1 + else + HAVE__BOOL=0 + fi + AC_SUBST([HAVE__BOOL]) +]) + +# AM_STDBOOL_H will be renamed to gl_STDBOOL_H in the future. +AC_DEFUN([gl_STDBOOL_H], [AM_STDBOOL_H]) + +# This macro is only needed in autoconf <= 2.59. Newer versions of autoconf +# have this macro built-in. + +AC_DEFUN([AC_HEADER_STDBOOL], + [AC_CACHE_CHECK([for stdbool.h that conforms to C99], + [ac_cv_header_stdbool_h], + [AC_TRY_COMPILE( + [ + #include <stdbool.h> + #ifndef bool + "error: bool is not defined" + #endif + #ifndef false + "error: false is not defined" + #endif + #if false + "error: false is not 0" + #endif + #ifndef true + "error: true is not defined" + #endif + #if true != 1 + "error: true is not 1" + #endif + #ifndef __bool_true_false_are_defined + "error: __bool_true_false_are_defined is not defined" + #endif + + struct s { _Bool s: 1; _Bool t; } s; + + char a[true == 1 ? 1 : -1]; + char b[false == 0 ? 1 : -1]; + char c[__bool_true_false_are_defined == 1 ? 1 : -1]; + char d[(bool) 0.5 == true ? 1 : -1]; + bool e = &s; + char f[(_Bool) 0.0 == false ? 1 : -1]; + char g[true]; + char h[sizeof (_Bool)]; + char i[sizeof s.t]; + enum { j = false, k = true, l = false * true, m = true * 256 }; + _Bool n[m]; + char o[sizeof n == m * sizeof n[0] ? 1 : -1]; + char p[-1 - (_Bool) 0 < 0 && -1 - (bool) 0 < 0 ? 1 : -1]; + #if defined __xlc__ || defined __GNUC__ + /* Catch a bug in IBM AIX xlc compiler version 6.0.0.0 + reported by James Lemley on 2005-10-05; see + http://lists.gnu.org/archive/html/bug-coreutils/2005-10/msg00086.html + This test is not quite right, since xlc is allowed to + reject this program, as the initializer for xlcbug is + not one of the forms that C requires support for. + However, doing the test right would require a run-time + test, and that would make cross-compilation harder. + Let us hope that IBM fixes the xlc bug, and also adds + support for this kind of constant expression. In the + meantime, this test will reject xlc, which is OK, since + our stdbool.h substitute should suffice. We also test + this with GCC, where it should work, to detect more + quickly whether someone messes up the test in the + future. */ + char digs[] = "0123456789"; + int xlcbug = 1 / (&(digs + 5)[-2 + (bool) 1] == &digs[4] ? 1 : -1); + #endif + /* Catch a bug in an HP-UX C compiler. See + http://gcc.gnu.org/ml/gcc-patches/2003-12/msg02303.html + http://lists.gnu.org/archive/html/bug-coreutils/2005-11/msg00161.html + */ + _Bool q = true; + _Bool *pq = &q; + ], + [ + *pq |= q; + *pq |= ! q; + /* Refer to every declared value, to avoid compiler optimizations. */ + return (!a + !b + !c + !d + !e + !f + !g + !h + !i + !!j + !k + !!l + + !m + !n + !o + !p + !q + !pq); + ], + [ac_cv_header_stdbool_h=yes], + [ac_cv_header_stdbool_h=no])]) + AC_CHECK_TYPES([_Bool]) + if test $ac_cv_header_stdbool_h = yes; then + AC_DEFINE(HAVE_STDBOOL_H, 1, [Define to 1 if stdbool.h conforms to C99.]) + fi]) diff --git a/m4/strcase.m4 b/m4/strcase.m4 new file mode 100644 index 000000000..79c525c11 --- /dev/null +++ b/m4/strcase.m4 @@ -0,0 +1,44 @@ +# strcase.m4 serial 9 +dnl Copyright (C) 2002, 2005-2008 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_STRCASE], +[ + gl_FUNC_STRCASECMP + gl_FUNC_STRNCASECMP +]) + +AC_DEFUN([gl_FUNC_STRCASECMP], +[ + AC_REQUIRE([gl_HEADER_STRINGS_H_DEFAULTS]) + AC_REPLACE_FUNCS(strcasecmp) + if test $ac_cv_func_strcasecmp = no; then + HAVE_STRCASECMP=0 + gl_PREREQ_STRCASECMP + fi +]) + +AC_DEFUN([gl_FUNC_STRNCASECMP], +[ + AC_REQUIRE([gl_HEADER_STRINGS_H_DEFAULTS]) + AC_REPLACE_FUNCS(strncasecmp) + if test $ac_cv_func_strncasecmp = no; then + gl_PREREQ_STRNCASECMP + fi + AC_CHECK_DECLS(strncasecmp) + if test $ac_cv_have_decl_strncasecmp = no; then + HAVE_DECL_STRNCASECMP=0 + fi +]) + +# Prerequisites of lib/strcasecmp.c. +AC_DEFUN([gl_PREREQ_STRCASECMP], [ + : +]) + +# Prerequisites of lib/strncasecmp.c. +AC_DEFUN([gl_PREREQ_STRNCASECMP], [ + : +]) diff --git a/m4/strftime.m4 b/m4/strftime.m4 new file mode 100644 index 000000000..70b537894 --- /dev/null +++ b/m4/strftime.m4 @@ -0,0 +1,33 @@ +#serial 29 + +# Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005, +# 2006, 2007 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# Written by Jim Meyering and Paul Eggert. + +AC_DEFUN([gl_FUNC_GNU_STRFTIME], +[ + gl_FUNC_STRFTIME +]) + +# These are the prerequisite macros for GNU's strftime.c replacement. +AC_DEFUN([gl_FUNC_STRFTIME], +[ + AC_LIBOBJ([strftime]) + + # This defines (or not) HAVE_TZNAME and HAVE_TM_ZONE. + AC_REQUIRE([AC_STRUCT_TIMEZONE]) + + AC_REQUIRE([AC_TYPE_MBSTATE_T]) + AC_REQUIRE([gl_TM_GMTOFF]) + + AC_CHECK_FUNCS_ONCE(mblen mbrlen mempcpy tzset) + AC_CHECK_HEADERS_ONCE(wchar.h) + + AC_DEFINE([my_strftime], [nstrftime], + [Define to the name of the strftime replacement function.]) +]) diff --git a/m4/strings_h.m4 b/m4/strings_h.m4 new file mode 100644 index 000000000..03ac182f3 --- /dev/null +++ b/m4/strings_h.m4 @@ -0,0 +1,33 @@ +# Configure a replacement for <string.h>. + +# Copyright (C) 2007 Free Software Foundation, Inc. +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_HEADER_STRINGS_H], +[ + dnl Use AC_REQUIRE here, so that the default behavior below is expanded + dnl once only, before all statements that occur in other macros. + AC_REQUIRE([gl_HEADER_STRINGS_H_BODY]) +]) + +AC_DEFUN([gl_HEADER_STRINGS_H_BODY], +[ + AC_REQUIRE([gl_HEADER_STRINGS_H_DEFAULTS]) + gl_CHECK_NEXT_HEADERS([strings.h]) +]) + +AC_DEFUN([gl_STRINGS_MODULE_INDICATOR], +[ + dnl Use AC_REQUIRE here, so that the default settings are expanded once only. + AC_REQUIRE([gl_HEADER_STRINGS_H_DEFAULTS]) + GNULIB_[]m4_translit([$1],[abcdefghijklmnopqrstuvwxyz./-],[ABCDEFGHIJKLMNOPQRSTUVWXYZ___])=1 +]) + +AC_DEFUN([gl_HEADER_STRINGS_H_DEFAULTS], +[ + dnl Assume proper GNU behavior unless another module says otherwise. + HAVE_STRCASECMP=1; AC_SUBST([HAVE_STRCASECMP]) + HAVE_DECL_STRNCASECMP=1; AC_SUBST([HAVE_DECL_STRNCASECMP]) +]) diff --git a/m4/time_h.m4 b/m4/time_h.m4 new file mode 100644 index 000000000..d42a635ec --- /dev/null +++ b/m4/time_h.m4 @@ -0,0 +1,74 @@ +# Configure a more-standard replacement for <time.h>. + +# Copyright (C) 2000, 2001, 2003, 2004, 2005, 2006, 2007 Free Software +# Foundation, Inc. + +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# Written by Paul Eggert and Jim Meyering. + +AC_DEFUN([gl_HEADER_TIME_H], +[ + dnl Use AC_REQUIRE here, so that the default behavior below is expanded + dnl once only, before all statements that occur in other macros. + AC_REQUIRE([gl_HEADER_TIME_H_BODY]) +]) + +AC_DEFUN([gl_HEADER_TIME_H_BODY], +[ + AC_REQUIRE([AC_C_RESTRICT]) + AC_REQUIRE([gl_HEADER_TIME_H_DEFAULTS]) + gl_CHECK_NEXT_HEADERS([time.h]) + AC_REQUIRE([gl_CHECK_TYPE_STRUCT_TIMESPEC]) +]) + +AC_DEFUN([gl_HEADER_TIME_H_DEFAULTS], +[ + dnl If another module says to replace or to not replace, do that. + dnl Otherwise, replace only if someone compiles with -DGNULIB_PORTCHECK; + dnl this lets maintainers check for portability. + REPLACE_LOCALTIME_R=GNULIB_PORTCHECK; AC_SUBST([REPLACE_LOCALTIME_R]) + REPLACE_NANOSLEEP=GNULIB_PORTCHECK; AC_SUBST([REPLACE_NANOSLEEP]) + REPLACE_STRPTIME=GNULIB_PORTCHECK; AC_SUBST([REPLACE_STRPTIME]) + REPLACE_TIMEGM=GNULIB_PORTCHECK; AC_SUBST([REPLACE_TIMEGM]) +]) + +dnl Define HAVE_STRUCT_TIMESPEC if `struct timespec' is declared +dnl in time.h or sys/time.h. + +AC_DEFUN([gl_CHECK_TYPE_STRUCT_TIMESPEC], +[ + AC_CHECK_HEADERS_ONCE([sys/time.h]) + AC_CACHE_CHECK([for struct timespec in <time.h>], + [gl_cv_sys_struct_timespec_in_time_h], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[#include <time.h> + ]], + [[static struct timespec x; x.tv_sec = x.tv_nsec;]])], + [gl_cv_sys_struct_timespec_in_time_h=yes], + [gl_cv_sys_struct_timespec_in_time_h=no])]) + + TIME_H_DEFINES_STRUCT_TIMESPEC=0 + SYS_TIME_H_DEFINES_STRUCT_TIMESPEC=0 + if test $gl_cv_sys_struct_timespec_in_time_h = yes; then + TIME_H_DEFINES_STRUCT_TIMESPEC=1 + else + AC_CACHE_CHECK([for struct timespec in <sys/time.h>], + [gl_cv_sys_struct_timespec_in_sys_time_h], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[#include <sys/time.h> + ]], + [[static struct timespec x; x.tv_sec = x.tv_nsec;]])], + [gl_cv_sys_struct_timespec_in_sys_time_h=yes], + [gl_cv_sys_struct_timespec_in_sys_time_h=no])]) + if test $gl_cv_sys_struct_timespec_in_sys_time_h = yes; then + SYS_TIME_H_DEFINES_STRUCT_TIMESPEC=1 + fi + fi + AC_SUBST([TIME_H_DEFINES_STRUCT_TIMESPEC]) + AC_SUBST([SYS_TIME_H_DEFINES_STRUCT_TIMESPEC]) +]) diff --git a/m4/time_r.m4 b/m4/time_r.m4 new file mode 100644 index 000000000..c871b56d7 --- /dev/null +++ b/m4/time_r.m4 @@ -0,0 +1,43 @@ +dnl Reentrant time functions like localtime_r. + +dnl Copyright (C) 2003, 2006, 2007, 2008 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +dnl Written by Paul Eggert. + +AC_DEFUN([gl_TIME_R], +[ + dnl Persuade glibc and Solaris <time.h> to declare localtime_r. + AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) + + AC_REQUIRE([gl_HEADER_TIME_H_DEFAULTS]) + AC_REQUIRE([AC_C_RESTRICT]) + + AC_CACHE_CHECK([whether localtime_r is compatible with its POSIX signature], + [gl_cv_time_r_posix], + [AC_TRY_COMPILE( + [#include <time.h>], + [/* We don't need to append 'restrict's to the argument types, + even though the POSIX signature has the 'restrict's, + since C99 says they can't affect type compatibility. */ + struct tm * (*ptr) (time_t const *, struct tm *) = localtime_r; + if (ptr) return 0; + /* Check the return type is a pointer. On HP-UX 10 it is 'int'. */ + *localtime_r (0, 0);], + [gl_cv_time_r_posix=yes], + [gl_cv_time_r_posix=no])]) + if test $gl_cv_time_r_posix = yes; then + REPLACE_LOCALTIME_R=0 + else + REPLACE_LOCALTIME_R=1 + AC_LIBOBJ([time_r]) + gl_PREREQ_TIME_R + fi +]) + +# Prerequisites of lib/time_r.c. +AC_DEFUN([gl_PREREQ_TIME_R], [ + : +]) diff --git a/m4/tm_gmtoff.m4 b/m4/tm_gmtoff.m4 new file mode 100644 index 000000000..cb0b3c884 --- /dev/null +++ b/m4/tm_gmtoff.m4 @@ -0,0 +1,14 @@ +# tm_gmtoff.m4 serial 2 +dnl Copyright (C) 2002 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_TM_GMTOFF], +[ + AC_CHECK_MEMBER([struct tm.tm_gmtoff], + [AC_DEFINE(HAVE_TM_GMTOFF, 1, + [Define if struct tm has the tm_gmtoff member.])], + , + [#include <time.h>]) +]) diff --git a/m4/wchar.m4 b/m4/wchar.m4 new file mode 100644 index 000000000..70b1248f8 --- /dev/null +++ b/m4/wchar.m4 @@ -0,0 +1,54 @@ +dnl A placeholder for ISO C99 <wchar.h>, for platforms that have issues. + +dnl Copyright (C) 2007 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +dnl Written by Eric Blake. + +# wchar.m4 serial 4 + +AC_DEFUN([gl_WCHAR_H], +[ + AC_REQUIRE([gl_WCHAR_H_DEFAULTS]) + AC_CACHE_CHECK([whether <wchar.h> is standalone], + [gl_cv_header_wchar_h_standalone], + [AC_COMPILE_IFELSE([[#include <wchar.h> +wchar_t w;]], + [gl_cv_header_wchar_h_standalone=yes], + [gl_cv_header_wchar_h_standalone=no])]) + if test $gl_cv_header_wchar_h_standalone != yes; then + WCHAR_H=wchar.h + fi + + dnl Prepare for creating substitute <wchar.h>. + dnl Do it always: WCHAR_H may be empty here but can be set later. + dnl Check for <wchar.h> (missing in Linux uClibc when built without wide + dnl character support). + AC_CHECK_HEADERS_ONCE([wchar.h]) + if test $ac_cv_header_wchar_h = yes; then + HAVE_WCHAR_H=1 + else + HAVE_WCHAR_H=0 + fi + AC_SUBST([HAVE_WCHAR_H]) + gl_CHECK_NEXT_HEADERS([wchar.h]) +]) + +AC_DEFUN([gl_WCHAR_MODULE_INDICATOR], +[ + dnl Use AC_REQUIRE here, so that the default settings are expanded once only. + AC_REQUIRE([gl_WCHAR_H_DEFAULTS]) + GNULIB_[]m4_translit([$1],[abcdefghijklmnopqrstuvwxyz./-],[ABCDEFGHIJKLMNOPQRSTUVWXYZ___])=1 +]) + +AC_DEFUN([gl_WCHAR_H_DEFAULTS], +[ + GNULIB_WCWIDTH=0; AC_SUBST([GNULIB_WCWIDTH]) + dnl Assume proper GNU behavior unless another module says otherwise. + HAVE_DECL_WCWIDTH=1; AC_SUBST([HAVE_DECL_WCWIDTH]) + REPLACE_WCWIDTH=0; AC_SUBST([REPLACE_WCWIDTH]) + WCHAR_H= + AC_SUBST([WCHAR_H]) +]) diff --git a/oop/ChangeLog b/oop/ChangeLog index 4f86d7ad5..6727ef3fb 100644 --- a/oop/ChangeLog +++ b/oop/ChangeLog @@ -1,4 +1,16 @@ -2007-05-05 Ludovic Courtès <ludo@chbouib.org> +2008-03-18 Ludovic Courtès <ludo@gnu.org> + + * goops/util.scm (mapappend): Now an alias for SRFI-1's + `append-map', which is more efficient. + (every, any): Used and re-exported from SRFI-1. + +2008-03-12 Ludovic Courtès <ludo@gnu.org> + + * goops/describe.scm (describe): Provide `describe' (symbol), + not `"describe"' (string). Reported by David Pirotte + <david@altosw.be>. + +2007-05-05 Ludovic Courtès <ludo@chbouib.org> * goops/internal.scm: Use the public module API rather than hack with `%module-public-interface', `nested-ref', et al. @@ -282,3 +294,7 @@ * goops.scm (goops-error): Removed use of oldfmt. + +;; Local Variables: +;; coding: utf-8 +;; End: diff --git a/oop/goops/describe.scm b/oop/goops/describe.scm index 06acf30a0..184fef214 100644 --- a/oop/goops/describe.scm +++ b/oop/goops/describe.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 1998, 1999, 2001, 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 1998, 1999, 2001, 2006, 2008 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 @@ -197,4 +197,4 @@ (format #t "\tSpecializers:") (print-args (method-specializers x)))) -(provide "describe") +(provide 'describe) diff --git a/oop/goops/util.scm b/oop/goops/util.scm index 33e871c54..b6276aa37 100644 --- a/oop/goops/util.scm +++ b/oop/goops/util.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 1999, 2000, 2001, 2003, 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2000, 2001, 2003, 2006, 2008 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 @@ -17,9 +17,10 @@ (define-module (oop goops util) - :export (any every - mapappend find-duplicate top-level-env top-level-env? + :export (mapappend find-duplicate top-level-env top-level-env? map* for-each* length* improper->proper) + :use-module (srfi srfi-1) + :re-export (any every) :no-backtrace ) @@ -28,43 +29,7 @@ ;;; {Utilities} ;;; -(define (any pred lst . rest) - (if (null? rest) ;fast path - (and (not (null? lst)) - (let loop ((head (car lst)) (tail (cdr lst))) - (if (null? tail) - (pred head) - (or (pred head) - (loop (car tail) (cdr tail)))))) - (let ((lsts (cons lst rest))) - (and (not (any null? lsts)) - (let loop ((heads (map car lsts)) (tails (map cdr lsts))) - (if (any null? tails) - (apply pred heads) - (or (apply pred heads) - (loop (map car tails) (map cdr tails))))))))) - -(define (every pred lst . rest) - (if (null? rest) ;fast path - (or (null? lst) - (let loop ((head (car lst)) (tail (cdr lst))) - (if (null? tail) - (pred head) - (and (pred head) - (loop (car tail) (cdr tail)))))) - (let ((lsts (cons lst rest))) - (or (any null? lsts) - (let loop ((heads (map car lsts)) (tails (map cdr lsts))) - (if (any null? tails) - (apply pred heads) - (and (apply pred heads) - (loop (map car tails) (map cdr tails))))))))) - -(define (mapappend func . args) - (if (memv '() args) - '() - (append (apply func (map car args)) - (apply mapappend func (map cdr args))))) +(define mapappend append-map) (define (find-duplicate l) ; find a duplicate in a list; #f otherwise (cond diff --git a/pre-inst-guile-env.in b/pre-inst-guile-env.in index e15290605..5bf1e136a 100644 --- a/pre-inst-guile-env.in +++ b/pre-inst-guile-env.in @@ -1,6 +1,6 @@ #!/bin/sh -# Copyright (C) 2003, 2006 Free Software Foundation +# Copyright (C) 2003, 2006, 2008 Free Software Foundation # # This file is part of GUILE. # @@ -63,11 +63,15 @@ export GUILE_LOAD_PATH # handle LTDL_LIBRARY_PATH (no clobber) ltdl_prefix="" +dyld_prefix="" for dir in $subdirs_with_ltlibs ; do ltdl_prefix="${top_builddir}/${dir}:${ltdl_prefix}" + dyld_prefix="${top_builddir}/${dir}/.libs:${dyld_prefix}" done LTDL_LIBRARY_PATH="${ltdl_prefix}$LTDL_LIBRARY_PATH" export LTDL_LIBRARY_PATH +DYLD_LIBRARY_PATH="${dyld_prefix}${top_builddir}/libguile/.libs:$DYLD_LIBRARY_PATH" +export DYLD_LIBRARY_PATH # handle PATH (no clobber) PATH="${top_builddir}/guile-config:${PATH}" diff --git a/pre-inst-guile.in b/pre-inst-guile.in index 4b7c97e4b..d210fdebc 100644 --- a/pre-inst-guile.in +++ b/pre-inst-guile.in @@ -1,6 +1,6 @@ #!/bin/sh -# Copyright (C) 2002, 2006 Free Software Foundation +# Copyright (C) 2002, 2006, 2008 Free Software Foundation # # This file is part of GUILE. # @@ -76,11 +76,15 @@ export GUILE_LOAD_PATH # handle LTDL_LIBRARY_PATH (no clobber) ltdl_prefix="" +dyld_prefix="" for dir in $subdirs_with_ltlibs ; do ltdl_prefix="${top_builddir}/${dir}:${ltdl_prefix}" + dyld_prefix="${top_builddir}/${dir}/.libs:${dyld_prefix}" done LTDL_LIBRARY_PATH="${ltdl_prefix}$LTDL_LIBRARY_PATH" export LTDL_LIBRARY_PATH +DYLD_LIBRARY_PATH="${dyld_prefix}${top_builddir}/libguile/.libs:$DYLD_LIBRARY_PATH" +export DYLD_LIBRARY_PATH # set GUILE (clobber) GUILE=${top_builddir}/libguile/guile diff --git a/srfi/ChangeLog b/srfi/ChangeLog index 9f0e412db..d771a8f9f 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,62 @@ +2008-08-30 Julian Graham <joolean@gmail.com> + + * srfi-18.scm: Raise error if Guile not built with threading + support. + +2008-08-25 Ludovic Courtès <ludo@gnu.org> + + * Makefile.am (AM_CFLAGS): New. + +2008-06-28 Ludovic Courtès <ludo@gnu.org> + + * Makefile.am (INCLUDES): Renamed to... + (AM_CPPFLAGS): this, to match current Automake conventions. + + * srfi-19.scm (priv:read-tai-utc-data): Use `eof-object?' + instead of comparing LINE with `eof'. + +2008-05-15 Julian Graham <joolean@gmail.com> + + * srfi-18.scm: New file. + +2008-04-28 Ludovic Courtès <ludo@gnu.org> + + * srfi-1.c (scm_srfi1_partition): Properly type-check LIST. + Reported by Julian Graham <joolean@gmail.com>. + +2008-04-27 Ludovic Courtès <ludo@gnu.org> + + * srfi-1.c: Include <config.h>. + +2008-04-26 Ludovic Courtès <ludo@gnu.org> + + * srfi-35.scm: Provide `srfi-35' through `cond-expand-provide'. + +2008-04-26 Ludovic Courtès <ludo@gnu.org> + + * Makefile.am (srfi_DATA): Add `srfi-88.scm'. + * srfi-88.scm: New file. + +2008-03-12 Ludovic Courtès <ludo@gnu.org> + + * srfi-37.scm (args-fold)[short-option]: Set ARGS to `(cdr + args)' before calling `next-arg'. This fixes parsing of + argument-less options when using short names. + +2008-01-22 Neil Jerram <neil@ossau.uklinux.net> + + * srfi-39.scm: Update copyright statement to LGPL. + +2007-12-13 Stephen Compall <s11@member.fsf.org> + + * srfi-69.scm (without-keyword-args): Use `cdr' instead of + `rest'. + +2007-12-03 Stephen Compall <s11@member.fsf.org> + + * srfi-69.scm: New file. + * Makefile.am: Add it. + 2007-09-10 Ludovic Courtès <ludo@gnu.org> * srfi-35.scm (make-compound-condition-type): When PARENTS diff --git a/srfi/Makefile.am b/srfi/Makefile.am index 8f5976e5c..bb69bbbf2 100644 --- a/srfi/Makefile.am +++ b/srfi/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 2001, 2002, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +## Copyright (C) 2001, 2002, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -26,8 +26,10 @@ DEFS = @DEFS@ @EXTRA_DEFS@ ## Check for headers in $(srcdir)/.., so that #include ## <libguile/MUMBLE.h> will find MUMBLE.h in this dir when we're ## building. Also look for Gnulib headers in `lib'. -INCLUDES = -I.. -I$(srcdir)/.. \ - -I$(top_srcdir)/lib -I$(top_builddir)/lib +AM_CPPFLAGS = -I.. -I$(srcdir)/.. \ + -I$(top_srcdir)/lib -I$(top_builddir)/lib + +AM_CFLAGS = $(GCC_CFLAGS) srfiincludedir = $(pkgincludedir)/srfi @@ -82,16 +84,18 @@ srfi_DATA = srfi-1.scm \ srfi-35.scm \ srfi-37.scm \ srfi-39.scm \ - srfi-60.scm + srfi-60.scm \ + srfi-69.scm \ + srfi-88.scm EXTRA_DIST = $(srfi_DATA) TAGS_FILES = $(srfi_DATA) GUILE_SNARF = ../libguile/guile-snarf -MKDEP = gcc -M -MG $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) +MKDEP = gcc -M -MG $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS) -snarfcppopts = $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) +snarfcppopts = $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS) SUFFIXES = .x .c.x: diff --git a/srfi/srfi-1.c b/srfi/srfi-1.c index 8e27ab4e6..35815b32f 100644 --- a/srfi/srfi-1.c +++ b/srfi/srfi-1.c @@ -1,6 +1,6 @@ /* srfi-1.c --- SRFI-1 procedures for Guile * - * Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2005, 2006 + * Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2005, 2006, 2008 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -18,6 +18,10 @@ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ +#if HAVE_CONFIG_H +# include <config.h> +#endif + #include <libguile.h> #include <libguile/lang.h> @@ -1663,6 +1667,7 @@ SCM_DEFINE (scm_srfi1_partition, "partition", 2, 0, 0, /* In this implementation, the output lists don't share memory with list, because it's probably not worth the effort. */ scm_t_trampoline_1 call = scm_trampoline_1(pred); + SCM orig_list = list; SCM kept = scm_cons(SCM_EOL, SCM_EOL); SCM kept_tail = kept; SCM dropped = scm_cons(SCM_EOL, SCM_EOL); @@ -1671,8 +1676,14 @@ SCM_DEFINE (scm_srfi1_partition, "partition", 2, 0, 0, SCM_ASSERT(call, pred, 2, FUNC_NAME); for (; !SCM_NULL_OR_NIL_P (list); list = SCM_CDR(list)) { - SCM elt = SCM_CAR(list); - SCM new_tail = scm_cons(SCM_CAR(list), SCM_EOL); + SCM elt, new_tail; + + /* Make sure LIST is not a dotted list. */ + SCM_ASSERT (scm_is_pair (list), orig_list, SCM_ARG2, FUNC_NAME); + + elt = SCM_CAR (list); + new_tail = scm_cons (SCM_CAR (list), SCM_EOL); + if (scm_is_true (call (pred, elt))) { SCM_SETCDR(kept_tail, new_tail); kept_tail = new_tail; diff --git a/srfi/srfi-18.scm b/srfi/srfi-18.scm new file mode 100644 index 000000000..925ecb304 --- /dev/null +++ b/srfi/srfi-18.scm @@ -0,0 +1,382 @@ +;;; srfi-18.scm --- Multithreading support + +;; Copyright (C) 2008 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 +;; License as published by the Free Software Foundation; either +;; version 2.1 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;; Author: Julian Graham <julian.graham@aya.yale.edu> +;;; Date: 2008-04-11 + +;;; Commentary: + +;; This is an implementation of SRFI-18 (Multithreading support). +;; +;; All procedures defined in SRFI-18, which are not already defined in +;; the Guile core library, are exported. +;; +;; This module is fully documented in the Guile Reference Manual. + +;;; Code: + +(define-module (srfi srfi-18) + :use-module (srfi srfi-34) + :export ( + +;;; Threads + ;; current-thread <= in the core + ;; thread? <= in the core + make-thread + thread-name + thread-specific + thread-specific-set! + thread-start! + thread-yield! + thread-sleep! + thread-terminate! + thread-join! + +;;; Mutexes + ;; mutex? <= in the core + make-mutex + mutex-name + mutex-specific + mutex-specific-set! + mutex-state + mutex-lock! + mutex-unlock! + +;;; Condition variables + ;; condition-variable? <= in the core + make-condition-variable + condition-variable-name + condition-variable-specific + condition-variable-specific-set! + condition-variable-signal! + condition-variable-broadcast! + condition-variable-wait! + +;;; Time + current-time + time? + time->seconds + seconds->time + + current-exception-handler + with-exception-handler + raise + join-timeout-exception? + abandoned-mutex-exception? + terminated-thread-exception? + uncaught-exception? + uncaught-exception-reason + ) + :re-export (thread? mutex? condition-variable?) + :replace (current-time + make-thread + make-mutex + make-condition-variable + raise)) + +(if (not (provided? 'threads)) + (error "SRFI-18 requires Guile with threads support")) + +(cond-expand-provide (current-module) '(srfi-18)) + +(define (check-arg-type pred arg caller) + (if (pred arg) + arg + (scm-error 'wrong-type-arg caller + "Wrong type argument: ~S" (list arg) '()))) + +(define abandoned-mutex-exception (list 'abandoned-mutex-exception)) +(define join-timeout-exception (list 'join-timeout-exception)) +(define terminated-thread-exception (list 'terminated-thread-exception)) +(define uncaught-exception (list 'uncaught-exception)) + +(define mutex-owners (make-weak-key-hash-table)) +(define object-names (make-weak-key-hash-table)) +(define object-specifics (make-weak-key-hash-table)) +(define thread-start-conds (make-weak-key-hash-table)) +(define thread-exception-handlers (make-weak-key-hash-table)) + +;; EXCEPTIONS + +(define raise (@ (srfi srfi-34) raise)) +(define (initial-handler obj) + (srfi-18-exception-preserver (cons uncaught-exception obj))) + +(define thread->exception (make-object-property)) + +(define (srfi-18-exception-preserver obj) + (if (or (terminated-thread-exception? obj) + (uncaught-exception? obj)) + (set! (thread->exception (current-thread)) obj))) + +(define (srfi-18-exception-handler key . args) + + ;; SRFI 34 exceptions continue to bubble up no matter who handles them, so + ;; if one is caught at this level, it has already been taken care of by + ;; `initial-handler'. + + (and (not (eq? key 'srfi-34)) + (srfi-18-exception-preserver (if (null? args) + (cons uncaught-exception key) + (cons* uncaught-exception key args))))) + +(define (current-handler-stack) + (let ((ct (current-thread))) + (or (hashq-ref thread-exception-handlers ct) + (hashq-set! thread-exception-handlers ct (list initial-handler))))) + +(define (with-exception-handler handler thunk) + (let ((ct (current-thread)) + (hl (current-handler-stack))) + (check-arg-type procedure? handler "with-exception-handler") + (check-arg-type thunk? thunk "with-exception-handler") + (hashq-set! thread-exception-handlers ct (cons handler hl)) + (apply (@ (srfi srfi-34) with-exception-handler) + (list (lambda (obj) + (hashq-set! thread-exception-handlers ct hl) + (handler obj)) + (lambda () + (let ((r (thunk))) + (hashq-set! thread-exception-handlers ct hl) r)))))) + +(define (current-exception-handler) + (car (current-handler-stack))) + +(define (join-timeout-exception? obj) (eq? obj join-timeout-exception)) +(define (abandoned-mutex-exception? obj) (eq? obj abandoned-mutex-exception)) +(define (uncaught-exception? obj) + (and (pair? obj) (eq? (car obj) uncaught-exception))) +(define (uncaught-exception-reason exc) + (cdr (check-arg-type uncaught-exception? exc "uncaught-exception-reason"))) +(define (terminated-thread-exception? obj) + (eq? obj terminated-thread-exception)) + +;; THREADS + +;; Create a new thread and prevent it from starting using a condition variable. +;; Once started, install a top-level exception handler that rethrows any +;; exceptions wrapped in an uncaught-exception wrapper. + +(define make-thread + (let ((make-cond-wrapper (lambda (thunk lcond lmutex scond smutex) + (lambda () + (lock-mutex lmutex) + (signal-condition-variable lcond) + (lock-mutex smutex) + (unlock-mutex lmutex) + (wait-condition-variable scond smutex) + (unlock-mutex smutex) + (with-exception-handler initial-handler + thunk))))) + (lambda (thunk . name) + (let ((n (and (pair? name) (car name))) + + (lm (make-mutex 'launch-mutex)) + (lc (make-condition-variable 'launch-condition-variable)) + (sm (make-mutex 'start-mutex)) + (sc (make-condition-variable 'start-condition-variable))) + + (lock-mutex lm) + (let ((t (call-with-new-thread (make-cond-wrapper thunk lc lm sc sm) + srfi-18-exception-handler))) + (hashq-set! thread-start-conds t (cons sm sc)) + (and n (hashq-set! object-names t n)) + (wait-condition-variable lc lm) + (unlock-mutex lm) + t))))) + +(define (thread-name thread) + (hashq-ref object-names (check-arg-type thread? thread "thread-name"))) + +(define (thread-specific thread) + (hashq-ref object-specifics + (check-arg-type thread? thread "thread-specific"))) + +(define (thread-specific-set! thread obj) + (hashq-set! object-specifics + (check-arg-type thread? thread "thread-specific-set!") + obj) + *unspecified*) + +(define (thread-start! thread) + (let ((x (hashq-ref thread-start-conds + (check-arg-type thread? thread "thread-start!")))) + (and x (let ((smutex (car x)) + (scond (cdr x))) + (hashq-remove! thread-start-conds thread) + (lock-mutex smutex) + (signal-condition-variable scond) + (unlock-mutex smutex))) + thread)) + +(define (thread-yield!) (yield) *unspecified*) + +(define (thread-sleep! timeout) + (let* ((ct (time->seconds (current-time))) + (t (cond ((time? timeout) (- (time->seconds timeout) ct)) + ((number? timeout) (- timeout ct)) + (else (scm-error 'wrong-type-arg caller + "Wrong type argument: ~S" + (list timeout) + '())))) + (secs (inexact->exact (truncate t))) + (usecs (inexact->exact (truncate (* (- t secs) 1000))))) + (and (> secs 0) (sleep secs)) + (and (> usecs 0) (usleep usecs)) + *unspecified*)) + +;; A convenience function for installing exception handlers on SRFI-18 +;; primitives that resume the calling continuation after the handler is +;; invoked -- this resolves a behavioral incompatibility with Guile's +;; implementation of SRFI-34, which uses lazy-catch and rethrows handled +;; exceptions. (SRFI-18, "Primitives and exceptions") + +(define (wrap thunk) + (lambda (continuation) + (with-exception-handler (lambda (obj) + (apply (current-exception-handler) (list obj)) + (apply continuation (list))) + thunk))) + +;; A pass-thru to cancel-thread that first installs a handler that throws +;; terminated-thread exception, as per SRFI-18, + +(define (thread-terminate! thread) + (define (thread-terminate-inner!) + (let ((current-handler (thread-cleanup thread))) + (if (thunk? current-handler) + (set-thread-cleanup! thread + (lambda () + (with-exception-handler initial-handler + current-handler) + (srfi-18-exception-preserver + terminated-thread-exception))) + (set-thread-cleanup! thread + (lambda () (srfi-18-exception-preserver + terminated-thread-exception)))) + (cancel-thread thread) + *unspecified*)) + (thread-terminate-inner!)) + +(define (thread-join! thread . args) + (define thread-join-inner! + (wrap (lambda () + (let ((v (apply join-thread (cons thread args))) + (e (thread->exception thread))) + (if (and (= (length args) 1) (not v)) + (raise join-timeout-exception)) + (if e (raise e)) + v)))) + (call/cc thread-join-inner!)) + +;; MUTEXES +;; These functions are all pass-thrus to the existing Guile implementations. + +(define make-mutex + (lambda name + (let ((n (and (pair? name) (car name))) + (m ((@ (guile) make-mutex) + 'unchecked-unlock + 'allow-external-unlock + 'recursive))) + (and n (hashq-set! object-names m n)) m))) + +(define (mutex-name mutex) + (hashq-ref object-names (check-arg-type mutex? mutex "mutex-name"))) + +(define (mutex-specific mutex) + (hashq-ref object-specifics + (check-arg-type mutex? mutex "mutex-specific"))) + +(define (mutex-specific-set! mutex obj) + (hashq-set! object-specifics + (check-arg-type mutex? mutex "mutex-specific-set!") + obj) + *unspecified*) + +(define (mutex-state mutex) + (let ((owner (mutex-owner mutex))) + (if owner + (if (thread-exited? owner) 'abandoned owner) + (if (> (mutex-level mutex) 0) 'not-owned 'not-abandoned)))) + +(define (mutex-lock! mutex . args) + (define mutex-lock-inner! + (wrap (lambda () + (catch 'abandoned-mutex-error + (lambda () (apply lock-mutex (cons mutex args))) + (lambda (key . args) (raise abandoned-mutex-exception)))))) + (call/cc mutex-lock-inner!)) + +(define (mutex-unlock! mutex . args) + (apply unlock-mutex (cons mutex args))) + +;; CONDITION VARIABLES +;; These functions are all pass-thrus to the existing Guile implementations. + +(define make-condition-variable + (lambda name + (let ((n (and (pair? name) (car name))) + (m ((@ (guile) make-condition-variable)))) + (and n (hashq-set! object-names m n)) m))) + +(define (condition-variable-name condition-variable) + (hashq-ref object-names (check-arg-type condition-variable? + condition-variable + "condition-variable-name"))) + +(define (condition-variable-specific condition-variable) + (hashq-ref object-specifics (check-arg-type condition-variable? + condition-variable + "condition-variable-specific"))) + +(define (condition-variable-specific-set! condition-variable obj) + (hashq-set! object-specifics + (check-arg-type condition-variable? + condition-variable + "condition-variable-specific-set!") + obj) + *unspecified*) + +(define (condition-variable-signal! cond) + (signal-condition-variable cond) + *unspecified*) + +(define (condition-variable-broadcast! cond) + (broadcast-condition-variable cond) + *unspecified*) + +;; TIME + +(define current-time gettimeofday) +(define (time? obj) + (and (pair? obj) + (let ((co (car obj))) (and (integer? co) (>= co 0))) + (let ((co (cdr obj))) (and (integer? co) (>= co 0))))) + +(define (time->seconds time) + (and (check-arg-type time? time "time->seconds") + (+ (car time) (/ (cdr time) 1000000)))) + +(define (seconds->time x) + (and (check-arg-type number? x "seconds->time") + (let ((fx (truncate x))) + (cons (inexact->exact fx) + (inexact->exact (truncate (* (- x fx) 1000000))))))) + +;; srfi-18.scm ends here
\ No newline at end of file diff --git a/srfi/srfi-19.scm b/srfi/srfi-19.scm index 08302d0c8..96ef3448a 100644 --- a/srfi/srfi-19.scm +++ b/srfi/srfi-19.scm @@ -1,6 +1,6 @@ ;;; srfi-19.scm --- Time/Date Library -;; Copyright (C) 2001, 2002, 2003, 2005, 2006, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2005, 2006, 2007, 2008 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 @@ -193,7 +193,7 @@ (let ((port (open-input-file filename)) (table '())) (let loop ((line (read-line port))) - (if (not (eq? line eof)) + (if (not (eof-object? line)) (begin (let* ((data (read (open-input-string (string-append "(" line ")")))) diff --git a/srfi/srfi-35.scm b/srfi/srfi-35.scm index c9e25ce12..203546625 100644 --- a/srfi/srfi-35.scm +++ b/srfi/srfi-35.scm @@ -1,6 +1,6 @@ ;;; srfi-35.scm --- Conditions -;; Copyright (C) 2007 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2008 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 @@ -37,6 +37,8 @@ &serious serious-condition? &error error?)) +(cond-expand-provide (current-module) '(srfi-35)) + ;;; ;;; Condition types. diff --git a/srfi/srfi-37.scm b/srfi/srfi-37.scm index 481789ed3..5e6d512a2 100644 --- a/srfi/srfi-37.scm +++ b/srfi/srfi-37.scm @@ -1,6 +1,6 @@ ;;; srfi-37.scm --- args-fold -;; Copyright (C) 2007 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2008 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 @@ -151,7 +151,9 @@ program-arguments in ARGS, as decided by the OPTIONS' ;; followed by the remaining short options in (car ARGS). (define (short-option position) (if (>= position (string-length (car args))) - (next-arg) + (begin + (set! args (cdr args)) + (next-arg)) (let* ((opt-name (string-ref (car args) position)) (option-here (hash-ref lookup opt-name))) (cond ((not option-here) diff --git a/srfi/srfi-39.scm b/srfi/srfi-39.scm index ecb6944ff..086751170 100644 --- a/srfi/srfi-39.scm +++ b/srfi/srfi-39.scm @@ -1,45 +1,20 @@ ;;; srfi-39.scm --- Parameter objects -;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005, 2006, 2008 Free Software Foundation, Inc. ;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or -;; (at your option) any later version. +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 2.1 of the License, or (at your option) any later version. ;; -;; This program is distributed in the hope that it will be useful, +;; This library is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. +;; Lesser General Public License for more details. ;; -;; You should have received a copy of the GNU General Public License -;; along with this software; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301 USA -;; -;; As a special exception, the Free Software Foundation gives permission -;; for additional uses of the text contained in its release of GUILE. -;; -;; The exception is that, if you link the GUILE library with other files -;; to produce an executable, this does not by itself cause the -;; resulting executable to be covered by the GNU General Public License. -;; Your use of that executable is in no way restricted on account of -;; linking the GUILE library code into it. -;; -;; This exception does not however invalidate any other reasons why -;; the executable file might be covered by the GNU General Public License. -;; -;; This exception applies only to the code released by the -;; Free Software Foundation under the name GUILE. If you copy -;; code from other Free Software Foundation releases into a copy of -;; GUILE, as the General Public License permits, the exception does -;; not apply to the code that you add in this way. To avoid misleading -;; anyone as to the status of such modified files, you must delete -;; this exception notice from them. -;; -;; If you write modifications of your own for GUILE, it is your choice -;; whether to permit this exception to apply to your modifications. -;; If you do not wish that, delete this exception notice. +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> ;;; Date: 2004-05-05 diff --git a/srfi/srfi-60.c b/srfi/srfi-60.c index f631c6447..b90306a8e 100644 --- a/srfi/srfi-60.c +++ b/srfi/srfi-60.c @@ -18,7 +18,6 @@ */ #include <libguile.h> -#include "libguile/private-gc.h" /* for SCM_MIN */ #include "srfi-60.h" @@ -332,7 +331,9 @@ SCM_DEFINE (scm_srfi60_integer_to_list, "integer->list", 1, 1, 0, long nn = SCM_I_INUM (n); for (i = 0; i < ll; i++) { - unsigned long shift = SCM_MIN (i, (unsigned long) SCM_LONG_BIT-1); + unsigned long shift = + (i < ((unsigned long) SCM_LONG_BIT-1)) + ? i : ((unsigned long) SCM_LONG_BIT-1); int bit = (nn >> shift) & 1; ret = scm_cons (scm_from_bool (bit), ret); } diff --git a/srfi/srfi-69.scm b/srfi/srfi-69.scm new file mode 100644 index 000000000..7da560b1b --- /dev/null +++ b/srfi/srfi-69.scm @@ -0,0 +1,329 @@ +;;; srfi-69.scm --- Basic hash tables + +;; Copyright (C) 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 +;; License as published by the Free Software Foundation; either +;; version 2.1 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;;; Commentary: + +;; My `hash' is compatible with core `hash', so I replace it. +;; However, my `hash-table?' and `make-hash-table' are different, so +;; importing this module will warn about them. If you don't rename my +;; imports, you shouldn't use both my hash tables and Guile's hash +;; tables in the same module. +;; +;; SRFI-13 `string-hash' and `string-hash-ci' have more arguments, but +;; are compatible with my `string-hash' and `string-ci-hash', and are +;; furthermore primitive in Guile, so I use them as my own. +;; +;; I also have the extension of allowing hash functions that require a +;; second argument to be used as the `hash-table-hash-function', and use +;; these in defaults to avoid an indirection in the hashx functions. The +;; only deviation this causes is: +;; +;; ((hash-table-hash-function (make-hash-table)) obj) +;; error> Wrong number of arguments to #<primitive-procedure hash> +;; +;; I don't think that SRFI 69 actually specifies that I *can't* do this, +;; because it only implies the signature of a hash function by way of the +;; named, exported hash functions. However, if this matters enough I can +;; add a private derivation of hash-function to the srfi-69:hash-table +;; record type, like associator is to equivalence-function. +;; +;; Also, outside of the issue of how weak keys and values are referenced +;; outside the table, I always interpret key equivalence to be that of +;; the `hash-table-equivalence-function'. For example, given the +;; requirement that `alist->hash-table' give earlier associations +;; priority, what should these answer? +;; +;; (hash-table-keys +;; (alist->hash-table '(("xY" . 1) ("Xy" . 2)) string-ci=?)) +;; +;; (let ((ht (make-hash-table string-ci=?))) +;; (hash-table-set! ht "xY" 2) +;; (hash-table-set! ht "Xy" 1) +;; (hash-table-keys ht)) +;; +;; My interpretation is that they can answer either ("Xy") or ("xY"), +;; where `hash-table-values' will of course always answer (1), because +;; the keys are the same according to the equivalence function. In this +;; implementation, both answer ("xY"). However, I don't guarantee that +;; this won't change in the future. + +;;; Code: + +;;;; Module definition & exports + +(define-module (srfi srfi-69) + #:use-module (srfi srfi-1) ;alist-cons,second&c,assoc + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-13) ;string-hash,string-hash-ci + #:use-module (ice-9 optargs) + #:export (;; Type constructors & predicate + make-hash-table hash-table? alist->hash-table + ;; Reflective queries + hash-table-equivalence-function hash-table-hash-function + ;; Dealing with single elements + hash-table-ref hash-table-ref/default hash-table-set! + hash-table-delete! hash-table-exists? hash-table-update! + hash-table-update!/default + ;; Dealing with the whole contents + hash-table-size hash-table-keys hash-table-values + hash-table-walk hash-table-fold hash-table->alist + hash-table-copy hash-table-merge! + ;; Hashing + string-ci-hash hash-by-identity) + #:re-export (string-hash) + #:replace (hash)) + +(cond-expand-provide (current-module) '(srfi-37)) + +;;;; Hashing + +;;; The largest fixnum is in `most-positive-fixnum' in module (guile), +;;; though not documented anywhere but libguile/numbers.c. + +(define (caller-with-default-size hash-fn) + "Answer a function that makes `most-positive-fixnum' the default +second argument to HASH-FN, a 2-arg procedure." + (lambda* (obj #:optional (size most-positive-fixnum)) + (hash-fn obj size))) + +(define hash (caller-with-default-size (@ (guile) hash))) + +(define string-ci-hash string-hash-ci) + +(define hash-by-identity (caller-with-default-size hashq)) + +;;;; Reflective queries, construction, predicate + +(define-record-type srfi-69:hash-table + (make-srfi-69-hash-table real-table associator size weakness + equivalence-function hash-function) + hash-table? + (real-table ht-real-table) + (associator ht-associator) + ;; required for O(1) by SRFI-69. It really makes a mess of things, + ;; and I'd like to compute it in O(n) and memoize it because it + ;; doesn't seem terribly useful, but SRFI-69 is final. + (size ht-size ht-size!) + ;; required for `hash-table-copy' + (weakness ht-weakness) + ;; used only to implement hash-table-equivalence-function; I don't + ;; use it internally other than for `ht-associator'. + (equivalence-function hash-table-equivalence-function) + (hash-function hash-table-hash-function)) + +(define (guess-hash-function equal-proc) + "Guess a hash function for EQUAL-PROC, falling back on `hash', as +specified in SRFI-69 for `make-hash-table'." + (cond ((eq? equal? equal-proc) (@ (guile) hash)) ;shortcut most common case + ((eq? eq? equal-proc) hashq) + ((eq? eqv? equal-proc) hashv) + ((eq? string=? equal-proc) string-hash) + ((eq? string-ci=? equal-proc) string-ci-hash) + (else (@ (guile) hash)))) + +(define (without-keyword-args rest-list) + "Answer REST-LIST with all keywords removed along with items that +follow them." + (let lp ((acc '()) (rest-list rest-list)) + (cond ((null? rest-list) (reverse! acc)) + ((keyword? (first rest-list)) + (lp acc (cddr rest-list))) + (else (lp (cons (first rest-list) acc) (cdr rest-list)))))) + +(define (guile-ht-ctor weakness) + "Answer the Guile HT constructor for the given WEAKNESS." + (case weakness + ((#f) (@ (guile) make-hash-table)) + ((key) make-weak-key-hash-table) + ((value) make-weak-value-hash-table) + ((key-or-value) make-doubly-weak-hash-table) + (else (error "Invalid weak hash table type" weakness)))) + +(define (equivalence-proc->associator equal-proc) + "Answer an `assoc'-like procedure that compares the argument key to +alist keys with EQUAL-PROC." + (cond ((or (eq? equal? equal-proc) + (eq? string=? equal-proc)) (@ (guile) assoc)) + ((eq? eq? equal-proc) assq) + ((eq? eqv? equal-proc) assv) + (else (lambda (item alist) + (assoc item alist equal-proc))))) + +(define* (make-hash-table + #:optional (equal-proc equal?) + (hash-proc (guess-hash-function equal-proc)) + #:key (weak #f) #:rest guile-opts) + "Answer a new hash table using EQUAL-PROC as the comparison +function, and HASH-PROC as the hash function. See the reference +manual for specifics, of which there are many." + (make-srfi-69-hash-table + (apply (guile-ht-ctor weak) (without-keyword-args guile-opts)) + (equivalence-proc->associator equal-proc) + 0 weak equal-proc hash-proc)) + +(define (alist->hash-table alist . mht-args) + "Convert ALIST to a hash table created with MHT-ARGS." + (let* ((result (apply make-hash-table mht-args)) + (size (ht-size result))) + (with-hashx-values (hash-proc associator real-table) result + (for-each (lambda (pair) + (let ((handle (hashx-get-handle hash-proc associator + real-table (car pair)))) + (cond ((not handle) + (set! size (1+ size)) + (hashx-set! hash-proc associator real-table + (car pair) (cdr pair)))))) + alist)) + (ht-size! result size) + result)) + +;;;; Accessing table items + +;; We use this to denote missing or unspecified values to avoid +;; possible collision with *unspecified*. +(define ht-unspecified (cons *unspecified* "ht-value")) + +;; I am a macro only for efficiency, to avoid varargs/apply. +(define-macro (hashx-invoke hashx-proc ht-var . args) + "Invoke HASHX-PROC, a `hashx-*' procedure taking a hash-function, +assoc-function, and the hash-table as first args." + `(,hashx-proc (hash-table-hash-function ,ht-var) + (ht-associator ,ht-var) + (ht-real-table ,ht-var) + . ,args)) + +(define-macro (with-hashx-values bindings ht-var . body-forms) + "Bind BINDINGS to the hash-function, associator, and real-table of +HT-VAR, while evaluating BODY-FORMS." + `(let ((,(first bindings) (hash-table-hash-function ,ht-var)) + (,(second bindings) (ht-associator ,ht-var)) + (,(third bindings) (ht-real-table ,ht-var))) + . ,body-forms)) + +(define (hash-table-ref ht key . default-thunk-lst) + "Lookup KEY in HT and answer the value, invoke DEFAULT-THUNK if KEY +isn't present, or signal an error if DEFAULT-THUNK isn't provided." + (let ((result (hashx-invoke hashx-ref ht key ht-unspecified))) + (if (eq? ht-unspecified result) + (if (pair? default-thunk-lst) + ((first default-thunk-lst)) + (error "Key not in table" key ht)) + result))) + +(define (hash-table-ref/default ht key default) + "Lookup KEY in HT and answer the value. Answer DEFAULT if KEY isn't +present." + (hashx-invoke hashx-ref ht key default)) + +(define (hash-table-set! ht key new-value) + "Set KEY to NEW-VALUE in HT." + (let ((handle (hashx-invoke hashx-create-handle! ht key ht-unspecified))) + (if (eq? ht-unspecified (cdr handle)) + (ht-size! ht (1+ (ht-size ht)))) + (set-cdr! handle new-value)) + *unspecified*) + +(define (hash-table-delete! ht key) + "Remove KEY's association in HT." + (with-hashx-values (h a real-ht) ht + (if (hashx-get-handle h a real-ht key) + (begin + (ht-size! ht (1- (ht-size ht))) + (hashx-remove! h a real-ht key)))) + *unspecified*) + +(define (hash-table-exists? ht key) + "Return whether KEY is a key in HT." + (and (hashx-invoke hashx-get-handle ht key) #t)) + +;;; `hashx-set!' duplicates the hash lookup, but we use it anyway to +;;; avoid creating a handle in case DEFAULT-THUNK exits +;;; `hash-table-update!' non-locally. +(define (hash-table-update! ht key modifier . default-thunk-lst) + "Modify HT's value at KEY by passing its value to MODIFIER and +setting it to the result thereof. Invoke DEFAULT-THUNK for the old +value if KEY isn't in HT, or signal an error if DEFAULT-THUNK is not +provided." + (with-hashx-values (hash-proc associator real-table) ht + (let ((handle (hashx-get-handle hash-proc associator real-table key))) + (cond (handle + (set-cdr! handle (modifier (cdr handle)))) + (else + (hashx-set! hash-proc associator real-table key + (if (pair? default-thunk-lst) + (modifier ((car default-thunk-lst))) + (error "Key not in table" key ht))) + (ht-size! ht (1+ (ht-size ht))))))) + *unspecified*) + +(define (hash-table-update!/default ht key modifier default) + "Modify HT's value at KEY by passing its old value, or DEFAULT if it +doesn't have one, to MODIFIER, and setting it to the result thereof." + (hash-table-update! ht key modifier (lambda () default))) + +;;;; Accessing whole tables + +(define (hash-table-size ht) + "Return the number of associations in HT. This is guaranteed O(1) +for tables where #:weak was #f or not specified at creation time." + (if (ht-weakness ht) + (hash-table-fold ht (lambda (k v ans) (1+ ans)) 0) + (ht-size ht))) + +(define (hash-table-keys ht) + "Return a list of the keys in HT." + (hash-table-fold ht (lambda (k v lst) (cons k lst)) '())) + +(define (hash-table-values ht) + "Return a list of the values in HT." + (hash-table-fold ht (lambda (k v lst) (cons v lst)) '())) + +(define (hash-table-walk ht proc) + "Call PROC with each key and value as two arguments." + (hash-table-fold ht (lambda (k v unspec) (proc k v) unspec) + *unspecified*)) + +(define (hash-table-fold ht f knil) + "Invoke (F KEY VAL PREV) for each KEY and VAL in HT, where PREV is +the result of the previous invocation, using KNIL as the first PREV. +Answer the final F result." + (hash-fold f knil (ht-real-table ht))) + +(define (hash-table->alist ht) + "Return an alist for HT." + (hash-table-fold ht alist-cons '())) + +(define (hash-table-copy ht) + "Answer a copy of HT." + (with-hashx-values (h a real-ht) ht + (let* ((size (hash-table-size ht)) (weak (ht-weakness ht)) + (new-real-ht ((guile-ht-ctor weak) size))) + (hash-fold (lambda (k v ign) (hashx-set! h a new-real-ht k v)) + #f real-ht) + (make-srfi-69-hash-table ;real,assoc,size,weak,equiv,h + new-real-ht a size weak + (hash-table-equivalence-function ht) h)))) + +(define (hash-table-merge! ht other-ht) + "Add all key/value pairs from OTHER-HT to HT, overriding HT's +mappings where present. Return HT." + (hash-table-fold + ht (lambda (k v ign) (hash-table-set! ht k v)) #f) + ht) + +;;; srfi-69.scm ends here diff --git a/srfi/srfi-88.scm b/srfi/srfi-88.scm new file mode 100644 index 000000000..ebde81d0b --- /dev/null +++ b/srfi/srfi-88.scm @@ -0,0 +1,50 @@ +;;; srfi-88.scm --- Keyword Objects + +;; Copyright (C) 2008 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 +;; License as published by the Free Software Foundation; either +;; version 2.1 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;; Author: Ludovic Courtès <ludo@gnu.org> + +;;; Commentary: + +;; This is a convenience module providing SRFI-88 "keyword object". All it +;; does is setup the right reader option and export keyword-related +;; convenience procedures. + +;;; Code: + +(define-module (srfi srfi-88) + #:re-export (keyword?) + #:export (keyword->string string->keyword)) + +(cond-expand-provide (current-module) '(srfi-88)) + + +(read-set! keywords 'postfix) + +(define (keyword->string k) + "Return the name of @var{k} as a string." + (symbol->string (keyword->symbol k))) + +(define (string->keyword s) + "Return the keyword object whose name is @var{s}." + (symbol->keyword (string->symbol s))) + +;;; Local Variables: +;;; coding: latin-1 +;;; End: + +;;; srfi-88.scm ends here diff --git a/test-suite/COPYING b/test-suite/COPYING deleted file mode 100644 index e69de29bb..000000000 --- a/test-suite/COPYING +++ /dev/null diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index a48a11c12..433431a77 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,159 @@ +2008-08-27 Ludovic Courtès <ludo@gnu.org> + + * tests/srfi-18.test: Don't run the tests unless + "(provided? 'threads)" is true. + +2008-08-25 Ludovic Courtès <ludo@gnu.org> + + * standalone/Makefile.am (test_cflags): Add `$(GCC_CFLAGS)'. + +2008-08-19 Ludovic Courtès <ludo@gnu.org> + + * tests/goops.test (object update)[changing class, `hell' in + `goops.c' grows as expected]: New tests. + +2008-07-06 Ludovic Courtès <ludo@gnu.org> + + * standalone/test-asmobs, standalone/test-bad-identifiers, + standalone/test-require-extension, standalone/test-system-cmds: + Invoke `guile' with `-q'. + +2008-06-02 Ludovic Courtès <ludo@gnu.org> + + * standalone/test-conversion.c: Support systems whose + <inttypes.h> doesn't define `PRIiMAX'. Reported by Peter + O'Gorman <pogma@thewrittenword.com>. + +2008-05-31 Ludovic Courtès <ludo@gnu.org> + + * standalone/test-gh.c (string_equal): Use `scm_c_string_length ()' + instead of `scm_i_string_length ()'. + +2008-05-15 Julian Graham <joolean@gmail.com> + + * tests/srfi-18.test: New file. + +2008-05-14 Julian Graham <joolean@gmail.com> + + * tests/threads.test (mutex-ownership, mutex-lock-levels): New + test prefix. + (mutex ownership for locked mutex, mutex ownership for unlocked + mutex, locking mutex on behalf of other thread, locking mutex + with no owner, unlocked level is 0, non-recursive lock level + is 1, recursive lock level is >1): New tests. + +2008-04-28 Ludovic Courtès <ludo@gnu.org> + + * tests/srfi-1.test (partition)[with improper list]: New test. + (partition!)[with improper list]: New test. + +2008-04-26 Ludovic Courtès <ludo@gnu.org> + + * standalone/Makefile.am (TESTS): Only add + `test-with-guile-module' when `BUILD_PTHREAD_SUPPORT' is true. + Reported by Alain Guibert <alguibert+bts@free.fr>. + +2008-04-26 Ludovic Courtès <ludo@gnu.org> + + * tests/srfi-35.test (cond-expand): New test. + +2008-04-26 Ludovic Courtès <ludo@gnu.org> + + * Makefile.am (SCM_TESTS): Add `tests/srfi-88.test'. + * tests/srfi-88.test: New file. + +2008-04-15 Ludovic Courtès <ludo@gnu.org> + + * tests/reader.test (read-options)[prefix non-keywords, postfix + keywords, `:' is not a postfix keyword (per SRFI-88)]: New tests. + +2008-04-13 Ludovic Courtès <ludo@gnu.org> + + * tests/goops.test (defining classes)[interaction with + `struct-ref', interaction with `struct-set!']: New test. Checks + the interaction of `struct-ref' with "light structs", fixed on + 2008-04-10 (commit 4650d115020924e8da5547d4c346cbe5cd01029e). + +2008-04-06 Ludovic Courtès <ludo@gnu.org> + + * standalone/test-asmobs-lib.c, standalone/test-conversion.c, + standalone/test-gh.c, standalone/test-list.c, + standalone/test-num2integral.c, standalone/test-round.c: Make + sure "config.h" is included first; use angle brackets for + <config.h> and <libguile.h>. + +2008-03-13 Ludovic Courtès <ludo@gnu.org> + + * standalone/Makefile.am (test_cflags): Add `-I' flags for + Gnulib, so that <alloca.h> can be found. + (snarfcppopts): Likewise. + + * tests/socket.test (temp-file-path): New. Replace calls to + `tmpnam' with calls to `temp-file-path', so that `$TMPDIR' is + honored. + * standalone/test-unwind.c (check_ports): Honor `$TMPDIR'. + +2008-03-12 Ludovic Courtès <ludo@gnu.org> + + * tests/srfi-37.test (short options without arguments): New + test. + +2008-02-23 Neil Jerram <neil@ossau.uklinux.net> + + * standalone/test-with-guile-module.c: Updated to GNU coding + standards; added standard license statement. + +2008-02-15 Ludovic Courtès <ludo@gnu.org> + + * tests/gc.test (gc): Add hack to clean up the stack so that the + test passes on SPARC. + +2008-02-01 Neil Jerram <neil@ossau.uklinux.net> + + * standalone/Makefile.am: Add stanza for test-with-guile-module. + + * standalone/test-with-guile-module.c: New test. + +2008-01-22 Neil Jerram <neil@ossau.uklinux.net> + + * COPYING: Removed. + +2008-01-18 Neil Jerram <neil@ossau.uklinux.net> + + * tests/hash.test: New "hashx" test supplied by Gregory Marton; + prior to today's fix in libguile/hashtab.c, this caused a + segmentation fault. + +2007-12-29 Neil Jerram <neil@ossau.uklinux.net> + + * standalone/test-bad-identifiers: New test. + (top level): Explain the point of this test. + + * standalone/Makefile.am (check_SCRIPTS, TESTS): Add it. + +2007-12-13 Stephen Compall <s11@member.fsf.org> + + * tests/srfi-69.test (SRFI-69)[can use all arguments, including + size]: New test. + +2007-12-03 Stephen Compall <s11@member.fsf.org> + + * tests/srfi-69.test: New file. + * Makefile.am: Add it. + +2007-10-21 Neil Jerram <neil@ossau.uklinux.net> + + * tests/continuations.test ("continuations"): Use + with-debugging-evaluator. + + * lib.scm (with-debugging-evaluator*, with-debugging-evaluator): + New utilities. + + * standalone/test-use-srfi: Use -q to avoid picking up the user's + ~/.guile file. + + * tests/eval.test (promises)[unmemoizing a promise]: New test. + 2007-10-20 Julian Graham <joolean@gmail.com> * tests/threads.test: Use proper `define-module'. @@ -193,7 +349,7 @@ 2006-12-24 Han-Wen Nienhuys <hanwen@lilypond.org> * tests/numbers.test ("equal?"): add case for reduction of - rational numbers. + rational numbers. 2006-12-13 Kevin Ryde <user42@zip.com.au> @@ -480,7 +636,7 @@ * tests/guardians.test: Adapted to new (original) semantics. test guardingobjects multiple times. - + 2005-06-12 Marius Vollmer <mvo@zagadka.de> * standalone/test-gh.c: Do nothing when deprecated things are @@ -506,7 +662,7 @@ * tests/unif.test (array-in-bounds?): Add a test failing in the current code. - + 2005-05-07 Kevin Ryde <user42@zip.com.au> * tests/srfi-1.test (car+cdr, fold, last, list-index, list-tabulate, @@ -933,7 +1089,7 @@ * standalone/test-conversion.c: Don't define SCM_T_INTMAX_MIN, etc, they are now provided by libuile.h. (test_int_sizes): New. - + 2004-07-06 Marius Vollmer <marius.vollmer@uni-dortmund.de> * standalone/test-num2integral.c, standalone/test-unwind.c: @@ -1052,7 +1208,7 @@ real/big combinations, collect up tests under arg types for clarity. 2004-03-26 Eric Hanchrow <offby1@blarg.net> - + * tests/numbers.test (modulo-expt): New tests. 2004-03-24 Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> @@ -1107,7 +1263,7 @@ * tests/r5rs_pitfall.scm: New. * Makefile.am (SCM_TESTS): Added it. - + 2004-01-11 Kevin Ryde <user42@zip.com.au> * tests/exceptions.test (false-if-exception): Disable tests on @@ -1475,7 +1631,7 @@ * tests/numbers.test (truncate, round, asinh, acosh, atanh): Add some tests. - + 2003-06-19 Kevin Ryde <user42@zip.com.au> * tests/posix.test: New file, exercising putenv, setenv, unsetenv. @@ -1504,7 +1660,7 @@ recent scm_logcount change. * tests/reader.test (reading): Test bad # error message is formattable. - + 2003-06-01 Dirk Herrmann <D.Herrmann@tu-bs.de> * tests/pairs.test: Added. @@ -1563,7 +1719,7 @@ * tests/numbers.test (-): Add test for negative inum subtract bignum. (logcount): New tests, exercising some negatives. - + 2003-05-03 Marius Vollmer <mvo@zagadka.de> * tests/r5rs_pitfall.test: New. Thanks to Dale P. Smith for diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index ea58cbeaf..e6ea258c5 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright 2001, 2002, 2003, 2004, 2005, 2006, 2007 Software Foundation, Inc. +## Copyright 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -79,6 +79,8 @@ SCM_TESTS = tests/alist.test \ tests/srfi-37.test \ tests/srfi-39.test \ tests/srfi-60.test \ + tests/srfi-69.test \ + tests/srfi-88.test \ tests/srfi-4.test \ tests/srfi-9.test \ tests/strings.test \ diff --git a/test-suite/lib.scm b/test-suite/lib.scm index 2daf95c60..c4ddf9e7c 100644 --- a/test-suite/lib.scm +++ b/test-suite/lib.scm @@ -42,6 +42,9 @@ with-test-prefix with-test-prefix* current-test-prefix format-test-name + ;; Using the debugging evaluator. + with-debugging-evaluator with-debugging-evaluator* + ;; Reporting results in various ways. register-reporter unregister-reporter reporter-registered? make-count-reporter print-counts @@ -408,6 +411,22 @@ (defmacro with-test-prefix (prefix . body) `(with-test-prefix* ,prefix (lambda () ,@body))) +;;; Call THUNK using the debugging evaluator. +(define (with-debugging-evaluator* thunk) + (let ((dopts #f)) + (dynamic-wind + (lambda () + (set! dopts (debug-options)) + (debug-enable 'debug)) + thunk + (lambda () + (debug-options dopts))))) + +;;; Evaluate BODY... using the debugging evaluator. +(define-macro (with-debugging-evaluator . body) + `(with-debugging-evaluator* (lambda () ,@body))) + + ;;;; REPORTERS ;;;; diff --git a/test-suite/standalone/.cvsignore b/test-suite/standalone/.cvsignore index 49fe7fee0..4b495e986 100644 --- a/test-suite/standalone/.cvsignore +++ b/test-suite/standalone/.cvsignore @@ -11,3 +11,4 @@ test-num2integral test-round test-unwind test-list +test-with-guile-module diff --git a/test-suite/standalone/.gitignore b/test-suite/standalone/.gitignore new file mode 100644 index 000000000..96a663d3d --- /dev/null +++ b/test-suite/standalone/.gitignore @@ -0,0 +1,7 @@ +test-conversion +test-gh +test-list +test-num2integral +test-round +test-unwind +test-with-guile-module diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am index 9a3c3a3c0..adbe0c84f 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, 2007 Software Foundation, Inc. +## Copyright 2003, 2004, 2005, 2006, 2007, 2008 Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -26,18 +26,22 @@ noinst_LTLIBRARIES = check_PROGRAMS = check_SCRIPTS = BUILT_SOURCES = +EXTRA_DIST = TESTS_ENVIRONMENT = "${top_builddir}/pre-inst-guile-env" -test_cflags = \ - -I$(top_srcdir)/test-suite/standalone \ - -I$(top_srcdir) \ - $(EXTRA_DEFS) $(GUILE_CFLAGS) +test_cflags = \ + -I$(top_srcdir)/test-suite/standalone \ + -I$(top_srcdir) \ + -I$(top_srcdir)/lib -I$(top_builddir)/lib \ + $(EXTRA_DEFS) $(GUILE_CFLAGS) $(GCC_CFLAGS) AM_LDFLAGS = $(GUILE_CFLAGS) -snarfcppopts = \ - $(DEFS) $(DEFAULT_INCLUDES) $(CPPFLAGS) $(CFLAGS) -I$(top_srcdir) +snarfcppopts = \ + $(DEFS) $(DEFAULT_INCLUDES) $(CPPFLAGS) $(CFLAGS) -I$(top_srcdir) \ + -I$(top_srcdir)/lib -I$(top_builddir)/lib + SUFFIXES = .x .c.x: ${top_builddir}/libguile/guile-snarf -o $@ $< $(snarfcppopts) @@ -49,6 +53,9 @@ CLEANFILES = *.x check_SCRIPTS += test-system-cmds TESTS += test-system-cmds +check_SCRIPTS += test-bad-identifiers +TESTS += test-bad-identifiers + check_SCRIPTS += test-require-extension TESTS += test-require-extension @@ -107,7 +114,21 @@ TESTS += test-conversion check_SCRIPTS += test-use-srfi TESTS += test-use-srfi +if BUILD_PTHREAD_SUPPORT + +# test-with-guile-module +test_with_guile_module_CFLAGS = ${test_cflags} +test_with_guile_module_LDADD = ${top_builddir}/libguile/libguile.la +check_PROGRAMS += test-with-guile-module +TESTS += test-with-guile-module + +else + +EXTRA_DIST += test-with-guile-module.c + +endif + all-local: cd ${srcdir} && chmod u+x ${check_SCRIPTS} -EXTRA_DIST = ${check_SCRIPTS} +EXTRA_DIST += ${check_SCRIPTS} diff --git a/test-suite/standalone/test-asmobs b/test-suite/standalone/test-asmobs index 19557e0f1..2ea75d9bf 100755 --- a/test-suite/standalone/test-asmobs +++ b/test-suite/standalone/test-asmobs @@ -1,5 +1,5 @@ #!/bin/sh -exec guile -s "$0" "$@" +exec guile -q -s "$0" "$@" !# (load-extension "libtest-asmobs" "libtest_asmobs_init") diff --git a/test-suite/standalone/test-asmobs-lib.c b/test-suite/standalone/test-asmobs-lib.c index f3d1634a2..88cf847c5 100644 --- a/test-suite/standalone/test-asmobs-lib.c +++ b/test-suite/standalone/test-asmobs-lib.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1999,2000,2001,2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1999,2000,2001,2003, 2006, 2008 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 @@ -15,7 +15,7 @@ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ -#include "libguile.h" +#include <libguile.h> long asmob000; long asmob100; diff --git a/test-suite/standalone/test-bad-identifiers b/test-suite/standalone/test-bad-identifiers new file mode 100755 index 000000000..e7af5a1d1 --- /dev/null +++ b/test-suite/standalone/test-bad-identifiers @@ -0,0 +1,77 @@ +#!/bin/sh +exec guile -q -s "$0" "$@" +!# + +;; The use of certain identifiers as variable or parameter names has +;; been found to cause build problems on particular platforms. The +;; aim of this test is to cause "make check" to fail (on GNU/Linux, +;; which most Guile developers use) if we accidentally add new code +;; that uses those identifiers. + +(define bad-identifiers + '( + ;; On AIX 5.2 and 5.3, /usr/include/sys/timer.h includes: + ;; #ifndef _LINUX_SOURCE_COMPAT + ;; #define func_data t_union.data + ;; #endif + ;; So we want to avoid using func_data in Guile source code. + "func_data" + + ;; More troublesome identifiers can be added into the list here. + )) + +(use-modules (ice-9 regex) (ice-9 rdelim)) + +(define bad-id-regexp + (make-regexp (string-append "\\<(" + (string-join (map regexp-quote bad-identifiers) "|") + ")\\>"))) + +(define exit-status 0) + +;; Non-exported code from (ice-9 ftw). +(define (directory-files dir) + (let ((dir-stream (opendir dir))) + (let loop ((new (readdir dir-stream)) + (acc '())) + (if (eof-object? new) + (begin + (closedir dir-stream) + acc) + (loop (readdir dir-stream) + (if (or (string=? "." new) ;;; ignore + (string=? ".." new)) ;;; ignore + acc + (cons (in-vicinity dir new) acc))))))) + +(define (directory-files-matching dir pattern) + (let ((file-name-regexp (make-regexp pattern))) + (filter (lambda (fn) + (regexp-exec file-name-regexp fn)) + (directory-files dir)))) + +(let loop ((file-names (directory-files-matching "../../libguile" + "\\.[ch]$"))) + (or (null? file-names) + (begin + (with-input-from-file (car file-names) + (lambda () + (let loop ((linenum 1) (line (read-line))) + (or (eof-object? line) + (begin + (if (regexp-exec bad-id-regexp line) + (begin + (set! exit-status 1) + (format (current-error-port) + "~a:~a: ~a\n" + (car file-names) + linenum + line))) + (loop (+ linenum 1) (read-line))))))) + (loop (cdr file-names))))) + +(exit exit-status) + +;; Local Variables: +;; mode: scheme +;; End: diff --git a/test-suite/standalone/test-conversion.c b/test-suite/standalone/test-conversion.c index 2e8c057fc..92835f244 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, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1999,2000,2001,2003,2004, 2006, 2007, 2008 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 @@ -15,17 +15,21 @@ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ -#include "libguile.h" +#if HAVE_CONFIG_H +# include <config.h> +#endif + +#include <libguile.h> #include <stdio.h> #include <assert.h> #include <string.h> -#include "config.h" - #ifdef HAVE_INTTYPES_H # include <inttypes.h> -#elif (!defined PRIiMAX) +#endif + +#ifndef PRIiMAX # if (defined SIZEOF_LONG_LONG) && (SIZEOF_LONG_LONG >= 8) # define PRIiMAX "lli" # define PRIuMAX "llu" diff --git a/test-suite/standalone/test-gh.c b/test-suite/standalone/test-gh.c index 78cf87fa5..b273b4499 100644 --- a/test-suite/standalone/test-gh.c +++ b/test-suite/standalone/test-gh.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1999,2000,2001,2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1999,2000,2001,2003, 2006, 2008 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 @@ -17,8 +17,8 @@ /* some bits originally by Jim Blandy <jimb@red-bean.com> */ -#include "libguile.h" -#include "libguile/gh.h" +#include <libguile.h> +#include <libguile/gh.h> #include <assert.h> #include <string.h> @@ -31,7 +31,7 @@ string_equal (SCM str, char *lit) int len = strlen (lit); int result; - result = ((scm_i_string_length (str) == len) + result = ((scm_c_string_length (str) == len) && (!memcmp (scm_i_string_chars (str), lit, len))); scm_remember_upto_here_1 (str); return result; diff --git a/test-suite/standalone/test-list.c b/test-suite/standalone/test-list.c index 7a9514ae9..3396dff83 100644 --- a/test-suite/standalone/test-list.c +++ b/test-suite/standalone/test-list.c @@ -1,6 +1,6 @@ /* test-list.c - exercise libguile/list.c functions */ -/* Copyright (C) 2006 Free Software Foundation, Inc. +/* Copyright (C) 2006, 2008 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 @@ -17,7 +17,7 @@ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ -#include "libguile.h" +#include <libguile.h> #include <stdio.h> #include <assert.h> diff --git a/test-suite/standalone/test-num2integral.c b/test-suite/standalone/test-num2integral.c index 86c3e5db7..d2de418e9 100644 --- a/test-suite/standalone/test-num2integral.c +++ b/test-suite/standalone/test-num2integral.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, 2008 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 @@ -15,7 +15,7 @@ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ -#include "libguile.h" +#include <libguile.h> #include <stdio.h> #include <assert.h> diff --git a/test-suite/standalone/test-require-extension b/test-suite/standalone/test-require-extension index 730137b55..69f18589a 100755 --- a/test-suite/standalone/test-require-extension +++ b/test-suite/standalone/test-require-extension @@ -7,12 +7,12 @@ set -e # (Note the syntax "! guile -c ..." isn't used here, because that doesn't # work on Solaris 10.) # -guile -c '(require-extension 7)' 2>/dev/null && exit 1 -guile -c '(require-extension (blarg))' 2>/dev/null && exit 1 -guile -c '(require-extension (srfi "foo"))' 2>/dev/null && exit 1 +guile -q -c '(require-extension 7)' 2>/dev/null && exit 1 +guile -q -c '(require-extension (blarg))' 2>/dev/null && exit 1 +guile -q -c '(require-extension (srfi "foo"))' 2>/dev/null && exit 1 # expect these to succeed -guile -c '(require-extension (srfi 1)) (exit (procedure? take-right))' -guile -c '(require-extension (srfi))' +guile -q -c '(require-extension (srfi 1)) (exit (procedure? take-right))' +guile -q -c '(require-extension (srfi))' exit 0 diff --git a/test-suite/standalone/test-round.c b/test-suite/standalone/test-round.c index a3928d26b..9725491c9 100644 --- a/test-suite/standalone/test-round.c +++ b/test-suite/standalone/test-round.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2004, 2006, 2008 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 @@ -15,7 +15,9 @@ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ -#include "config.h" +#if HAVE_CONFIG_H +# include <config.h> +#endif #include <assert.h> #include <math.h> @@ -25,7 +27,7 @@ #include <fenv.h> #endif -#include "libguile.h" +#include <libguile.h> #define numberof(x) (sizeof (x) / sizeof ((x)[0])) diff --git a/test-suite/standalone/test-system-cmds b/test-suite/standalone/test-system-cmds index d0e4a6991..f5007297e 100755 --- a/test-suite/standalone/test-system-cmds +++ b/test-suite/standalone/test-system-cmds @@ -1,5 +1,5 @@ #!/bin/sh -exec guile -s "$0" "$@" +exec guile -q -s "$0" "$@" !# (define (test-system-cmd) diff --git a/test-suite/standalone/test-unwind.c b/test-suite/standalone/test-unwind.c index e2971beeb..472887abe 100644 --- a/test-suite/standalone/test-unwind.c +++ b/test-suite/standalone/test-unwind.c @@ -1,8 +1,36 @@ +/* Copyright (C) 2004, 2005, 2008 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 + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + */ + +#if HAVE_CONFIG_H +# include <config.h> +#endif + +#include <alloca.h> + #include <libguile.h> #include <stdlib.h> #include <stdio.h> #include <unistd.h> +#ifdef HAVE_STRING_H +# include <string.h> +#endif + + void set_flag (void *data); void func1 (void); void func2 (void); @@ -170,7 +198,17 @@ delete_file (void *data) void check_ports () { - char filename[] = "/tmp/check-ports.XXXXXX"; +#define FILENAME_TEMPLATE "/check-ports.XXXXXX" + char *filename; + const char *tmpdir = getenv ("TMPDIR"); + + if (tmpdir == NULL) + tmpdir = "/tmp"; + + filename = (char *) alloca (strlen (tmpdir) + + sizeof (FILENAME_TEMPLATE) + 1); + strcpy (filename, tmpdir); + strcat (filename, FILENAME_TEMPLATE); if (mktemp (filename) == NULL) exit (1); @@ -205,6 +243,7 @@ check_ports () } } scm_dynwind_end (); +#undef FILENAME_TEMPLATE } void diff --git a/test-suite/standalone/test-use-srfi b/test-suite/standalone/test-use-srfi index 309b3bda7..7186b5a24 100755 --- a/test-suite/standalone/test-use-srfi +++ b/test-suite/standalone/test-use-srfi @@ -19,14 +19,14 @@ # Test that two srfi numbers on the command line work. # -guile --use-srfi=1,10 >/dev/null <<EOF +guile -q --use-srfi=1,10 >/dev/null <<EOF (if (and (defined? 'partition) (defined? 'define-reader-ctor)) (exit 0) ;; good (exit 1)) ;; bad EOF if test $? = 0; then :; else - echo "guile --user-srfi=1,10 fails to run" + echo "guile --use-srfi=1,10 fails to run" exit 1 fi @@ -38,7 +38,7 @@ fi # `top-repl' the core bindings got ahead of anything --use-srfi gave. # -guile --use-srfi=1 >/dev/null <<EOF +guile -q --use-srfi=1 >/dev/null <<EOF (catch #t (lambda () (iota 2 3 4)) @@ -47,7 +47,7 @@ guile --use-srfi=1 >/dev/null <<EOF (exit 0) ;; good EOF if test $? = 0; then :; else - echo "guile --user-srfi=1 doesn't give SRFI-1 iota" + echo "guile --use-srfi=1 doesn't give SRFI-1 iota" exit 1 fi @@ -56,12 +56,12 @@ fi # exercises duplicates handling in `top-repl' versus `use-srfis' (in # boot-9.scm). # -guile --use-srfi=17 >/dev/null <<EOF +guile -q --use-srfi=17 >/dev/null <<EOF (if (procedure-with-setter? car) (exit 0) ;; good (exit 1)) ;; bad EOF if test $? = 0; then :; else - echo "guile --user-srfi=17 doesn't give SRFI-17 car" + echo "guile --use-srfi=17 doesn't give SRFI-17 car" exit 1 fi diff --git a/test-suite/standalone/test-with-guile-module.c b/test-suite/standalone/test-with-guile-module.c new file mode 100644 index 000000000..14d3afdc7 --- /dev/null +++ b/test-suite/standalone/test-with-guile-module.c @@ -0,0 +1,77 @@ +/* Copyright (C) 2008 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 + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + */ + +#include <pthread.h> +#include <libguile.h> + +void *thread_inner_main (void *unused); +void *thread_main (void *unused); +void *do_join (void *data); +void *inner_main (void *unused); + +void * +thread_inner_main (void *unused) +{ + int argc = 3; + char *argv[] = { + "guile", + "-c", + "(or (current-module) (exit -1))", + 0 + }; + + scm_shell (argc, argv); + + return NULL; /* dummy */ +} + +void * +thread_main (void *unused) +{ + scm_with_guile (&thread_inner_main, NULL); + + return NULL; /* dummy */ +} + +void * +do_join (void *data) +{ + pthread_t *thread = (pthread_t *) data; + + pthread_join (*thread, NULL); + + return NULL; /* dummy */ +} + +void * +inner_main (void *unused) +{ + pthread_t thread; + + pthread_create (&thread, NULL, &thread_main, NULL); + scm_without_guile (do_join, &thread); + + return NULL; /* dummy */ +} + +int +main (int argc, char **argv) +{ + scm_with_guile (&inner_main, NULL); + + return 0; +} diff --git a/test-suite/tests/continuations.test b/test-suite/tests/continuations.test index c1b6803cb..7d76b762b 100644 --- a/test-suite/tests/continuations.test +++ b/test-suite/tests/continuations.test @@ -53,8 +53,7 @@ (pass-if "throwing to a rewound catch context" (eq? (dont-crash-please) 'no-reentry)) - (let ((dopts (debug-options))) - (debug-enable 'debug) + (with-debugging-evaluator (pass-if "make a stack from a continuation" (stack? (call-with-current-continuation make-stack))) @@ -64,8 +63,6 @@ (or (boolean? id) (symbol? id)))) (pass-if "get a continuation's innermost frame" - (pair? (call-with-current-continuation last-stack-frame))) - - (debug-options dopts)) + (pair? (call-with-current-continuation last-stack-frame)))) ) diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test index 519e2c0a1..b6ddb7b06 100644 --- a/test-suite/tests/eval.test +++ b/test-suite/tests/eval.test @@ -294,7 +294,23 @@ (pass-if-exception "implicit forcing is not supported" exception:wrong-type-arg - (+ (delay (* 3 7)) 13)))) + (+ (delay (* 3 7)) 13)) + + ;; Tests that require the debugging evaluator... + (with-debugging-evaluator + + (pass-if "unmemoizing a promise" + (display-backtrace + (let ((stack #f)) + (false-if-exception (lazy-catch #t + (lambda () + (let ((f (lambda (g) (delay (g))))) + (force (f error)))) + (lambda _ + (set! stack (make-stack #t))))) + stack) + (%make-void-port "w")) + #t)))) ;;; ;;; letrec init evaluation diff --git a/test-suite/tests/gc.test b/test-suite/tests/gc.test index d881aba17..0fdfaaf6d 100644 --- a/test-suite/tests/gc.test +++ b/test-suite/tests/gc.test @@ -1,5 +1,5 @@ ;;;; gc.test --- test guile's garbage collection -*- scheme -*- -;;;; Copyright (C) 2000, 2001, 2004, 2006, 2007 Free Software Foundation, Inc. +;;;; Copyright (C) 2000, 2001, 2004, 2006, 2007, 2008 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 @@ -66,6 +66,15 @@ (total 1000)) (for-each (lambda (x) (guard (make-module))) (iota total)) + + ;; XXX: This hack aims to clean up the stack to make sure we + ;; don't leave a reference to one of the modules we created. It + ;; proved to be useful on SPARC: + ;; http://lists.gnu.org/archive/html/guile-devel/2008-02/msg00006.html . + (let cleanup ((i 10)) + (and (> i 0) + (begin (cleanup (1- i)) i))) + (gc) (gc) ;; twice: have to kill the weak vectors. (= (length (filter (lambda (x) diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test index 8ed697c59..713132a43 100644 --- a/test-suite/tests/goops.test +++ b/test-suite/tests/goops.test @@ -1,6 +1,6 @@ ;;;; goops.test --- test suite for GOOPS -*- scheme -*- ;;;; -;;;; Copyright (C) 2001,2003,2004, 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 2001,2003,2004, 2006, 2008 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 @@ -18,7 +18,8 @@ ;;;; Boston, MA 02110-1301 USA (define-module (test-suite test-goops) - #:use-module (test-suite lib)) + #:use-module (test-suite lib) + #:autoload (srfi srfi-1) (unfold)) (pass-if "GOOPS loads" (false-if-exception @@ -148,7 +149,31 @@ #t) (lambda args #f))) - )) + + (pass-if "interaction with `struct-ref'" + (eval '(define-class <class-struct> () + (foo #:init-keyword #:foo) + (bar #:init-keyword #:bar)) + (current-module)) + (eval '(let ((x (make <class-struct> + #:foo 'hello + #:bar 'world))) + (and (struct? x) + (eq? (struct-ref x 0) 'hello) + (eq? (struct-ref x 1) 'world))) + (current-module))) + + (pass-if "interaction with `struct-set!'" + (eval '(define-class <class-struct-2> () + (foo) (bar)) + (current-module)) + (eval '(let ((x (make <class-struct-2>))) + (struct-set! x 0 'hello) + (struct-set! x 1 'world) + (and (struct? x) + (eq? (struct-ref x 0) 'hello) + (eq? (struct-ref x 1) 'world))) + (current-module))))) (with-test-prefix "defining generics" @@ -253,7 +278,77 @@ (y #:accessor y #:init-value 456) (z #:accessor z #:init-value 789)) (current-module)) - (eval '(and (= (y foo) 456) (= (z foo) 789)) (current-module)))) + (eval '(and (= (y foo) 456) (= (z foo) 789)) (current-module))) + + (pass-if "changing class" + (let* ((c1 (class () (the-slot #:init-keyword #:value))) + (c2 (class () (the-slot #:init-keyword #:value) + (the-other-slot #:init-value 888))) + (o1 (make c1 #:value 777))) + (and (is-a? o1 c1) + (not (is-a? o1 c2)) + (equal? (slot-ref o1 'the-slot) 777) + (let ((o2 (change-class o1 c2))) + (and (eq? o1 o2) + (is-a? o2 c2) + (not (is-a? o2 c1)) + (equal? (slot-ref o2 'the-slot) 777)))))) + + (pass-if "`hell' in `goops.c' grows as expected" + ;; This snippet yielded a segfault prior to the 2008-08-19 `goops.c' + ;; fix (i.e., Guile 1.8.5 and earlier). The root of the problem was + ;; that `go_to_hell ()' would not reallocate enough room for the `hell' + ;; array, leading to out-of-bounds accesses. + + (let* ((parent-class (class () + #:name '<class-that-will-be-redefined>)) + (classes + (unfold (lambda (i) (>= i 20)) + (lambda (i) + (make-class (list parent-class) + '((the-slot #:init-value #:value) + (the-other-slot)) + #:name (string->symbol + (string-append "<foo-to-redefine-" + (number->string i) + ">")))) + (lambda (i) + (+ 1 i)) + 0)) + (objects + (map (lambda (class) + (make class #:value 777)) + classes))) + + (define-method (change-class (foo parent-class) + (new <class>)) + ;; Called by `scm_change_object_class ()', via `purgatory ()'. + (if (null? classes) + (next-method) + (let ((class (car classes)) + (object (car objects))) + (set! classes (cdr classes)) + (set! objects (cdr objects)) + + ;; Redefine the class so that its instances are eventually + ;; passed to `scm_change_object_class ()'. This leads to + ;; nested `scm_change_object_class ()' calls, which increases + ;; the size of HELL and increments N_HELL. + (class-redefinition class + (make-class '() (class-slots class) + #:name (class-name class))) + + ;; Use `slot-ref' to trigger the `scm_change_object_class ()' + ;; and `go_to_hell ()' calls. + (slot-ref object 'the-slot) + + (next-method)))) + + + ;; Initiate the whole `change-class' chain. + (let* ((class (car classes)) + (object (change-class (car objects) class))) + (is-a? object class))))) (with-test-prefix "object comparison" (pass-if "default method" diff --git a/test-suite/tests/hash.test b/test-suite/tests/hash.test index 8215df118..959c28541 100644 --- a/test-suite/tests/hash.test +++ b/test-suite/tests/hash.test @@ -1,6 +1,6 @@ ;;;; hash.test --- test guile hashing -*- scheme -*- ;;;; -;;;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 2004, 2005, 2006, 2008 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 @@ -72,3 +72,14 @@ (hashx-set! hashq assq table 'x 123) (hashx-remove! hashq assq table 'x) (null? (hash-map->list noop table))))) + +;;; +;;; hashx +;;; + +(with-test-prefix "hashx" + (pass-if-exception + "hashx-set! (lambda (k s) 1) (lambda (k al) #t) table 'foo 'bar" + exception:wrong-type-arg + (hashx-set! (lambda (k s) 1) (lambda (k al) #t) (make-hash-table) 'foo 'bar)) + ) diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test index d6047a2d3..0b13cf1c0 100644 --- a/test-suite/tests/reader.test +++ b/test-suite/tests/reader.test @@ -1,6 +1,6 @@ ;;;; reader.test --- Exercise the reader. -*- Scheme -*- ;;;; -;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007, 2008 Free Software Foundation, Inc. ;;;; Jim Blandy <jimb@red-bean.com> ;;;; ;;;; This library is free software; you can redistribute it and/or @@ -149,6 +149,20 @@ (with-read-options '(keywords prefix case-insensitive) (lambda () (read-string ":KeyWord"))))) + (pass-if "prefix non-keywords" + (symbol? (with-read-options '(keywords prefix) + (lambda () + (read-string "srfi88-keyword:"))))) + (pass-if "postfix keywords" + (eq? #:keyword + (with-read-options '(keywords postfix) + (lambda () + (read-string "keyword:"))))) + (pass-if "`:' is not a postfix keyword (per SRFI-88)" + (eq? ': + (with-read-options '(keywords postfix) + (lambda () + (read-string ":"))))) (pass-if "no positions" (let ((sexp (with-read-options '() (lambda () diff --git a/test-suite/tests/socket.test b/test-suite/tests/socket.test index f5fc2be89..4bfc41557 100644 --- a/test-suite/tests/socket.test +++ b/test-suite/tests/socket.test @@ -1,6 +1,6 @@ ;;;; socket.test --- test socket functions -*- scheme -*- ;;;; -;;;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +;;;; Copyright (C) 2004, 2005, 2006, 2007, 2008 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 @@ -174,6 +174,15 @@ ;;; AF_UNIX sockets and `make-socket-address' ;;; +(define (temp-file-path) + ;; Return a temporary file path that honors `$TMPDIR', which `tmpnam' + ;; doesn't do. + (let ((dir (or (getenv "TMPDIR") "/tmp"))) + (string-append dir "/guile-test-socket-" + (number->string (current-time)) "-" + (number->string (random 100000))))) + + (if (defined? 'AF_UNIX) (with-test-prefix "AF_UNIX/SOCK_DGRAM" @@ -181,7 +190,7 @@ (let ((server-socket (socket AF_UNIX SOCK_DGRAM 0)) (server-bound? #f) - (path (tmpnam))) + (path (temp-file-path))) (pass-if "bind" (catch 'system-error @@ -196,7 +205,7 @@ (pass-if "bind/sockaddr" (let* ((sock (socket AF_UNIX SOCK_STREAM 0)) - (path (tmpnam)) + (path (temp-file-path)) (sockaddr (make-socket-address AF_UNIX path))) (catch 'system-error (lambda () @@ -233,7 +242,7 @@ (server-bound? #f) (server-listening? #f) (server-pid #f) - (path (tmpnam))) + (path (temp-file-path))) (pass-if "bind" (catch 'system-error @@ -248,7 +257,7 @@ (pass-if "bind/sockaddr" (let* ((sock (socket AF_UNIX SOCK_STREAM 0)) - (path (tmpnam)) + (path (temp-file-path)) (sockaddr (make-socket-address AF_UNIX path))) (catch 'system-error (lambda () diff --git a/test-suite/tests/srfi-1.test b/test-suite/tests/srfi-1.test index 22c4a9a68..4f2838744 100644 --- a/test-suite/tests/srfi-1.test +++ b/test-suite/tests/srfi-1.test @@ -1,6 +1,6 @@ ;;;; srfi-1.test --- Test suite for Guile's SRFI-1 functions. -*- scheme -*- ;;;; -;;;; Copyright 2003, 2004, 2005, 2006 Free Software Foundation, Inc. +;;;; Copyright 2003, 2004, 2005, 2006, 2008 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 @@ -2068,7 +2068,11 @@ (make-list 10000 1))) (lambda (even odd) (and (= (length odd) 10000) - (= (length even) 0)))))) + (= (length even) 0))))) + + (pass-if-exception "with improper list" + exception:wrong-type-arg + (partition symbol? '(a b . c)))) ;; ;; partition! @@ -2111,7 +2115,11 @@ (make-list 10000 1))) (lambda (even odd) (and (= (length odd) 10000) - (= (length even) 0)))))) + (= (length even) 0))))) + + (pass-if-exception "with improper list" + exception:wrong-type-arg + (partition! symbol? (cons* 'a 'b 'c)))) ;; ;; reduce diff --git a/test-suite/tests/srfi-18.test b/test-suite/tests/srfi-18.test new file mode 100644 index 000000000..fa309e6ce --- /dev/null +++ b/test-suite/tests/srfi-18.test @@ -0,0 +1,481 @@ +;;;; srfi-18.test --- Test suite for Guile's SRFI-18 functions. -*- scheme -*- +;;;; Julian Graham, 2007-10-26 +;;;; +;;;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. +;;;; +;;;; This program is free software; you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation; either version 2, or (at your option) +;;;; any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this software; see the file COPYING. If not, write to +;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;;;; Boston, MA 02110-1301 USA + +(define-module (test-suite test-srfi-18) + #:use-module (test-suite lib)) + +(and (provided? 'threads) + (use-modules (srfi srfi-18)) + +(with-test-prefix "current-thread" + + (pass-if "current-thread eq current-thread" + (eq? (current-thread) (current-thread)))) + +(with-test-prefix "thread?" + + (pass-if "current-thread is thread" + (thread? (current-thread))) + + (pass-if "foo not thread" + (not (thread? 'foo)))) + +(with-test-prefix "make-thread" + + (pass-if "make-thread creates new thread" + (let* ((n (length (all-threads))) + (t (make-thread (lambda () 'foo) 'make-thread-1)) + (r (> (length (all-threads)) n))) + (thread-terminate! t) r))) + +(with-test-prefix "thread-name" + + (pass-if "make-thread with name binds name" + (let* ((t (make-thread (lambda () 'foo) 'thread-name-1)) + (r (eq? (thread-name t) 'thread-name-1))) + (thread-terminate! t) r)) + + (pass-if "make-thread without name does not bind name" + (let* ((t (make-thread (lambda () 'foo))) + (r (not (thread-name t)))) + (thread-terminate! t) r))) + +(with-test-prefix "thread-specific" + + (pass-if "thread-specific is initially #f" + (let* ((t (make-thread (lambda () 'foo) 'thread-specific-1)) + (r (not (thread-specific t)))) + (thread-terminate! t) r)) + + (pass-if "thread-specific-set! can set value" + (let ((t (make-thread (lambda () 'foo) 'thread-specific-2))) + (thread-specific-set! t "hello") + (let ((r (equal? (thread-specific t) "hello"))) + (thread-terminate! t) r)))) + +(with-test-prefix "thread-start!" + + (pass-if "thread activates only after start" + (let* ((started #f) + (m (make-mutex 'thread-start-mutex)) + (t (make-thread (lambda () (set! started #t)) 'thread-start-1))) + (and (not started) (thread-start! t) (thread-join! t) started)))) + +(with-test-prefix "thread-yield!" + + (pass-if "thread yield suceeds" + (thread-yield!) #t)) + +(with-test-prefix "thread-sleep!" + + (pass-if "thread sleep with time" + (let ((future-time (seconds->time (+ (time->seconds (current-time)) 2)))) + (unspecified? (thread-sleep! future-time)))) + + (pass-if "thread sleep with number" + (let ((old-secs (car (current-time)))) + (unspecified? (thread-sleep! (+ (time->seconds (current-time))))))) + + (pass-if "thread does not sleep on past time" + (let ((past-time (seconds->time (- (time->seconds (current-time)) 2)))) + (unspecified? (thread-sleep! past-time))))) + +(with-test-prefix "thread-terminate!" + + (pass-if "termination destroys non-started thread" + (let ((t (make-thread (lambda () 'nothing) 'thread-terminate-1)) + (num-threads (length (all-threads))) + (success #f)) + (thread-terminate! t) + (with-exception-handler + (lambda (obj) (set! success (terminated-thread-exception? obj))) + (lambda () (thread-join! t))) + success)) + + (pass-if "termination destroys started thread" + (let* ((m1 (make-mutex 'thread-terminate-2a)) + (m2 (make-mutex 'thread-terminate-2b)) + (c (make-condition-variable 'thread-terminate-2)) + (t (make-thread (lambda () + (mutex-lock! m1) + (condition-variable-signal! c) + (mutex-unlock! m1) + (mutex-lock! m2)) + 'thread-terminate-2)) + (success #f)) + (mutex-lock! m1) + (mutex-lock! m2) + (thread-start! t) + (mutex-unlock! m1 c) + (thread-terminate! t) + (with-exception-handler + (lambda (obj) (set! success (terminated-thread-exception? obj))) + (lambda () (thread-join! t))) + success))) + +(with-test-prefix "thread-join!" + + (pass-if "join receives result of thread" + (let ((t (make-thread (lambda () 'foo) 'thread-join-1))) + (thread-start! t) + (eq? (thread-join! t) 'foo))) + + (pass-if "join receives timeout val if timeout expires" + (let* ((m (make-mutex 'thread-join-2)) + (t (make-thread (lambda () (mutex-lock! m)) 'thread-join-2))) + (mutex-lock! m) + (thread-start! t) + (let ((r (thread-join! t (current-time) 'bar))) + (thread-terminate! t) + (eq? r 'bar)))) + + (pass-if "join throws exception on timeout without timeout val" + (let* ((m (make-mutex 'thread-join-3)) + (t (make-thread (lambda () (mutex-lock! m)) 'thread-join-3)) + (success #f)) + (mutex-lock! m) + (thread-start! t) + (with-exception-handler + (lambda (obj) (set! success (join-timeout-exception? obj))) + (lambda () (thread-join! t (current-time)))) + (thread-terminate! t) + success)) + + (pass-if "join waits on timeout" + (let ((t (make-thread (lambda () (sleep 1) 'foo) 'thread-join-4))) + (thread-start! t) + (eq? (thread-join! t (+ (time->seconds (current-time)) 2)) 'foo)))) + +(with-test-prefix "mutex?" + + (pass-if "make-mutex creates mutex" + (mutex? (make-mutex))) + + (pass-if "symbol not mutex" + (not (mutex? 'foo)))) + +(with-test-prefix "mutex-name" + + (pass-if "make-mutex with name binds name" + (let* ((m (make-mutex 'mutex-name-1))) + (eq? (mutex-name m) 'mutex-name-1))) + + (pass-if "make-mutex without name does not bind name" + (let* ((m (make-mutex))) + (not (mutex-name m))))) + +(with-test-prefix "mutex-specific" + + (pass-if "mutex-specific is initially #f" + (let ((m (make-mutex 'mutex-specific-1))) + (not (mutex-specific m)))) + + (pass-if "mutex-specific-set! can set value" + (let ((m (make-mutex 'mutex-specific-2))) + (mutex-specific-set! m "hello") + (equal? (mutex-specific m) "hello")))) + +(with-test-prefix "mutex-state" + + (pass-if "mutex state is initially not-abandoned" + (let ((m (make-mutex 'mutex-state-1))) + (eq? (mutex-state m) 'not-abandoned))) + + (pass-if "mutex state of locked, owned mutex is owner thread" + (let ((m (make-mutex 'mutex-state-2))) + (mutex-lock! m) + (eq? (mutex-state m) (current-thread)))) + + (pass-if "mutex state of locked, unowned mutex is not-owned" + (let ((m (make-mutex 'mutex-state-3))) + (mutex-lock! m #f #f) + (eq? (mutex-state m) 'not-owned))) + + (pass-if "mutex state of unlocked, abandoned mutex is abandoned" + (let* ((m (make-mutex 'mutex-state-4)) + (t (make-thread (lambda () (mutex-lock! m))))) + (thread-start! t) + (thread-join! t) + (eq? (mutex-state m) 'abandoned)))) + +(with-test-prefix "mutex-lock!" + + (pass-if "mutex-lock! returns true on successful lock" + (let* ((m (make-mutex 'mutex-lock-1))) + (mutex-lock! m))) + + (pass-if "mutex-lock! returns false on timeout" + (let* ((m (make-mutex 'mutex-lock-2)) + (t (make-thread (lambda () (mutex-lock! m (current-time) #f))))) + (mutex-lock! m) + (thread-start! t) + (not (thread-join! t)))) + + (pass-if "mutex-lock! returns true when lock obtained within timeout" + (let* ((m (make-mutex 'mutex-lock-3)) + (t (make-thread (lambda () + (mutex-lock! m (+ (time->seconds (current-time)) + 100) + #f))))) + (mutex-lock! m) + (thread-start! t) + (mutex-unlock! m) + (thread-join! t))) + + (pass-if "can lock mutex for non-current thread" + (let* ((m1 (make-mutex 'mutex-lock-4a)) + (m2 (make-mutex 'mutex-lock-4b)) + (t (make-thread (lambda () (mutex-lock! m1)) 'mutex-lock-4))) + (mutex-lock! m1) + (thread-start! t) + (mutex-lock! m2 #f t) + (let ((success (eq? (mutex-state m2) t))) + (thread-terminate! t) success))) + + (pass-if "locking abandoned mutex throws exception" + (let* ((m (make-mutex 'mutex-lock-5)) + (t (make-thread (lambda () (mutex-lock! m)) 'mutex-lock-5)) + (success #f)) + (thread-start! t) + (thread-join! t) + (with-exception-handler + (lambda (obj) (set! success (abandoned-mutex-exception? obj))) + (lambda () (mutex-lock! m))) + (and success (eq? (mutex-state m) (current-thread))))) + + (pass-if "sleeping threads notified of abandonment" + (let* ((m1 (make-mutex 'mutex-lock-6a)) + (m2 (make-mutex 'mutex-lock-6b)) + (c (make-condition-variable 'mutex-lock-6)) + (t (make-thread (lambda () + (mutex-lock! m1) + (mutex-lock! m2) + (condition-variable-signal! c)))) + (success #f)) + (mutex-lock! m1) + (thread-start! t) + (with-exception-handler + (lambda (obj) (set! success (abandoned-mutex-exception? obj))) + (lambda () (mutex-unlock! m1 c) (mutex-lock! m2))) + success))) + +(with-test-prefix "mutex-unlock!" + + (pass-if "unlock changes mutex state" + (let* ((m (make-mutex 'mutex-unlock-1))) + (mutex-lock! m) + (mutex-unlock! m) + (eq? (mutex-state m) 'not-abandoned))) + + (pass-if "can unlock from any thread" + (let* ((m (make-mutex 'mutex-unlock-2)) + (t (make-thread (lambda () (mutex-unlock! m)) 'mutex-unlock-2))) + (mutex-lock! m) + (thread-start! t) + (thread-join! t) + (eq? (mutex-state m) 'not-abandoned))) + + (pass-if "mutex unlock is true when condition is signalled" + (let* ((m (make-mutex 'mutex-unlock-3)) + (c (make-condition-variable 'mutex-unlock-3)) + (t (make-thread (lambda () + (mutex-lock! m) + (condition-variable-signal! c) + (mutex-unlock! m))))) + (mutex-lock! m) + (thread-start! t) + (mutex-unlock! m c))) + + (pass-if "mutex unlock is false when condition times out" + (let* ((m (make-mutex 'mutex-unlock-4)) + (c (make-condition-variable 'mutex-unlock-4))) + (mutex-lock! m) + (not (mutex-unlock! m c (+ (time->seconds (current-time)) 1)))))) + +(with-test-prefix "condition-variable?" + + (pass-if "make-condition-variable creates condition variable" + (condition-variable? (make-condition-variable))) + + (pass-if "symbol not condition variable" + (not (condition-variable? 'foo)))) + +(with-test-prefix "condition-variable-name" + + (pass-if "make-condition-variable with name binds name" + (let* ((c (make-condition-variable 'condition-variable-name-1))) + (eq? (condition-variable-name c) 'condition-variable-name-1))) + + (pass-if "make-condition-variable without name does not bind name" + (let* ((c (make-condition-variable))) + (not (condition-variable-name c))))) + +(with-test-prefix "condition-variable-specific" + + (pass-if "condition-variable-specific is initially #f" + (let ((c (make-condition-variable 'condition-variable-specific-1))) + (not (condition-variable-specific c)))) + + (pass-if "condition-variable-specific-set! can set value" + (let ((c (make-condition-variable 'condition-variable-specific-1))) + (condition-variable-specific-set! c "hello") + (equal? (condition-variable-specific c) "hello")))) + +(with-test-prefix "condition-variable-signal!" + + (pass-if "condition-variable-signal! wakes up single thread" + (let* ((m (make-mutex 'condition-variable-signal-1)) + (c (make-condition-variable 'condition-variable-signal-1)) + (t (make-thread (lambda () + (mutex-lock! m) + (condition-variable-signal! c) + (mutex-unlock! m))))) + (mutex-lock! m) + (thread-start! t) + (mutex-unlock! m c)))) + +(with-test-prefix "condition-variable-broadcast!" + + (pass-if "condition-variable-broadcast! wakes up multiple threads" + (let* ((sem 0) + (c1 (make-condition-variable 'condition-variable-broadcast-1-a)) + (m1 (make-mutex 'condition-variable-broadcast-1-a)) + (c2 (make-condition-variable 'condition-variable-broadcast-1-b)) + (m2 (make-mutex 'condition-variable-broadcast-1-b)) + (inc-sem! (lambda () + (mutex-lock! m1) + (set! sem (+ sem 1)) + (condition-variable-broadcast! c1) + (mutex-unlock! m1))) + (dec-sem! (lambda () + (mutex-lock! m1) + (while (eqv? sem 0) (wait-condition-variable c1 m1)) + (set! sem (- sem 1)) + (mutex-unlock! m1))) + (t1 (make-thread (lambda () + (mutex-lock! m2) + (inc-sem!) + (mutex-unlock! m2 c2) + (inc-sem!)))) + (t2 (make-thread (lambda () + (mutex-lock! m2) + (inc-sem!) + (mutex-unlock! m2 c2) + (inc-sem!))))) + (thread-start! t1) + (thread-start! t2) + (dec-sem!) + (dec-sem!) + (mutex-lock! m2) + (condition-variable-broadcast! c2) + (mutex-unlock! m2) + (dec-sem!) + (dec-sem!)))) + +(with-test-prefix "time?" + + (pass-if "current-time is time" (time? (current-time))) + (pass-if "number is not time" (not (time? 123))) + (pass-if "symbol not time" (not (time? 'foo)))) + +(with-test-prefix "time->seconds" + + (pass-if "time->seconds makes time into rational" + (rational? (time->seconds (current-time)))) + + (pass-if "time->seconds is reversible" + (let ((t (current-time))) + (equal? t (seconds->time (time->seconds t)))))) + +(with-test-prefix "seconds->time" + + (pass-if "seconds->time makes rational into time" + (time? (seconds->time 123.456))) + + (pass-if "seconds->time is reversible" + (let ((t (time->seconds (current-time)))) + (equal? t (time->seconds (seconds->time t)))))) + +(with-test-prefix "current-exception-handler" + + (pass-if "current handler returned at top level" + (procedure? (current-exception-handler))) + + (pass-if "specified handler set under with-exception-handler" + (let ((h (lambda (key . args) 'nothing))) + (with-exception-handler h (lambda () (eq? (current-exception-handler) + h))))) + + (pass-if "multiple levels of handler nesting" + (let ((h (lambda (key . args) 'nothing)) + (i (current-exception-handler))) + (and (with-exception-handler h (lambda () + (eq? (current-exception-handler) h))) + (eq? (current-exception-handler) i)))) + + (pass-if "exception handler installation is thread-safe" + (let* ((h1 (current-exception-handler)) + (h2 (lambda (key . args) 'nothing-2)) + (m (make-mutex 'current-exception-handler-4)) + (c (make-condition-variable 'current-exception-handler-4)) + (t (make-thread (lambda () + (with-exception-handler + h2 (lambda () + (mutex-lock! m) + (condition-variable-signal! c) + (wait-condition-variable c m) + (and (eq? (current-exception-handler) h2) + (mutex-unlock! m))))) + 'current-exception-handler-4))) + (mutex-lock! m) + (thread-start! t) + (wait-condition-variable c m) + (and (eq? (current-exception-handler) h1) + (condition-variable-signal! c) + (mutex-unlock! m) + (thread-join! t))))) + +(with-test-prefix "uncaught-exception-reason" + + (pass-if "initial handler captures top level exception" + (let ((t (make-thread (lambda () (raise 'foo)))) + (success #f)) + (thread-start! t) + (with-exception-handler + (lambda (obj) + (and (uncaught-exception? obj) + (eq? (uncaught-exception-reason obj) 'foo) + (set! success #t))) + (lambda () (thread-join! t))) + success)) + + (pass-if "initial handler captures non-SRFI-18 throw" + (let ((t (make-thread (lambda () (throw 'foo)))) + (success #f)) + (thread-start! t) + (with-exception-handler + (lambda (obj) + (and (uncaught-exception? obj) + (eq? (uncaught-exception-reason obj) 'foo) + (set! success #t))) + (lambda () (thread-join! t))) + success))) + +) diff --git a/test-suite/tests/srfi-35.test b/test-suite/tests/srfi-35.test index ec7a104c3..83efd61d9 100644 --- a/test-suite/tests/srfi-35.test +++ b/test-suite/tests/srfi-35.test @@ -1,7 +1,7 @@ ;;;; srfi-35.test --- Test suite for SRFI-35 -*- Scheme -*- ;;;; Ludovic Courtès <ludo@gnu.org> ;;;; -;;;; Copyright (C) 2007 Free Software Foundation, Inc. +;;;; Copyright (C) 2007, 2008 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 @@ -23,6 +23,12 @@ :use-module (srfi srfi-35)) +(with-test-prefix "cond-expand" + (pass-if "srfi-35" + (cond-expand (srfi-35 #t) + (else #f)))) + + (with-test-prefix "condition types" (pass-if "&condition" (condition-type? &condition)) @@ -308,3 +314,7 @@ (pass-if "(c2-b v5)" (equal? (c2-b v5) "b2"))) + +;;; Local Variables: +;;; coding: latin-1 +;;; End: diff --git a/test-suite/tests/srfi-37.test b/test-suite/tests/srfi-37.test index 73647c004..d7745876d 100644 --- a/test-suite/tests/srfi-37.test +++ b/test-suite/tests/srfi-37.test @@ -1,6 +1,6 @@ ;;;; srfi-37.test --- Test suite for SRFI 37 -*- scheme -*- ;;;; -;;;; Copyright (C) 2007 Free Software Foundation, Inc. +;;;; Copyright (C) 2007, 2008 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 @@ -94,4 +94,16 @@ (lambda (opt name arg k) #f) '())))) + (pass-if "short options without arguments" + ;; In Guile 1.8.4 and earlier, using short names of argument-less options + ;; would lead to a stack overflow. + (let ((arg-proc (lambda (opt name arg k) + (acons name arg k)))) + (equal? '((#\x . #f)) + (args-fold '("-x") + (list (option '(#\x) #f #f arg-proc)) + (lambda (opt name arg k) #f) + (lambda (opt name arg k) #f) + '())))) + ) diff --git a/test-suite/tests/srfi-69.test b/test-suite/tests/srfi-69.test new file mode 100644 index 000000000..1d240d28c --- /dev/null +++ b/test-suite/tests/srfi-69.test @@ -0,0 +1,108 @@ +;;;; srfi-69.test --- Test suite for SRFI 69 -*- scheme -*- +;;;; +;;;; Copyright (C) 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 +;;;; the Free Software Foundation; either version 2, or (at your option) +;;;; any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this software; see the file COPYING. If not, write to +;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;;;; Boston, MA 02110-1301 USA + +(define-module (test-srfi-69) + #:use-module (test-suite lib) + #:use-module (srfi srfi-69) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26)) + +(define (string-ci-assoc-equal? left right) + "Answer whether LEFT and RIGHT are equal, being associations of +case-insensitive strings to `equal?'-tested values." + (and (string-ci=? (car left) (car right)) + (equal? (cdr left) (cdr right)))) + +(with-test-prefix "SRFI-69" + + (pass-if "small alist<->hash tables round-trip" + (let* ((start-alist '((a . 1) (b . 2) (c . 3) (a . 42))) + (ht (alist->hash-table start-alist eq?)) + (end-alist (hash-table->alist ht))) + (and (= 3 (hash-table-size ht)) + (lset= equal? end-alist (take start-alist 3)) + (= 1 (hash-table-ref ht 'a)) + (= 2 (hash-table-ref ht 'b)) + (= 3 (hash-table-ref ht 'c))))) + + (pass-if "string-ci=? tables work by default" + (let ((ht (alist->hash-table '(("xY" . 2) ("abc" . 54)) string-ci=?))) + (hash-table-set! ht "XY" 42) + (hash-table-set! ht "qqq" 100) + (and (= 54 (hash-table-ref ht "ABc")) + (= 42 (hash-table-ref ht "xy")) + (= 3 (hash-table-size ht)) + (lset= string-ci-assoc-equal? + '(("xy" . 42) ("abc" . 54) ("qqq" . 100)) + (hash-table->alist ht))))) + + (pass-if-exception "Bad weakness arg to mht signals an error" + '(misc-error . "^Invalid weak hash table type") + (make-hash-table equal? hash #:weak 'key-and-value)) + + (pass-if "empty hash tables are empty" + (null? (hash-table->alist (make-hash-table eq?)))) + + (pass-if "hash-table-ref uses default" + (equal? '(4) + (hash-table-ref (alist->hash-table '((a . 1)) eq?) + 'b (cut list (+ 2 2))))) + + (pass-if "hash-table-delete! deletes present assocs, ignores others" + (let ((ht (alist->hash-table '((a . 1) (b . 2)) eq?))) + (hash-table-delete! ht 'c) + (and (= 2 (hash-table-size ht)) + (begin + (hash-table-delete! ht 'a) + (= 1 (hash-table-size ht))) + (lset= equal? '((b . 2)) (hash-table->alist ht))))) + + (pass-if "alist->hash-table does not require linear stack space" + (eqv? 99999 + (hash-table-ref (alist->hash-table + (unfold-right (cut >= <> 100000) + (lambda (s) `(x . ,s)) 1+ 0) + eq?) + 'x))) + + (pass-if "hash-table-walk ignores return values" + (let ((ht (alist->hash-table '((a . 1) (b . 2) (c . 3)) eq?))) + (for-each (cut hash-table-walk ht <>) + (list (lambda (k v) (values)) + (lambda (k v) (values 1 2 3)))) + #t)) + + (pass-if "hash-table-update! modifies existing binding" + (let ((ht (alist->hash-table '((a . 1)) eq?))) + (hash-table-update! ht 'a 1+) + (hash-table-update! ht 'a (cut + 4 <>) (lambda () 42)) + (and (= 1 (hash-table-size ht)) + (lset= equal? '((a . 6)) (hash-table->alist ht))))) + + (pass-if "hash-table-update! creates new binding when appropriate" + (let ((ht (make-hash-table eq?))) + (hash-table-update! ht 'b 1+ (lambda () 42)) + (hash-table-update! ht 'b (cut + 10 <>)) + (and (= 1 (hash-table-size ht)) + (lset= equal? '((b . 53)) (hash-table->alist ht))))) + + (pass-if "can use all arguments, including size" + (hash-table? (make-hash-table equal? hash #:weak 'key 31))) + +) diff --git a/test-suite/tests/srfi-88.test b/test-suite/tests/srfi-88.test new file mode 100644 index 000000000..63f40cc40 --- /dev/null +++ b/test-suite/tests/srfi-88.test @@ -0,0 +1,59 @@ +;;;; srfi-88.test --- Test suite for SRFI-88 -*- Scheme -*- +;;;; Ludovic Courtès <ludo@gnu.org> +;;;; +;;;; Copyright (C) 2008 Free Software Foundation, Inc. +;;;; +;;;; This program is free software; you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation; either version 2, or (at your option) +;;;; any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this software; see the file COPYING. If not, write to +;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;;;; Boston, MA 02110-1301 USA + +(define-module (test-srfi-88) + :use-module (test-suite lib) + :use-module (srfi srfi-88)) + + +;; Most of the test cases are taken from SRFI-88. + +(with-test-prefix "srfi-88" + + (pass-if "cond-expand" + (cond-expand (srfi-88 #t) + (else #f))) + + (pass-if "keyword?" + (and (keyword? 'foo:) + (keyword? foo:) + (not (keyword? 'foo)) + (not (keyword? ':)) + (keyword? (car '(a: b:))) + (not (keyword? "bar")))) + + (pass-if "keyword->string" + (and (string=? (keyword->string foo:) "foo") + (string=? "a b c" + (keyword->string (string->keyword "a b c"))))) + + (pass-if "string->keyword" + (eq? (string->keyword "foo") foo:)) + + (pass-if "empty keyword" + ;; XXX: We don't currently support syntax of the form + ;; `#{extended symbol}#:'. + (string=? "" + (keyword->string (string->keyword ""))))) + + +;;; Local Variables: +;;; coding: latin-1 +;;; End: diff --git a/test-suite/tests/threads.test b/test-suite/tests/threads.test index 10b1b91a0..caace7fd4 100644 --- a/test-suite/tests/threads.test +++ b/test-suite/tests/threads.test @@ -138,6 +138,97 @@ (equal? result '(10 8 6 4 2 0))))) ;; + ;; timed mutex locking + ;; + + (with-test-prefix "lock-mutex" + + (pass-if "timed locking fails if timeout exceeded" + (let ((m (make-mutex))) + (lock-mutex m) + (let ((t (begin-thread (lock-mutex m (+ (current-time) 1))))) + (not (join-thread t))))) + + (pass-if "timed locking succeeds if mutex unlocked within timeout" + (let* ((m (make-mutex)) + (c (make-condition-variable)) + (cm (make-mutex))) + (lock-mutex cm) + (let ((t (begin-thread (begin (lock-mutex cm) + (signal-condition-variable c) + (unlock-mutex cm) + (lock-mutex m + (+ (current-time) 2)))))) + (lock-mutex m) + (wait-condition-variable c cm) + (unlock-mutex cm) + (sleep 1) + (unlock-mutex m) + (join-thread t))))) + + ;; + ;; timed mutex unlocking + ;; + + (with-test-prefix "unlock-mutex" + + (pass-if "timed unlocking returns #f if timeout exceeded" + (let ((m (make-mutex)) + (c (make-condition-variable))) + (lock-mutex m) + (not (unlock-mutex m c (current-time))))) + + (pass-if "timed unlocking returns #t if condition signaled" + (let ((m1 (make-mutex)) + (m2 (make-mutex)) + (c1 (make-condition-variable)) + (c2 (make-condition-variable))) + (lock-mutex m1) + (let ((t (begin-thread (begin (lock-mutex m1) + (signal-condition-variable c1) + (lock-mutex m2) + (unlock-mutex m1) + (unlock-mutex m2 + c2 + (+ (current-time) + 2)))))) + (wait-condition-variable c1 m1) + (unlock-mutex m1) + (lock-mutex m2) + (signal-condition-variable c2) + (unlock-mutex m2) + (join-thread t))))) + + ;; + ;; timed joining + ;; + + (with-test-prefix "join-thread" + + (pass-if "timed joining fails if timeout exceeded" + (let* ((m (make-mutex)) + (c (make-condition-variable)) + (t (begin-thread (begin (lock-mutex m) + (wait-condition-variable c m)))) + (r (join-thread t (current-time)))) + (cancel-thread t) + (not r))) + + (pass-if "join-thread returns timeoutval on timeout" + (let* ((m (make-mutex)) + (c (make-condition-variable)) + (t (begin-thread (begin (lock-mutex m) + (wait-condition-variable c m)))) + (r (join-thread t (current-time) 'foo))) + (cancel-thread t) + (eq? r 'foo))) + + + (pass-if "timed joining succeeds if thread exits within timeout" + (let ((t (begin-thread (begin (sleep 1) #t)))) + (join-thread t (+ (current-time) 2))))) + + ;; ;; thread cancellation ;; @@ -185,4 +276,81 @@ (eq? (join-thread t) 'bar)))) (pass-if "initial handler is false" - (not (thread-cleanup (current-thread))))))) + (not (thread-cleanup (current-thread))))) + + ;; + ;; mutex ownership + ;; + + (with-test-prefix "mutex-ownership" + (pass-if "mutex ownership for locked mutex" + (let ((m (make-mutex))) + (lock-mutex m) + (eq? (mutex-owner m) (current-thread)))) + + (pass-if "mutex ownership for unlocked mutex" + (let ((m (make-mutex))) + (not (mutex-owner m)))) + + (pass-if "locking mutex on behalf of other thread" + (let* ((m (make-mutex)) + (t (begin-thread 'foo))) + (lock-mutex m #f t) + (eq? (mutex-owner m) t))) + + (pass-if "locking mutex with no owner" + (let ((m (make-mutex))) + (lock-mutex m #f #f) + (not (mutex-owner m))))) + + ;; + ;; mutex lock levels + ;; + + (with-test-prefix "mutex-lock-levels" + + (pass-if "unlocked level is 0" + (let ((m (make-mutex))) + (and (not (mutex-locked? m)) (eqv? (mutex-level m) 0)))) + + (pass-if "non-recursive lock level is 1" + (let ((m (make-mutex))) + (lock-mutex m) + (and (mutex-locked? m) (eqv? (mutex-level m) 1)))) + + (pass-if "recursive lock level is >1" + (let ((m (make-mutex 'recursive))) + (lock-mutex m) + (lock-mutex m) + (and (mutex-locked? m) (eqv? (mutex-level m) 2))))) + + ;; + ;; mutex behavior + ;; + + (with-test-prefix "mutex-behavior" + + (pass-if "unchecked unlock" + (let* ((m (make-mutex 'unchecked-unlock))) + (unlock-mutex m))) + + (pass-if "allow external unlock" + (let* ((m (make-mutex 'allow-external-unlock)) + (t (begin-thread (lock-mutex m)))) + (join-thread t) + (unlock-mutex m))) + + (pass-if "recursive mutexes" + (let* ((m (make-mutex 'recursive))) + (lock-mutex m) + (lock-mutex m))) + + (pass-if "locking abandoned mutex throws exception" + (let* ((m (make-mutex)) + (t (begin-thread (lock-mutex m))) + (success #f)) + (join-thread t) + (catch 'abandoned-mutex-error + (lambda () (lock-mutex m)) + (lambda key (set! success #t))) + success))))) diff --git a/test-suite/tests/time.test b/test-suite/tests/time.test index ebc4499fd..d5639eb68 100644 --- a/test-suite/tests/time.test +++ b/test-suite/tests/time.test @@ -1,7 +1,7 @@ ;;;; time.test --- test suite for Guile's time functions -*- scheme -*- ;;;; Jim Blandy <jimb@red-bean.com> --- June 1999, 2004 ;;;; -;;;; Copyright (C) 1999, 2004, 2006, 2007 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2004, 2006, 2007, 2008 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 @@ -196,44 +196,19 @@ (with-test-prefix "strftime" - ;; Note we must force isdst to get the ZOW zone name out of %Z on HP-UX. - ;; If localtime is in daylight savings then it will decide there's no - ;; daylight savings zone name for the fake ZOW, and come back empty. - ;; - ;; This test is disabled because on NetBSD %Z doesn't look at the tm_zone - ;; field in struct tm passed by guile. That behaviour is reasonable - ;; enough since that field is not in C99 so a C99 program won't know it - ;; has to be set. For the details on that see - ;; - ;; http://www.netbsd.org/cgi-bin/query-pr-single.pl?number=21722 - ;; - ;; Not sure what to do about this in guile, it'd be nice for %Z to look at - ;; tm:zone everywhere. - ;; - ;; - ;; (pass-if "strftime %Z doesn't return garbage" - ;; (let ((t (localtime (current-time)))) - ;; (set-tm:zone t "ZOW") - ;; (set-tm:isdst t 0) - ;; (string=? (strftime "%Z" t) - ;; "ZOW"))) + (pass-if "strftime %Z doesn't return garbage" + (let ((t (localtime (current-time)))) + (set-tm:zone t "ZOW") + (set-tm:isdst t 0) + (string=? (strftime "%Z" t) + "ZOW"))) (with-test-prefix "C99 %z format" - ;; C99 spec is empty string if no zone determinable - ;; - ;; on pre-C99 systems not sure what to expect if %z unsupported, probably - ;; "%z" unchanged in C99 if timezone - ;; - (define have-strftime-%z - (not (member (strftime "%z" (gmtime 0)) - '("" "%z")))) - ;; %z here is quite possibly affected by the same tm:gmtoff vs current ;; zone as %Z above is, so in the following tests we make them the same. (pass-if "GMT" - (or have-strftime-%z (throw 'unsupported)) (putenv "TZ=GMT+0") (tzset) (let ((tm (localtime 86400))) @@ -243,7 +218,6 @@ ;; because we didn't adjust for tm:gmtoff being west of Greenwich versus ;; tm_gmtoff being east of Greenwich (pass-if "EST+5" - (or have-strftime-%z (throw 'unsupported)) (putenv "TZ=EST+5") (tzset) (let ((tm (localtime 86400))) |