diff options
| author | cvs2svn <admin@example.com> | 1998-10-14 21:25:52 +0000 |
|---|---|---|
| committer | cvs2svn <admin@example.com> | 1998-10-14 21:25:52 +0000 |
| commit | a6e50127956f9ac4b64cc4ab530757806099cb00 (patch) | |
| tree | b78773ab800d693b72211449c09ed32bcb51efc2 | |
| parent | a437d8a2a8191098aac9e2348dc8037f4448f418 (diff) | |
| download | guile-a6e50127956f9ac4b64cc4ab530757806099cb00.tar.gz | |
This commit was manufactured by cvs2svn to create tagmvo_pre_local_defines_fix
'mvo_pre_local_defines_fix'.
154 files changed, 0 insertions, 44879 deletions
diff --git a/.cvsignore b/.cvsignore deleted file mode 100644 index 6e4d6341b..000000000 --- a/.cvsignore +++ /dev/null @@ -1,7 +0,0 @@ -Makefile -config.cache -config.log -config.status -guile-*.tar.gz -config.build-subdirs -libtool diff --git a/ANON-CVS b/ANON-CVS deleted file mode 100644 index 0983712da..000000000 --- a/ANON-CVS +++ /dev/null @@ -1,89 +0,0 @@ -Anonymous CVS access to Guile ======================================== - -We make the current Guile sources available via anonymous CVS. Please -keep in mind that these sources are strictly experimental; they will -usually not be well-tested, and may not even compile on some systems. -They may contain interfaces which will change. They will usually not -be of sufficient quality for use by people not comfortable hacking the -innards of Guile. Caveat! - -However, we're providing them anyway for several reasons. We'd like -to encourage people to get involved in developing Guile. People -willing to use the bleeding edge of development can get earlier access -to new, experimental features. Patches submitted relative to recent -sources will be easier for us to evaluate and install, since the -patch's original sources will be closer to what we're working with. -And it allows us to start testing features earlier. - -To check out a CVS working directory: - -1) Install CVS version 1.9 or later on your system. -2) Log into the CVS server: - $ cvs -d :pserver:anoncvs@egcs.cygnus.com:/egcs/carton/cvsfiles login - At the prompt for `CVS password:', type `anoncvs'. - Once you have logged in, your password is saved in ~/.cvspass, and you - will not need to enter it again. -3) Check out a module: - $ cvs -z 9 -d :pserver:anoncvs@egcs.cygnus.com:/egcs/carton/cvsfiles checkout guile-core - This should create a new directory `guile-core' in your current - directory, and populate it with the current Guile sources. - -The modules available for checkout are: - guile-core --- The scheme interpreter itself. - guile-doc --- Guile documentation-in-progress. - guile-tcltk --- An interface between Guile and Tcl/Tk. - guile-scsh --- An incomplete port of SCSH 0.4.4 to Guile. - guile-rgx-ctax --- This has been discontinued; use Andrew Archibald's - distribution instead: - ftp://ftp.red-bean.com/pub/guile/contrib/misc/guile-lang-allover-0.1.tar.gz - -Once you have a working directory, you can bring it up to date easily -and efficiently: - -1) Go to the top directory of the source tree. That is, your current - directory should be the one containing `configure.in', `README', - and so on. -2) Do the update: - $ cvs update - -This will incorporate any changes the developers have made to Guile -since your last update into your source tree. - -The EGCS Project is kindly lending us space, time, and bandwidth on -their CVS server. Thanks, folks! - - -Questions ============================================================ - -(I don't know if they'll be "frequently asked" or not yet!) - -- It takes forever to do an update; what can I do to speed it up? - - CVS tries to be smart about what it sends; it will transmit and - install only those files that have changed, and will sometimes - transmit and apply patches instead, to save transmission time. - - It is also possible to have CVS compress transmitted data, using zlib. - Put the following line in your ~/.cvsrc file: - - cvs -z 9 - - See the CVS documentation for more details. - - -- What happens if I've changed files in my working directory, and then - I do an update? - - If you have made local changes to your sources, the `cvs update' - command will not overwrite them; instead, CVS will try to merge its - changes with your changes, as if you had applied a patch. Rejects are - marked in the sources. - -- Why does the build process try to run autoconf, aclocal, or automake? - - It shouldn't; if it does, that's a bug, I think. Those are the - tools we use to generate `configure', `aclocal.m4', and the - `Makefile.in' files from their respective sources. Ideally, you - shouldn't need to have them installed, if you don't want to change - those sources. If you do, see the section in `README' called - `Hacking It Yourself'. diff --git a/AUTHORS b/AUTHORS deleted file mode 100644 index 2b6f1dd54..000000000 --- a/AUTHORS +++ /dev/null @@ -1,61 +0,0 @@ -To find out what should go in this file, see "Information For -Maintainers of GNU Software" (maintain.texi), the section called -"Recording Changes". - - -Aubrey Jaffer: -is the author of SCM, the Scheme interpreter upon which Guile is -based. Guile started from SCM version 4e1 in November -94 and is -still largely composed of the original SCM code. - -George Carrette: -wrote files present in Siod version 2.3, released in December of 1989. -Siod was the starting point for SCM. The major innovations taken from -Siod are the evaluator's use of the C-stack and being able to garbage -collect off the C-stack - -Radey Shouman: -In the subdirectory libguile, wrote: - gsubr.c ramap.c unif.c - gsubr.h ramap.h unif.h - -Gary Houston: changes to many files in libguile. -wrote: libguile/socket.c, ice-9/expect.scm - -Tom Lord: Many changes throughout. -In the subdirectory ice-9, wrote: - Makefile.in configure.in lineio.scm poe.scm - boot-9.scm hcons.scm mapping.scm - -Anthony Green: wrote the following files in libguile: - coop-defs.h coop-threads.h fsu-pthreads.h mit-pthreads.h threads.h - coop-threads.c coop.c mit-pthreads.c threads.c -and ice-9/threads.scm. - -Mikael Djurfeldt: -In the subdirectory libguile, wrote: - backtrace.c debug.c options.c root.c srcprop.c stacks.c - backtrace.h debug.h options.h root.h srcprop.h stacks.h - iselect.c gdbint.c objects.c objprop.c stackchk.c - iselect.h gdbint.h objects.h objprop.h stackchk.h - gdb_interface.h -In the subdirectory libguile, rewrote: - coop-threads.c coop.c mit-pthreads.c threads.c print.c - coop-threads.h fsu-pthreads.h mit-pthreads.h threads.h print.h -Many other changes throughout. - -Mark Galassi: -Designed and implemented the high-level libguile API (the @code{gh_} -interface), based largely on the defunct @code{gscm_} interface. In the -subdirectory libguile, wrote: -gh.h gh_funcs.c gh_list.c gh_test_repl.c -gh_data.c gh_init.c gh_predicates.c -gh_eval.c gh_io.c gh_test_c.c - -Marius Vollmer: -In the subdirectory libguile, wrote: - fluids.c - fluids.h -In the subdirectory libguile, rewrote: - dynl.c dynl-dl.c dynl-shl.c - dynl.h dynl-dld.c diff --git a/COPYING b/COPYING deleted file mode 100644 index eeb586b39..000000000 --- a/COPYING +++ /dev/null @@ -1,340 +0,0 @@ - GNU GENERAL PUBLIC LICENSE - Version 2, June 1991 - - Copyright (C) 1989, 1991 Free Software Foundation, Inc. - 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -License is intended to guarantee your freedom to share and change free -software--to make sure the software is free for all its users. This -General Public License applies to most of the Free Software -Foundation's software and to any other program whose authors commit to -using it. (Some other Free Software Foundation software is covered by -the GNU Library General Public License instead.) You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, 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 or use pieces of it -in new free programs; and that you know you can do these things. - - To protect your rights, we need to make restrictions that forbid -anyone to deny you these rights or to ask you to surrender the rights. -These restrictions translate to certain responsibilities for you if you -distribute copies of the software, or if you modify it. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must give the recipients all the rights that -you have. You must make sure that they, too, receive or can get the -source code. And you must show them these terms so they know their -rights. - - We protect your rights with two steps: (1) copyright the software, and -(2) offer you this license which gives you legal permission to copy, -distribute and/or modify the software. - - Also, for each author's protection and ours, we want to make certain -that everyone understands that there is no warranty for this free -software. If the software is modified by someone else and passed on, we -want its recipients to know that what they have is not the original, so -that any problems introduced by others will not reflect on the original -authors' reputations. - - Finally, any free program is threatened constantly by software -patents. We wish to avoid the danger that redistributors of a free -program will individually obtain patent licenses, in effect making the -program proprietary. To prevent this, we have made it clear that any -patent must be licensed for everyone's free use or not licensed at all. - - The precise terms and conditions for copying, distribution and -modification follow. - - GNU GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License applies to any program or other work which contains -a notice placed by the copyright holder saying it may be distributed -under the terms of this General Public License. The "Program", below, -refers to any such program or work, and a "work based on the Program" -means either the Program or any derivative work under copyright law: -that is to say, a work containing the Program or a portion of it, -either verbatim or with modifications and/or translated into another -language. (Hereinafter, translation is included without limitation in -the term "modification".) Each licensee is addressed as "you". - -Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running the Program is not restricted, and the output from the Program -is covered only if its contents constitute a work based on the -Program (independent of having been made by running the Program). -Whether that is true depends on what the Program does. - - 1. You may copy and distribute verbatim copies of the Program's -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 give any other recipients of the Program a copy of this License -along with the Program. - -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 Program or any portion -of it, thus forming a work based on the Program, 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) You must cause the modified files to carry prominent notices - stating that you changed the files and the date of any change. - - b) You must cause any work that you distribute or publish, that in - whole or in part contains or is derived from the Program or any - part thereof, to be licensed as a whole at no charge to all third - parties under the terms of this License. - - c) If the modified program normally reads commands interactively - when run, you must cause it, when started running for such - interactive use in the most ordinary way, to print or display an - announcement including an appropriate copyright notice and a - notice that there is no warranty (or else, saying that you provide - a warranty) and that users may redistribute the program under - these conditions, and telling the user how to view a copy of this - License. (Exception: if the Program itself is interactive but - does not normally print such an announcement, your work based on - the Program is not required to print an announcement.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Program, -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 Program, 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 Program. - -In addition, mere aggregation of another work not based on the Program -with the Program (or with a work based on the Program) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may copy and distribute the Program (or a work based on it, -under Section 2) in object code or executable form under the terms of -Sections 1 and 2 above provided that you also do one of the following: - - a) 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; or, - - b) Accompany it with a written offer, valid for at least three - years, to give any third party, for a charge no more than your - cost of physically performing source distribution, a complete - machine-readable copy of the corresponding source code, to be - distributed under the terms of Sections 1 and 2 above on a medium - customarily used for software interchange; or, - - c) Accompany it with the information you received as to the offer - to distribute corresponding source code. (This alternative is - allowed only for noncommercial distribution and only if you - received the program in object code or executable form with such - an offer, in accord with Subsection b above.) - -The source code for a work means the preferred form of the work for -making modifications to it. For an executable work, 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 executable. However, as a -special exception, the source code 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. - -If distribution of executable or 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 counts as -distribution of the source code, even though third parties are not -compelled to copy the source along with the object code. - - 4. You may not copy, modify, sublicense, or distribute the Program -except as expressly provided under this License. Any attempt -otherwise to copy, modify, sublicense or distribute the Program 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. - - 5. 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 Program or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Program (or any work based on the -Program), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Program or works based on it. - - 6. Each time you redistribute the Program (or any work based on the -Program), the recipient automatically receives a license from the -original licensor to copy, distribute or modify the Program 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 to -this License. - - 7. 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 Program at all. For example, if a patent -license would not permit royalty-free redistribution of the Program 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 Program. - -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. - - 8. If the distribution and/or use of the Program is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Program 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. - - 9. The Free Software Foundation may publish revised and/or new versions -of the 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 Program -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 Program does not specify a version number of -this License, you may choose any version ever published by the Free Software -Foundation. - - 10. If you wish to incorporate parts of the Program into other free -programs whose distribution conditions are different, 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 - - 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY -FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN -OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES -PROVIDE THE PROGRAM "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 PROGRAM IS WITH YOU. SHOULD THE -PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, -REPAIR OR CORRECTION. - - 12. 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 PROGRAM 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 PROGRAM (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 PROGRAM TO OPERATE WITH ANY OTHER -PROGRAMS), 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 Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. 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 program's name and a brief idea of what it does.> - Copyright (C) 19yy <name of author> - - 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 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -Also add information on how to contact you by electronic and paper mail. - -If the program is interactive, make it output a short notice like this -when it starts in an interactive mode: - - Gnomovision version 69, Copyright (C) 19yy name of author - Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, the commands you use may -be called something other than `show w' and `show c'; they could even be -mouse-clicks or menu items--whatever suits your program. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the program, if -necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the program - `Gnomovision' (which makes passes at compilers) written by James Hacker. - - <signature of Ty Coon>, 1 April 1989 - Ty Coon, President of Vice - -This General Public License does not permit incorporating your program into -proprietary programs. If your program is a subroutine library, you may -consider it more useful to permit linking proprietary applications with the -library. If this is what you want to do, use the GNU Library General -Public License instead of this License. diff --git a/ChangeLog b/ChangeLog deleted file mode 100644 index 2f1fdc85c..000000000 --- a/ChangeLog +++ /dev/null @@ -1,806 +0,0 @@ -1998-10-14 Jim Blandy <jimb@zwingli.cygnus.com> - - * configure.in: Define SCM_SINGLES whenever a float can fit in a - long, not only when a float is the same size as a long. This gets - us SCM_SINGLES defined on alphas. (Thanks to Clark McGrew.) - * configure: Regenerated. - - * configure.in: Construct libguile/versiondat.h here; see - log entry in libguile/ChangeLog for details. - * configure: Regenerated. - - * configure.in: Allow tabs and whitespace between `void' and - `usleep'. (Thanks to Harvey J. Stein.) - * configure: Regenerated. - - Don't redefine sleep/usleep. - * configure.in: Remove tests for usleep's argument type; we only - need that if we're going to replace it. - - * acconfig.h (USLEEP_ARG_TYPE): Delete. All the other SLEEP - garbage is needed just to use usleep and sleep without compiler - warnings. - * configure: Regenerated. - -1998-10-12 Jim Blandy <jimb@zwingli.cygnus.com> - - * configure: Regenerated. - - * configure.in (GUILE_FUNC_DECLARED): Name the cache variables - starting with guile_cv_; ac_cv_ is autoconf's namespace. - - The type of the argument to usleep varies from system to system, - as does the return type. We really shouldn't be redefining usleep - at all, but I don't have time to clean that up before the 1.3 - release. It's on the schedule for afterwards. - * configure.in: Cache results from usleep return value test. - Test for the type of the usleep argument, and cache that too. - * acconfig.h (USLEEP_ARG_TYPE): New macro. - -1998-10-11 Jim Blandy <jimb@zwingli.cygnus.com> - - * acconfig.h (HAVE_RL_GETC_FUNCTION): Fix this entry. - -1998-10-10 Jim Blandy <jimb@zwingli.cygnus.com> - - * GUILE-VERSION: bump to 1.2.91, since we're doing snapshots again. - - * Guile 1.2.90 released --- beta. - * GUILE-VERSION: Set to 1.2.90. This would appear to be a - regression from 1.3a, but everyone knows that the next release is - 1.3, I want to switch to a more coherent version numbering system, - and now is the time. - -1998-10-09 Jim Blandy <jimb@zwingli.cygnus.com> - - * configure.in: Call AC_C_INLINE, so we can use inline happily in - libguile. - * configure: Regenerated. - -1998-10-07 Jim Blandy <jimb@zwingli.cygnus.com> - - * configure.in: Don't forget to #define HAVE_RL_GETC_FUNCTION if - we do find the rl_getc_function variable in the readline library; - AC_CHECK_FUNCS used to do this for us, but we're not using it any - more. - * acconfig.h: Add an entry for HAVE_RL_GETC_FUNCTION. - - * configure.in: Properly test for the presence of rl_getc_function; - it's a variable, not a function. - * configure: Regenerated. - - * doc: New subdirectory. - * Makefile.am (SUBDIRS): List it. - * configure.in (AC_OUTPUT): Build its Makefile. - * configure, Makefile.in: Regenerated. - - * guile.m4 (GUILE_FLAGS): New macro. - - * guile.m4 (AM_INIT_GUILE_MODULE): Deleted; it doesn't do anything - terribly helpful any more, nobody's using it, and this is not - really the way I want to handle modules anyway. - -1998-10-03 Jim Blandy <jimb@zwingli.cygnus.com> - - * configure.in (FD_SETTER, FILE_CNT_GPTR): New cases for SCO's - stdio implementation. (Thanks to David Tillman.) - * configure: Rebuilt. - - * guile-config: Renamed from `build'. - * Makefile.am (SUBDIRS): Mention `guile-config', not `build'. - * configure.in: Create `guile-config/Makefile.in', not - `build/Makefile.in'. Doc fix, too. - - * qthreads.m4: Doc fix. - * Makefile.in, aclocal.m4, configure: Regeneranegerederadea. - -1998-10-03 <jimb@savonarola.red-bean.com> - - * configure.in: Check for a missing `sleep' declaration. - * acconfig.h (MISSING_SLEEP_DECL): Provide some text for this. - * configure: Regenerated. - - * configure.in: Don't use the canonical host name to decide - whether `bzero' and `usleep' have declarations --- that's going - back to the bad old days before autoconf. Remove the call to - AC_CANONICAL_HOST and the subsequent case statement. - (GUILE_FUNC_DECLARED): New m4 macro. Use it to check for - declarations for `bzero', `usleep', and (new!) `strptime'. - * acconfig.h: (DECLARE_BZERO, DECLARE_USLEEP): Removed. - (MISSING_BZERO_DECL, MISSING_USLEEP_DECL, MISSING_STRPTIME_DECL): - Added. I think this naming convention is more consistent with the - rest of autoconf; names generally describes the system, not what - the package should do to accomodate the system. - * configure: Regenerated. - -1998-09-05 Jim Blandy <jimb@zwingli.cygnus.com> - - * configure.in: Remove --disable-debug option. The debugging - support is pretty stable now, and it's confusing people. - * configure: Regenerated. - - * HACKING: Remove -Wstrict-prototypes from the list of requested - flags (to match 1998-07-30 change). - -1998-07-30 Jim Blandy <jimb@zwingli.cygnus.com> - - * configure.in: Don't use -Wstrict-prototypes after all. - * configure: Regenerated. - -1998-07-29 Jim Blandy <jimb@zwingli.cygnus.com> - - * configure.in: Request more warnings. - * configure: Regenerated. - * HACKING: Ask people not to make changes that introduce those - warnings. Now I have to go through the code and actually bring it - up to standards... :( - - * Makefile.in, aclocal.m4, configure: Regenerated using the last - public version of automake, not the hacked Cygnus version. - * config.guess, config.sub, ltconfig, ltmain.sh: New versions from - libtool. - - * configure.in, qthreads.m4: Display a message about how the - threads configuration went. - * aclocal.m4, configure: Regenerated. - -1998-07-28 Jim Blandy <jimb@zwingli.cygnus.com> - - Remove the TOTORO kludge. We're not doing snapshots any more, so - totoro is completely uninvolved. (Poor Totoro!) - * configure.in: Remove code to check the hostname and #define - TOTORO. - * acconfig.h: Remove comments for TOTORO symbol. - * configure, Makefile.in: Regenerated. - - * qthreads.m4 (QTHREADS_CONFIGURE): We *can* use AC_REQUIRE here - to get AC_PROG_LN_S. - * aclocal.m4, configure: Regenerated. - -1998-07-26 Jim Blandy <jimb@zwingli.cygnus.com> - - Clean up thread configuration. - * qthreads.m4: New file, which knows how to configure the qthreads - library. - * configure.in: Replace all thread package selection code. Do the - --with-threads argument processing here. Enable the appropriate - thread interface files in libguile. Remove all qthreads - configuration code; call QTHREADS_CONFIGURE instead. Set - GUILE_LIBS using the info provided by QTHREADS_CONFIGURE. - * threads.m4: Removed; not used any more. - * Makefile.am (aclocal_DATA): Mention qthreads.m4, not threads.m4. - * Makefile.in, aclocal.m4, configure: Rgnrtd. (Sv th vwls!) - Note that these were regenerated with the tools available from - Cygnus's source tree, which have patches not available to the - general public. I'm not sure this was a good idea; feel free to - revert them to the latest released versions of the tools. - - Upgrade to the version of libtool available at Cygnus. See note - above. - * config.guess, config.sub, ltconfig, ltmain.sh: Upgraded. - -1998-07-12 Mikael Djurfeldt <mdj@barbara.nada.kth.se> - - * configure.in: Changed variable HOSTNAME --> PROG_HOSTNAME in - totoro kludge. - -Sat Jul 11 21:54:29 1998 Mikael Djurfeldt <mdj@totoro.red-bean.com> - - * acconfig.h, configure.in: Define TOTORO if configuring on - totoro.red-bean.com. - - * configure.in: Check for strdup. - -1998-05-19 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * configure.in: Check for rl_cleanup_after_signal. - -1998-05-11 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * configure.in: Added test for rl_getc_function. Warn if - libreadline is found but not this function. - -1998-05-06 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * configure.in: Replaced some AC_CHECK_FUNC --> AC_CHECK_FUNCS so - that suitable HAVE_<function name> symbols get defined. - -1998-04-25 Mikael Djurfeldt <mdj@kenneth> - - * configure.in: Define USLEEP_RETURNS_VOID on some systems. - (Thanks to Julian Satchell.) - -1998-04-20 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * configure.in: Check for usleep; Define DECLARE_BZERO and - DECLARE_USLEEP on Solaris 2.5 since it supplies those functions - without declaring them. - - * acconfig.h: Added DECLARE_BZERO, DECLARE_USLEEP - -1998-04-19 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * configure.in: Define HAVE_DLOPEN also when HAVE_LIBDL is - defined. - -1998-04-18 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * configure.in (GUILE_LIBS): New variable. Contains libraries - which libguile needs to be linked with. Substituted into - libpath.h. - - * threads.m4 (threads_package): Don't add $LDFLAGS and $LIBS to - $cy_cv_threads_libs. - -1998-04-11 Mikael Djurfeldt <mdj@kenneth> - - New libtool: 1.2 - * ltconfig, ltmain.sh, config.sub, config.guess: Updated. - New automake: 1.3 - * Makefile.in, aclocal.m4, configure: Regenerated. - * README: Mention new version numbers on libtool and automake. - -1997-12-11 Tim Pierce <twp@skepsis.com> - - * HACKING: Note that SSH is mandatory for CVS access. - -Sun Dec 7 06:11:24 1997 Gary Houston <ghouston@actrix.gen.nz> - - * README: using Automake 1.2d - * configure.in: AC_CHECK_FUNCS: add "system". - -1997-12-01 Tim Pierce <twp@skepsis.com> - - * acconfig.h: Add USCORE. - -1997-11-27 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * configure.in: Added code to enable GUILE_ISELECT on systems - which have the necessary functions (gettimeofday, select). - - * acconfig.h: Added GUILE_ISELECT. - -1997-11-24 Tim Pierce <twp@twp.tezcat.com> - - * acinclude.m4: Assume dlsym does not add underscore if - cross-compiling. - * aclocal.m4, configure: Regenderated. - -1997-11-21 Tim Pierce <twp@twp.tezcat.com> - - * acinclude.m4 (GUILE_DLSYM_USCORE): New macro, thanks Dan Hagerty - <hag@ai.mit.edu>. - * configure.in: Use it. - * configure: Regenerated. - * acconfig.h (DLSYM_ADDS_USCORE): New #define. - -1997-10-26 Mikael Djurfeldt <mdj@nada.kth.se> - - * README (libtool): Tell people to use version 1.0e. - -Sat Oct 25 02:50:43 1997 Jim Blandy <jimb@totoro.red-bean.com> - - Call the QuickThreads library libqthreads.a, not libqt.a. The old - name conflicts with the Qt user interface toolkit. - * threads.m4 (CY_AC_WITH_THREADS): Use new library name. - * configure.in: Same. - * aclocal.m4, configure: Regenerated. - -Thu Oct 23 00:58:06 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * configure.in: Check for the readline library, and the termcap - library (on which readline relies). - * configure: Regenerated. - -Wed Oct 22 16:55:57 1997 Jim Blandy <jimb@totoro.red-bean.com> - - New libtool: 1.0e - * ltconfig, ltmain.sh, config.sub, config.guess: Updated. - * configure, aclocal.m4: Regenerated. - -1997-10-02 Marius Vollmer <mvo@zagadka.ping.de> - - Make dynamic linking work on Dec Unix. (Thanks to Clark McGrew) - * configure.in: Check whether dlopen can be found without -ldl. - -Mon Sep 29 23:52:52 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * Makefile.in: Regenerated with automake 1.2c. - -Sat Sep 27 23:01:58 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * Makefile.am: Add new `build' subdirectory to SUBDIRS. - * configure.in: Add build/Makefile to AC_OUTPUT clause. - * Makefile.in, configure: Regenerated. - - * Makefile.in, aclocal.m4: Regenerated with automake 1.2a. - -Tue Sep 16 00:19:46 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * README, ltconfig, ltmain.sh: New libtool: 1.0c. - -Thu Sep 11 11:28:24 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * ltmain.sh: Added a missing '\' before \n on line 32. - -Thu Aug 28 23:40:43 1997 Jim Blandy <jimb@totoro.red-bean.com> - - New libtool: 1.0b. - * ltconfig, ltmain.sh, config.guess: Freshly libtoolized. - * Makefile.in, aclocal.m4, configure: Regenerated, salamander-style. - -Wed Aug 27 11:35:09 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * Makefile.in: Regenerated, so it uses "tar", not "gtar". - - * configure.in: Use the QuickThreads assembler fragment with Irix - dynamic linking support for Irix 6 as well as Irix 5. Thanks to - Jesse Glick. - * configure: Regenerated. - -Sun Aug 24 15:51:12 1997 Mikael Djurfeldt <mdj@kenneth> - - * acinclude.m4 (GUILE_NAMED_CHECK_FUNC): New macro: Tagged test, - so that test for the same function can be performed multiple - times. - - * configure.in (AC_CHECK_HEADERS): Test for rxposix.h, - rx/rxposix.h. Add library rx only if regcomp can't be found - without it. - - * acconfig.h (HAVE_REGCOMP): Added it here since autoheader misses - it for some reason! - -Fri Aug 22 21:21:49 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * THANKS: New file. - * Makefile.in, aclocal.m4, configure: Regenerated. - -Wed Jul 23 20:24:27 1997 Mikael Djurfeldt <djurf@zafir.e.kth.se> - - * configure.in: Added thread support for the alpha architecture. - configure: Regenerated. - -Thu Jul 17 07:56:05 1997 Gary Houston <ghouston@actrix.gen.nz> - - * configure.in: use AC_CHECK_FUNCS for sethostent etc., - so scmconfig.h is updated with the test results. this may - disable one of the cygwin hacks. - -Fri Jul 11 00:18:19 1997 Jim Blandy <jimb@floss.red-bean.com> - - Changes to compile under gnu-win32, from Marcus Daniels: - * configure.in: When sys/un.h exists, define HAVE_UNIX_DOMAIN_SOCKETS - to indicate that Unix domain sockets will work. - Check for socketpair, getgroups, setwent, pause, and tzset - (cygwin currently lacks these them). - Check for sethostent endhostent getnetent setnetent endnetent - getprotoent endprotoent getservent endservent getnetbyaddr - getnetbyname inet_lnaof inet_makeaddr inet_netof (cygwin currently - lacks them). In the case of cygwin, temporarily prefix these - functions with "cygwin32_", the way that netdb.h does. - Don't define HAVE_REGCOMP unless both regcomp and regex.h are - available (cygwin b18 came distributed without a working regex.h - file). - * acconfig.h (HAVE_UNIX_DOMAIN_SOCKETS): Add this. - * configure: Regenerated. - -Wed Jul 2 12:28:40 1997 Tim Pierce <twp@twp.tezcat.com> - - * ltmain.sh: Remove any trailing colon on $shlibpath_var - (i.e. LD_LIBRARY_PATH) for braindamaged linkers that choke on it. - Patch sent to bug-libtool. - -Sat Jun 28 16:13:43 1997 Tim Pierce <twp@twp.tezcat.com> - - * configure.in: Add alloca.o explicitly to LIBOBJS (thanks Eric - Backus for reporting this problem and suggesting a fix). - * configure: Regenerated. - -Thu Jun 26 20:43:31 1997 Jim Blandy <jimb@floss.red-bean.com> - - * Guile 1.2 released. - - * configure.in: Check for librx after libm; fundamentals need to - come first. - * configure: Regenerated. - -Tue Jun 24 13:34:20 1997 Tim Pierce <twpierce@bio-5.bsd.uchicago.edu> - - * aclocal.m4 (AM_PATH_PROG_LD): Change `ac_cv_path_LD' typo to - `am_cv_path_LD'. - * configure: Regenerated. - -Sun Jun 22 15:43:07 1997 Jim Blandy <jimb@floss.red-bean.com> - - Try to detect when people are using one version of libguile and a - different version of ice-9. People have been skewing things and - sending in bug reports. - * configure.in: Provide libguile its version information through a - separate header file generated by the Makefile, not through - scmconfig.h. - (GUILE_MAJOR_VERSION, GUILE_MINOR_VERSION, GUILE_VERSION): - AC_SUBST these, instead of AC_DEFINE'ing them. - (GUILE_STAMP): New AC_SUBST: the time we configured the tree. - (AC_OUTPUT): Create ice-9/version.scm. - * acconfig.h (GUILE_MAJOR_VERSION, GUILE_MINOR_VERSION, - GUILE_VERSION): Deleted. - * Makefile.in: Regenerated. - - * aclocal.m4: Regenerated, using the libtool 0.9h m4 macros. - - * Makefile.am (EXTRA_DIST): Include acconfig.h in the - distribution. - * Makefile.in: Regenerated. - -Sat Jun 21 00:14:07 1997 Jim Blandy <jimb@floss.red-bean.com> - - * ltmain.sh (line 1191): Don't forget 'test' in if statement. - - * ltconfig, ltmain.sh: libtoolized, using libtool 0.9h. - -Wed Jun 11 00:34:01 1997 Jim Blandy <jimb@floss.red-bean.com> - - * ltconfig, ltmain.sh, config.guess: New files from libtool 0.9g. - - * configure.in: By default, include functions in Guile to allow - linking with dynamic libraries at run-time. In other words, - --enable-dynamic-linking is now the default. - * configure: Rebuilt. - - * configure.in: Remove space between AC_CHECK_LIB and opening - paren in check for Rx. - * configure: Regenerated. - - * configure.in: Remove all mention of xtra_PLUGIN_guile_libs. - It's never used. - * configure, Makefile.in: Regenerated. - -Tue Jun 10 23:37:12 1997 Jim Blandy <jimb@floss.red-bean.com> - - * configure.in: Move checks for libraries (-lm, -lnsl, -lsocket, - -dl, -dld) before checks for functions. - * configure: Regenerated. - -Mon Jun 9 02:35:46 1997 Tim Pierce <twp@twp.tezcat.com> - - * config.guess: New copy from autoconf-2.12, which recognizes - OpenBSD. - -Tue Jun 3 16:34:19 1997 Jim Blandy <jimb@totoro.cyclic.com> - - * configure.in: Check for Rx, so we will use its routines (which I - pretty much trust) if it is installed. - * configure: Regenerated. - -Sat May 31 03:48:45 1997 Gary Houston <ghouston@actrix.gen.nz> - - * acconfig.h: mention HAVE_RESTARTS. - * configure.in: check for sigaction and restartable system calls. - -Tue May 27 22:47:52 1997 Tim Pierce <twp@twp.tezcat.com> - - * configure.in: Check for presence of regcomp. - * configure: Regenerated. - -Mon May 26 12:14:20 1997 Jim Blandy <jimb@floss.cyclic.com> - - * COPYING: New address for FSF. - - * configure.in: We don't need to add fileblocks.o to LIBOBJS if - struct stat doesn't have the st_blocks field. We take care of - that case in the code. Replace AC_STRUCT_ST_BLOCKS with its - definition, edited appropriately. (Bernard URBAN) - * configure: Regenerated. - -Sat May 17 13:49:28 1997 Jim Blandy <jimb@floss.cyclic.com> - - * configure.in: Don't link against -lnsl or -lsocket unless we - actually need to. This causes trouble on Irix. (Thanks to Larry - Schwimmer.) - - * config.sub: Get newer version, that recognizes the i686. - -Fri May 16 17:26:10 1997 Jim Blandy <jimb@totoro.cyclic.com> - - * README: Changed Mikael's threads work attribution in order - to sooth Anthony's enormous, but wounded, ego. - -Fri May 16 17:26:53 1997 Jim Blandy <jimb@totoro.cyclic.com> - - Just kidding!!! - -Fri May 16 04:24:48 1997 Jim Blandy <jimb@floss.cyclic.com> - - Guile 1.1 released. - * GUILE-VERSION: Bump to 1.1. - -Tue May 13 16:34:40 1997 Jim Blandy <jimb@floss.cyclic.com> - - Switch to automake-1.1p. - * Makefile.in, aclocal.m4, configure: Regenerated. - -Mon May 12 18:29:45 1997 Jim Blandy <jimb@floss.cyclic.com> - - * threads.m4: Copy Anthony's change here, so it'll actually - survive. - -Thu May 8 11:48:40 1997 Anthony Green <green@hoser.cygnus.com> - - * aclocal.m4: Fixes for building with coop threads in a - seperate compilation directory. - * configure: Rebuilt. - -Fri May 2 16:24:15 1997 Jim Blandy <jimb@floss.cyclic.com> - - Upgrade to libtool 0.9e. - * ltconfig, ltmain.sh, config.guess, config.sub: New versions, - supplied by libtool. - - * configure.in: When configuring qt, sunos needs the underscore - files; Solaris and Linux both need the normal files. - * configure: Reebilt. - -Thu May 1 15:35:49 1997 Jim Blandy <jimb@floss.cyclic.com> - - * configure.in: Get the paths for qt's md files right, so it can - build correctly when using a separate compilation directory. - * configure: Regenerated. - -Thu Apr 24 01:20:34 1997 Jim Blandy <jimb@floss.cyclic.com> - - Get threads to work again. - * Makefile.am (SUBDIRS): List libguile last, so qt gets built - first. - * Makefile.in: Regenerated. - * aclocal.m4, configure: Regenerate, with modern definition of - CY_AC_WITH_THREADS. Where did the old text come from? Creepy... - - Reduced Guile distribution: one configure script, no plugins. - * configure.in: Merged the old text from qt/configure.in and - libguile/configure.in; Tom Tromey says automake only wants one - configure.in script. This seems fishy, but... - * Makefile.am: List the subdirectories explicitly; no more PLUGIN - gubbish. - * acconfig.h, acinclude.m4: Moved here from libguile, since - libguile's configure script lives here now. - * AUTHORS, INSTALL, README: Updated. - * Makefile.in, aclocal.m4 configure: Regenerated. Just like - amputated amphibian limbs. - -Tue Apr 22 16:57:38 1997 Jim Blandy <jimb@totoro.cyclic.com> - - * newdoc/ref/Makefile.am (dist_texis): Distribute the index files. - * newdoc/ref/Makefile.in: Regenerated. - -Mon Apr 14 18:51:25 1997 Jim Blandy <jimb@floss.cyclic.com> - - * threads.m4 (CY_AC_WITH_THREADS): When using coop threads, no - need to link against libthreads; the files it used to contain - are now a part of libguile. - -Sun Apr 13 22:14:10 1997 Jim Blandy <jimb@floss.cyclic.com> - - * guile.m4: Revert change of Mar 15, and use the new 'no-define' - argument to the AM_INIT_AUTOMAKE macro. - -Fri Apr 11 15:43:07 1997 Jim Blandy <jimb@totoro.cyclic.com> - - * ltconfig, ltmain.sh: Upgraded libtool files to 0.9d. - * README: Say where to find libtool 0.9d. - -Wed Apr 9 17:51:13 1997 Jim Blandy <jimb@floss.cyclic.com> - - Changes to work with automake-1.1n, which has better libtool - support. Also use libtool 0.8. - * README: Note new version numbers for automake and libtool. - * missing: New file required by new automake. - * Makefile.in: Regenerated. - -Sat Apr 5 16:48:38 1997 Jim Blandy <jimb@floss.cyclic.com> - - * newdoc/ref/scheme.texi (set-object-property!): Fix function name. - - * Makefile.am: Omit doc subtree. - * configure.in: Omit makefiles in doc subtree. - * Makefile.in, configure: Rebuilt. - -Sat Mar 15 01:11:44 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * guile.m4 (AM_INIT_GUILE_MODULE): Replaced AM_INIT_AUTOMAKE macro - with its definition and commented out definition of PACKAGE. This - changed seemed necessary after having removed PACKAGE from - libguile/acconfig.h. - -Mon Feb 24 21:43:26 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * ltconfig, ltmain.sh: New versions from libtool-0.9. - - * configure.in: Added AM_MAINTAINER_MODE - -Fri Feb 7 17:57:46 1997 Jim Blandy <jimb@floss.cyclic.com> - - * config.sub, config.guess: New versions, that handle i686, etc. - -Thu Jan 23 07:06:15 1997 Mark Galassi <rosalia@papageno.lanl.gov> - - * newdoc/tutorial/guile-tut.texi: started checking in the Guile - tutorial rewrite, but have not merged much into it yet. - -Tue Jan 21 17:28:40 1997 Mark Galassi <rosalia@sarastro.lanl.gov> - - * newdoc/ref/guile-ref.texi: started checking in parts of the - reference manual re-write. - -Sat Jan 11 14:40:17 1997 Marius Vollmer <mvo@zagadka.ping.de> - - * ltconfig, ltmain.sh: New files for libtool support. libguile, - rx, gh and gtcltk-lib can now be build as shared libraries. - * Makefile.am (EXTRA_DIST): Added ltconfig and ltmain.sh - -Sun Jan 5 16:57:10 1997 Jim Blandy <jimb@floss.cyclic.com> - - * Guile 1.0 released. This is the first release by the Free - Software Foundation; Cygnus has also released earlier versions of - Guile. - - * GUILE-VERSION: Updated version number. - * NEWS: Added comments for all the user-visible changes marked in - the ChangeLogs. - * README: Updated for release. - -Thu Dec 12 00:14:32 1996 Gary Houston <ghouston@actrix.gen.nz> - - * scsh: new directory. - -Mon Dec 2 17:33:04 1996 Tom Tromey <tromey@cygnus.com> - - * configure.in: Generate doc/guile-programmer/Makefile and - doc/guile-user/Makefile. - -Sat Nov 30 23:45:54 1996 Tom Tromey <tromey@cygnus.com> - - * aclocal.m4: Now automatically generated by aclocal. - * threads.m4: New file. - * guile.m4: New file. - * Makefile.am, doc/Makefile.am: New files. - * configure.in: Updated for Automake. Avoid excessively verbose - "greet" messages. - -Wed Oct 16 07:32:14 1996 Mark Galassi <rosalia@sarastro.lanl.gov> - - * lgh: directory renamed to gh, along with all prefixes of the - high level library procedures. - -Thu Oct 10 14:37:43 1996 Jim Blandy <jimb@floss.cyclic.com> - - * Makefile.in (TAGS tags): Find the source files in $srcdir. - -Wed Oct 9 19:37:14 1996 Jim Blandy <jimb@floss.cyclic.com> - - * Makefile.in (DISTFILES): Add AUTHORS and aclocal.m4. - -Tue Oct 1 00:13:55 1996 Mikael Djurfeldt <mdj@woody.nada.kth.se> - - * configure.in: Added some configuration magic from the Cygnus - distribution. - - * aclocal.m4: New file. For now used for thread support - configuration. - -Fri Sep 13 14:39:30 1996 Mark Galassi <rosalia@sarastro.lanl.gov> - - * Makefile.in (DISTFILES): added mkinstalldirs to the DISTFILES - - * PLUGIN: changed the PLUGIN/REQ files in the ice-9 and lgh - directories, to arrange for lgh to the last thing - configured/built. - -Wed Sep 11 21:11:33 1996 Mark Galassi <rosalia@nis.lanl.gov> - - * lgh/: added the directory in which I implement the high level - libguile library (lgh_) for this release of Guile. See the - ChangeLog in there for further details. - -Wed Sep 11 16:12:53 1996 Mark Galassi <rosalia@sarastro.lanl.gov> - - * doc/ (guile-user and guile-programmer): added the guile-user and - guile-programmer directories which contain the user and programmer - manuals. See the ChangeLog entries there for detail. - -Wed Sep 11 14:33:49 1996 Jim Blandy <jimb@floss.cyclic.com> - - * Makefile.in (distclean): Don't forget to delete doc/Makefile. - - * Makefile.in (distclean): Don't forget to delete - config.build-subdirs. - -Thu Sep 5 17:36:15 1996 Jim Blandy <jimb@floss.cyclic.com> - - * Makefile.in (tags): New name for `TAGS' target, which will - always run the commands. - -Thu Sep 5 09:56:50 1996 Jim Blandy <jimb@totoro.cyclic.com> - - * README: Doc fixes. - -Fri Aug 30 16:56:27 1996 Jim Blandy <jimb@floss.cyclic.com> - - * Makefile.in (TAGS): Produce a single tags file for all of Guile. - -Thu Aug 15 19:03:03 1996 Jim Blandy <jimb@floss.cyclic.com> - - * configure.in: Check for -ldl, so the check for Tcl won't fail - spuriously. - -Thu Aug 15 01:29:29 1996 Jim Blandy <jimb@totoro.cyclic.com> - - Change the way we decide whether to build gtcltk-lib, so that it's - omitted from the build process when appropriate, but never from - the dist process. - * configure.in: Don't edit all_subdirs depending on the - availability of Tk; let that be the list of all PLUGIN - subdirectories present, as it used to be. Instead, edit a new - variable, build_subdirs; write its final value, the list of - subdirs we do want to compile in, to config.build-subdirs. - Substitute that into the top-level Makefile too. - * Makefile.in (subdirs): Set this to @build_subdirs@, so we only - recurse on the subdirectories we should build. - (distdirs): Set this to @existingdirs@, so it includes the subdirs - we decided not to build. - - * doc/gtcltk.texi: File resurrected from old Guile releases. - * doc/Makefile.in (info): Build the gtcltk documentation. - (DIST_FILES): Include it in the distribution. - - * configure.in: If we can find the library for tcl7.5, build - gtcltk-lib. Call AC_PROG_CC, to help run that test with the right - compiler (not sure this is necessary). - -Mon Aug 12 15:09:37 1996 Jim Blandy <jimb@totoro.cyclic.com> - - * NEWS: Fix bug reporting address. - -Fri Aug 9 15:58:42 1996 Jim Blandy <jimb@totoro.cyclic.com> - - * AUTHORS: New file, in accordance with the GNU maintainers' - standards. - -Tue Aug 6 14:40:44 1996 Jim Blandy <jimb@totoro.cyclic.com> - - * README: Renamed from ANNOUNCE; include bug report address, - description, and short tour. - * INSTALL: Renamed from BUILDING. - * NEWS: New file. - * Makefile.in (DISTFILES): Update appropriately. - -Thu Aug 1 02:31:53 1996 Jim Blandy <jimb@totoro.cyclic.com> - - * doc/Makefile.in: Added pattern targets for creating DVI and - PostScript files. - (%.ps, %.dvi, %.txt): New targets. - (DVIPS, TEXI2DVI): New variables. - - * GUILE-VERSION: Updated to 1.0b3. - - Rehashed distribution system, in preparation for nightly - snapshots. Other changes in subdirectories. - * Makefile.in (dist): Rewritten --- the old target was out of - date, dependent on files that we don't have, and relied on GNU - tar. The new target is simpler. - (VERSION, srcdir, dist_dirs): New variables. - (DISTFILES): Renamed from localfiles. Added GUILE-VERSION and - TODO. - (localtreats): Variable removed. We don't have this file. - (info): cd to doc and make info there; don't make info in every - ${subdir}; those Makefiles don't know what to do. - (distname, distdir, treats, announcefile): Variables removed. - (manifest-file): Target removed. - (dist-dir): New target, responsible for distributable files in - this directory. - (GZIP, GZIP_EXT, TAR_VERBOSE, DIST_NAME): New variables, - controlling the 'dist' target. - * configure.in: Substitute GUILE-VERSION into the top-level - Makefile. Build doc/Makefile from doc/Makefile.in. - - * doc/Makefile.in: New file. diff --git a/GUILE-VERSION b/GUILE-VERSION deleted file mode 100644 index 6904bec5e..000000000 --- a/GUILE-VERSION +++ /dev/null @@ -1,7 +0,0 @@ -GUILE_MAJOR_VERSION=1 -GUILE_MINOR_VERSION=2.91 -GUILE_VERSION=$GUILE_MAJOR_VERSION.$GUILE_MINOR_VERSION - -# For automake. -VERSION=$GUILE_VERSION -PACKAGE=guile diff --git a/HACKING b/HACKING deleted file mode 100644 index bd3f32ff5..000000000 --- a/HACKING +++ /dev/null @@ -1,144 +0,0 @@ -Here are some guidelines for members of the Guile developers team. - -CVS conventions ====================================================== - -- We use CVS to manage the Guile sources. The repository lives on -egcs.cygnus.com, in /egcs/carton/cvsfiles; you will need an account on -that machine to access the repository. Also, for security reasons, -egcs 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@egcs.cygnus.com:/egcs/carton/cvsfiles - -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.cs.hut.fi/ssh. - -The Guile sources live in several modules: - - - guile-core --- the interpreter, QuickThreads, and ice-9 - - guile-doc --- documentation in progress. When complete, this will - be incorporated into guile-core. - - 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-comp --- the Hobbit compiler (talk to mdj) - - guile-emacs --- Guile/Emacs interface (talk to mdj) - - guile-oops --- The Guile Object-Oriented Programming System (talk to mdj) - - guile-www --- A Guile module for making HTTP requests. - -- We check Makefile.in and configure files into CVS, as well as the -files they are built from (Makefile.am, configure.in); we do not check -in Makefiles or header files generated by configuration scripts. The -general rule is that you should be able to check out a working -directory of Guile from CVS, and then type "configure" and "make", -without running any other tools. - -- Make sure your changes compile and work, at least on your own -machine, before checking them into the main branch of the Guile -repository. 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 ===================================================== - -- As for any part of Project GNU, changes to Guile should follow the -GNU coding standards. The standards are available via anonymous FTP -from prep.ai.mit.edu, as /pub/gnu/standards/standards.texi and -make-stds.texi. - -- The Guile tree should compile without warnings under the following -GCC switches, which are the default in the current configure script: - -O2 -Wall -Wpointer-arith -Wmissing-prototypes -The only exceptions are the warnings about variables being clobbered -by longjmp/vfork in eval.c. (Tho' if you can figure out how to get -rid of those, too, I'd be happy.) - -Note that the warnings generated vary from one version of GCC to the -next, and from one architecture to the next (apparently). To provide -a concrete common standard, Guile should compile without warnings from -GCC 2.7.2.3 in a Red Hat 5.0 i386 Linux machine. Furthermore, each -developer should pursue any additional warnings noted by on their -compiler. This means that people using more stringent compilers will -have more work to do, and assures that everyone won't switch to the -most lenient compiler they can find. :) - -- When you make a user-visible change (i.e. one that should be -documented, and appear in NEWS, put an asterisk in column zero of the -start of the ChangeLog entry, like so: - -Sat Aug 3 01:27:14 1996 Gary Houston <ghouston@actrix.gen.nz> - -* * fports.c (scm_open_file): don't return #f, throw error. - -When you've written a NEWS entry and updated the documentation, go -ahead and remove the asterisk. I will use the asterisks to find and -document changes that haven't been dealt with before a release. - -- There's no need to keep a change log for documentation files. This -is because documentation is not susceptible to bugs that are hard to -fix. Documentation does not consist of parts that must interact in a -precisely engineered fashion; to correct an error, you need not know -the history of the erroneous passage. (This is copied from the GNU -coding standards.) - -- Make sure you have papers from people before integrating their -changes or contributions. This is very frustrating, but very -important to do right. From maintain.texi, "Information for -Maintainers of GNU Software": - - When incorporating changes from other people, make sure to follow the - correct procedures. Doing this ensures that the FSF has the legal - right to distribute and defend GNU software. - - For the sake of registering the copyright on later versions ofthe - software you need to keep track of each person who makes significant - changes. A change of ten lines or so, or a few such changes, in a - large program is not significant. - - *Before* incorporating significant changes, make sure that the person - has signed copyright papers, and that the Free Software Foundation has - received them. - -If you receive contributions you want to use from someone, let me know -and I'll take care of the administrivia. Put the contributions aside -until we have the necessary papers. - -- When you make substantial changes to a file, add the current year to -the list of years in the copyright notice at the top of the file. - - -Helpful hints ======================================================== - -- [From Mikael Djurfeldt] When working on the Guile internals, it is -quite often practical to implement a scheme-level procedure which -helps you examine the feature you're working on. - -Examples of such procedures are: pt-size, debug-hand and -current-pstate. - -I've now put #ifdef GUILE_DEBUG around all such procedures, so that -they are not compiled into the "normal" Guile library. Please do the -same when you add new procedures/C functions for debugging purpose. - -You can define the GUILE_DEBUG flag by passing --enable-guile-debug to -the configure script. - -- You'll see uses of the macro SCM_P scattered throughout the code; -those are vestiges of a time when Guile was meant to compile on -pre-ANSI compilers. Guile now requires ANSI C, so when you write new -functions, feel free to use ANSI declarations, and please provide -prototypes for everything. You don't need to use SCM_P in new code. - - -Jim Blandy diff --git a/INSTALL b/INSTALL deleted file mode 100644 index 8f2cb3ef0..000000000 --- a/INSTALL +++ /dev/null @@ -1,218 +0,0 @@ -Brief Installation Instructions =========================================== - -To build Guile on unix, there are two basic steps: - - 1. Type "./configure", to configure the package for your system. - 2. Type "make", to build the package. - -Generic instructions for configuring and compiling GNU distributions -are included below. - - -Special Instructions For Some Systems ===================================== - -We would like Guile to build on all systems using the simple -instructions above, but it seems that a few systems still need special -treatment. If you can send us fixes for these problems, we'd be -grateful. - -SunOS 4.1: Guile's shared library support seems to be confused, but - hey; shared libraries are confusing. You may need to configure - Guile with a command like: - ./configure --disable-shared - For more information on `--disable-shared', see below, "Flags - Accepted by Configure". - -HP/UX: GCC 2.7.2 (and maybe other versions) have trouble creating - shared libraries if they depend on any non-shared libraries. GCC - seems to have other problems as well. To work around this, we - suggest you configure Guile to use the system's C compiler: - CC=cc ./configure - - -What You Get ============================================================== - -The `configure' script examines your system, and adapts Guile to -compile and run on it. - -The `make' command builds several things: -- An executable file `guile/guile', which is an interactive shell for - talking with the Guile Scheme interpreter. -- An object library `libguile/.libs/libguile.a', containing the Guile Scheme - interpreter, ready to be linked into your programs. - -To install Guile, type `make install'. This installs the executable -and libraries mentioned above, as well as Guile's header files and -Scheme libraries. - -Make also builds shared libraries, on systems that support them. -Because of the nature of shared libraries, before linking against -them, you should probably install them; `make install' takes care of -this. - - -Flags Accepted by Configure =============================================== - -If you run the configure script with no arguments, it should examine -your system and set things up appropriately. However, there are a few -switches specific to Guile you may find useful in some circumstances. - ---enable-maintainer-mode --- If you have automake, autoconf, and -libtool installed on your system, this switch causes configure to -generate Makefiles which know how to automatically regenerate -configure scripts, makefiles, and headers, when they are out of date. -The README file says which versions of those tools you will need. - ---with-threads --- Build a Guile executable and library that supports -cooperative threading. If you use this switch, Guile will also build -and install the QuickThreads non-preemptive threading library, -libqt.a, which you will need to link into your programs after -libguile.a. That is, you should pass the switches -lguile -qt to your -linker. - -Coop threads are not yet thoroughly tested; once they are, they will -be enabled by default. The interaction with blocking I/O is pretty ad -hoc at the moment. In our experience, bugs in the thread support do -not affect you if you don't actually use threads. - -At the moment, threads are known not to work with the NetBSD 1.2 -assembler. - ---enable-dynamic-linking --- Build a Guile executable and library -providing Scheme functions which can load a shared library and -initialize it, perhaps thereby adding new functions to Guile. This -feature is not yet thoroughly tested; once it is, it will be enabled -by default. This option has no effect on systems that do not support -shared libraries. - ---disable-shared --- Do not build shared libraries. Normally, Guile -will build shared libraries if your system supports them. Guile -always builds static libraries. - - -Using Guile Without Installing It ========================================= - -If you want to run Guile without installing it, set the environment -variable `GUILE_LOAD_PATH' to a colon-separated list of directories, -including the directory containing this INSTALL file. If you used a -separate build directory, you'll need to include the build directory -in the path as well. - -For example, suppose the Guile distribution unpacked into a directory -called `/home/jimb/guile-snap' (so the full name of this file would be -`/home/jimb/guile-snap/INSTALL'). Then you might say: - - export GUILE_LOAD_PATH=/home/jimb/guile-snap - -if you're using Bash or any other Bourne shell variant, or - - setenv GUILE_LOAD_PATH /home/jimb/guile-snap - -if you're using CSH or one of its variants. - -If you built Guile in a separate directory from the source tree, then -you'll need to include your build directory in the GUILE_LOAD_PATH as -well. For example, if you built in a subdirectory of the source tree -called `pentium', you might say: - - export GUILE_LOAD_PATH=/home/jimb/guile-snap:/home/jimb/guile-snap/pentium - - -Building a Statically Linked Guile ======================================== - -Sometimes it's useful to build a statically-linked version of the -Guile executable. It's helpful in debugging, and for producing -stand-alone executables for distribution to machines you don't -control. - -To do this, set the LDFLAGS environment variable to `-static' before -you configure, or before you run the `make' command to build the -executable. - - -Generic Instructions for Building Auto-Configured Packages ================ - -To compile this package: - -1. Configure the package for your system. In the directory that this -file is in, type `./configure'. If you're using `csh' on an old -version of System V, you might need to type `sh configure' instead to -prevent `csh' from trying to execute `configure' itself. - -The `configure' shell script attempts to guess correct values for -various system-dependent variables used during compilation, and -creates the Makefile(s) (one in each subdirectory of the source -directory). In some packages it creates a C header file containing -system-dependent definitions. It also creates a file `config.status' -that you can run in the future to recreate the current configuration. -Running `configure' takes a minute or two. - -To compile the package in a different directory from the one -containing the source code, you must use GNU make. `cd' to the -directory where you want the object files and executables to go and -run `configure' with the option `--srcdir=DIR', where DIR is the -directory that contains the source code. Using this option is -actually unnecessary if the source code is in the parent directory of -the one in which you are compiling; `configure' automatically checks -for the source code in `..' if it does not find it in the current -directory. - -By default, `make install' will install the package's files in -/usr/local/bin, /usr/local/lib, /usr/local/man, etc. You can specify -an installation prefix other than /usr/local by giving `configure' the -option `--prefix=PATH'. Alternately, you can do so by changing the -`prefix' variable in the Makefile that `configure' creates (the -Makefile in the top-level directory, if the package contains -subdirectories). - -You can specify separate installation prefixes for machine-specific -files and machine-independent files. If you give `configure' the -option `--exec_prefix=PATH', the package will use PATH as the prefix -for installing programs and libraries. Normally, all files are -installed using the same prefix. - -`configure' ignores any other arguments that you give it. - -If your system requires unusual options for compilation or linking -that `configure' doesn't know about, you can give `configure' initial -values for some variables by setting them in the environment. In -Bourne-compatible shells, you can do that on the command line like -this: - CC='gcc -traditional' DEFS=-D_POSIX_SOURCE ./configure - -The `make' variables that you might want to override with environment -variables when running `configure' are: - -(For these variables, any value given in the environment overrides the -value that `configure' would choose:) -CC C compiler program. - Default is `cc', or `gcc' if `gcc' is in your PATH. -INSTALL Program to use to install files. - Default is `install' if you have it, `cp' otherwise. -INCLUDEDIR Directory for `configure' to search for include files. - Default is /usr/include. - -(For these variables, any value given in the environment is added to -the value that `configure' chooses:) -DEFS Configuration options, in the form '-Dfoo -Dbar ...' -LIBS Libraries to link with, in the form '-lfoo -lbar ...' - -If you need to do unusual things to compile the package, we encourage -you to teach `configure' how to do them and mail the diffs to the -address given in the README so we can include them in the next -release. - -2. Type `make' to compile the package. - -3. Type `make install' to install programs, data files, and -documentation. - -4. You can remove the program binaries and object files from the -source directory by typing `make clean'. To also remove the -Makefile(s), the header file containing system-dependent definitions -(if the package uses one), and `config.status' (all the files that -`configure' created), type `make distclean'. - -The file `configure.in' is used as a template to create `configure' by -a program called `autoconf'. You will only need it if you want to -regenerate `configure' using a newer version of `autoconf'. diff --git a/Makefile.am b/Makefile.am deleted file mode 100644 index c6be506a8..000000000 --- a/Makefile.am +++ /dev/null @@ -1,11 +0,0 @@ -## Process this file with automake to produce Makefile.in. - -SUBDIRS = ice-9 qt libguile guile-config doc - -## FIXME: in the future there will be direct automake support for -## doing this. When that happens, switch over. -aclocaldir = $(datadir)/aclocal -aclocal_DATA = guile.m4 qthreads.m4 - -EXTRA_DIST = $(aclocal_DATA) ltconfig ltmain.sh acconfig.h \ - HACKING GUILE-VERSION diff --git a/Makefile.in b/Makefile.in deleted file mode 100644 index 864305f82..000000000 --- a/Makefile.in +++ /dev/null @@ -1,349 +0,0 @@ -# Makefile.in generated automatically by automake 1.3 from Makefile.am - -# Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc. -# This Makefile.in 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 program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - - -SHELL = /bin/sh - -srcdir = @srcdir@ -top_srcdir = @top_srcdir@ -VPATH = @srcdir@ -prefix = @prefix@ -exec_prefix = @exec_prefix@ - -bindir = @bindir@ -sbindir = @sbindir@ -libexecdir = @libexecdir@ -datadir = @datadir@ -sysconfdir = @sysconfdir@ -sharedstatedir = @sharedstatedir@ -localstatedir = @localstatedir@ -libdir = @libdir@ -infodir = @infodir@ -mandir = @mandir@ -includedir = @includedir@ -oldincludedir = /usr/include - -DISTDIR = - -pkgdatadir = $(datadir)/@PACKAGE@ -pkglibdir = $(libdir)/@PACKAGE@ -pkgincludedir = $(includedir)/@PACKAGE@ - -top_builddir = . - -ACLOCAL = @ACLOCAL@ -AUTOCONF = @AUTOCONF@ -AUTOMAKE = @AUTOMAKE@ -AUTOHEADER = @AUTOHEADER@ - -INSTALL = @INSTALL@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_DATA = @INSTALL_DATA@ -INSTALL_SCRIPT = @INSTALL_SCRIPT@ -transform = @program_transform_name@ - -NORMAL_INSTALL = : -PRE_INSTALL = : -POST_INSTALL = : -NORMAL_UNINSTALL = : -PRE_UNINSTALL = : -POST_UNINSTALL = : -host_alias = @host_alias@ -host_triplet = @host@ -AWK = @AWK@ -CC = @CC@ -CPP = @CPP@ -GUILE_LIBS = @GUILE_LIBS@ -GUILE_MAJOR_VERSION = @GUILE_MAJOR_VERSION@ -GUILE_MINOR_VERSION = @GUILE_MINOR_VERSION@ -GUILE_STAMP = @GUILE_STAMP@ -GUILE_VERSION = @GUILE_VERSION@ -LD = @LD@ -LIBLOBJS = @LIBLOBJS@ -LIBTOOL = @LIBTOOL@ -LN_S = @LN_S@ -MAINT = @MAINT@ -MAKEINFO = @MAKEINFO@ -NM = @NM@ -PACKAGE = @PACKAGE@ -QTHREAD_LTLIBS = @QTHREAD_LTLIBS@ -RANLIB = @RANLIB@ -THREAD_CPPFLAGS = @THREAD_CPPFLAGS@ -THREAD_LIBS_INSTALLED = @THREAD_LIBS_INSTALLED@ -THREAD_LIBS_LOCAL = @THREAD_LIBS_LOCAL@ -THREAD_PACKAGE = @THREAD_PACKAGE@ -VERSION = @VERSION@ -qtdmdb_s = @qtdmdb_s@ -qtmd_h = @qtmd_h@ -qtmdc_c = @qtmdc_c@ -qtmds_s = @qtmds_s@ - -SUBDIRS = ice-9 qt libguile guile-config doc - -aclocaldir = $(datadir)/aclocal -aclocal_DATA = guile.m4 qthreads.m4 - -EXTRA_DIST = $(aclocal_DATA) ltconfig ltmain.sh acconfig.h \ - HACKING GUILE-VERSION -ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 -mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs -CONFIG_HEADER = ./libguile/scmconfig.h -CONFIG_CLEAN_FILES = -DATA = $(aclocal_DATA) - -DIST_COMMON = README AUTHORS COPYING ChangeLog INSTALL Makefile.am \ -Makefile.in NEWS THANKS TODO acinclude.m4 aclocal.m4 config.guess \ -config.sub configure configure.in install-sh ltconfig ltmain.sh \ -mdate-sh missing mkinstalldirs - - -DISTFILES = $(DIST_COMMON) $(SOURCES) $(HEADERS) $(TEXINFOS) $(EXTRA_DIST) - -TAR = tar -GZIP = --best -all: all-recursive all-am - -.SUFFIXES: -$(srcdir)/Makefile.in: @MAINT@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) - cd $(top_srcdir) && $(AUTOMAKE) --gnu Makefile - -Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status $(BUILT_SOURCES) - cd $(top_builddir) \ - && CONFIG_FILES=$@ CONFIG_HEADERS= $(SHELL) ./config.status - -$(ACLOCAL_M4): @MAINT@ configure.in acinclude.m4 - cd $(srcdir) && $(ACLOCAL) - -config.status: $(srcdir)/configure - $(SHELL) ./config.status --recheck -$(srcdir)/configure: @MAINT@$(srcdir)/configure.in $(ACLOCAL_M4) $(CONFIGURE_DEPENDENCIES) - cd $(srcdir) && $(AUTOCONF) - -install-aclocalDATA: $(aclocal_DATA) - @$(NORMAL_INSTALL) - $(mkinstalldirs) $(DESTDIR)$(aclocaldir) - @list='$(aclocal_DATA)'; for p in $$list; do \ - if test -f $(srcdir)/$$p; then \ - echo " $(INSTALL_DATA) $(srcdir)/$$p $(DESTDIR)$(aclocaldir)/$$p"; \ - $(INSTALL_DATA) $(srcdir)/$$p $(DESTDIR)$(aclocaldir)/$$p; \ - else if test -f $$p; then \ - echo " $(INSTALL_DATA) $$p $(DESTDIR)$(aclocaldir)/$$p"; \ - $(INSTALL_DATA) $$p $(DESTDIR)$(aclocaldir)/$$p; \ - fi; fi; \ - done - -uninstall-aclocalDATA: - @$(NORMAL_UNINSTALL) - list='$(aclocal_DATA)'; for p in $$list; do \ - rm -f $(DESTDIR)$(aclocaldir)/$$p; \ - done - -# This directory's subdirectories are mostly independent; you can cd -# into them and run `make' without going through this Makefile. -# To change the values of `make' variables: instead of editing Makefiles, -# (1) if the variable is set in `config.status', edit `config.status' -# (which will cause the Makefiles to be regenerated when you run `make'); -# (2) otherwise, pass the desired values on the `make' command line. - -@SET_MAKE@ - -all-recursive install-data-recursive install-exec-recursive \ -installdirs-recursive install-recursive uninstall-recursive \ -check-recursive installcheck-recursive info-recursive dvi-recursive: - @set fnord $(MAKEFLAGS); amf=$$2; \ - list='$(SUBDIRS)'; for subdir in $$list; do \ - target=`echo $@ | sed s/-recursive//`; \ - echo "Making $$target in $$subdir"; \ - (cd $$subdir && $(MAKE) $$target) \ - || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \ - done && test -z "$$fail" - -mostlyclean-recursive clean-recursive distclean-recursive \ -maintainer-clean-recursive: - @set fnord $(MAKEFLAGS); amf=$$2; \ - rev=''; list='$(SUBDIRS)'; for subdir in $$list; do \ - rev="$$subdir $$rev"; \ - done; \ - for subdir in $$rev; do \ - target=`echo $@ | sed s/-recursive//`; \ - echo "Making $$target in $$subdir"; \ - (cd $$subdir && $(MAKE) $$target) \ - || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \ - done && test -z "$$fail" -tags-recursive: - list='$(SUBDIRS)'; for subdir in $$list; do \ - (cd $$subdir && $(MAKE) tags); \ - done - -tags: TAGS - -ID: $(HEADERS) $(SOURCES) $(LISP) - here=`pwd` && cd $(srcdir) \ - && mkid -f$$here/ID $(SOURCES) $(HEADERS) $(LISP) - -TAGS: tags-recursive $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) $(LISP) - tags=; \ - here=`pwd`; \ - list='$(SUBDIRS)'; for subdir in $$list; do \ - test -f $$subdir/TAGS && tags="$$tags -i $$here/$$subdir/TAGS"; \ - done; \ - list='$(SOURCES) $(HEADERS)'; \ - unique=`for i in $$list; do echo $$i; done | \ - awk ' { files[$$0] = 1; } \ - END { for (i in files) print i; }'`; \ - test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \ - || (cd $(srcdir) && etags $(ETAGS_ARGS) $$tags $$unique $(LISP) -o $$here/TAGS) - -mostlyclean-tags: - -clean-tags: - -distclean-tags: - -rm -f TAGS ID - -maintainer-clean-tags: - -distdir = $(PACKAGE)-$(VERSION) -top_distdir = $(distdir) - -# This target untars the dist file and tries a VPATH configuration. Then -# it guarantees that the distribution is self-contained by making another -# tarfile. -distcheck: dist - -rm -rf $(distdir) - GZIP=$(GZIP) $(TAR) zxf $(distdir).tar.gz - mkdir $(distdir)/=build - mkdir $(distdir)/=inst - dc_install_base=`cd $(distdir)/=inst && pwd`; \ - cd $(distdir)/=build \ - && ../configure --srcdir=.. --prefix=$$dc_install_base \ - && $(MAKE) \ - && $(MAKE) dvi \ - && $(MAKE) check \ - && $(MAKE) install \ - && $(MAKE) installcheck \ - && $(MAKE) dist - -rm -rf $(distdir) - @echo "========================"; \ - echo "$(distdir).tar.gz is ready for distribution"; \ - echo "========================" -dist: distdir - -chmod -R a+r $(distdir) - GZIP=$(GZIP) $(TAR) chozf $(distdir).tar.gz $(distdir) - -rm -rf $(distdir) -dist-all: distdir - -chmod -R a+r $(distdir) - GZIP=$(GZIP) $(TAR) chozf $(distdir).tar.gz $(distdir) - -rm -rf $(distdir) -distdir: $(DISTFILES) - -rm -rf $(distdir) - mkdir $(distdir) - -chmod 777 $(distdir) - here=`cd $(top_builddir) && pwd`; \ - top_distdir=`cd $(distdir) && pwd`; \ - distdir=`cd $(distdir) && pwd`; \ - cd $(top_srcdir) \ - && $(AUTOMAKE) --include-deps --build-dir=$$here --srcdir-name=$(top_srcdir) --output-dir=$$top_distdir --gnu Makefile - @for file in $(DISTFILES); do \ - d=$(srcdir); \ - test -f $(distdir)/$$file \ - || ln $$d/$$file $(distdir)/$$file 2> /dev/null \ - || cp -p $$d/$$file $(distdir)/$$file; \ - done - for subdir in $(SUBDIRS); do \ - test -d $(distdir)/$$subdir \ - || mkdir $(distdir)/$$subdir \ - || exit 1; \ - chmod 777 $(distdir)/$$subdir; \ - (cd $$subdir && $(MAKE) top_distdir=../$(distdir) distdir=../$(distdir)/$$subdir distdir) \ - || exit 1; \ - done -info: info-recursive -dvi: dvi-recursive -check: all-am - $(MAKE) check-recursive -installcheck: installcheck-recursive -all-am: Makefile $(DATA) - -install-data-am: install-aclocalDATA - -uninstall-am: uninstall-aclocalDATA - -install-exec: install-exec-recursive - @$(NORMAL_INSTALL) - -install-data: install-data-recursive install-data-am - @$(NORMAL_INSTALL) - -install: install-recursive install-data-am - @: - -uninstall: uninstall-recursive uninstall-am - -install-strip: - $(MAKE) INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' INSTALL_SCRIPT='$(INSTALL_PROGRAM)' install -installdirs: installdirs-recursive - $(mkinstalldirs) $(DATADIR)$(aclocaldir) - - -mostlyclean-generic: - -test -z "$(MOSTLYCLEANFILES)" || rm -f $(MOSTLYCLEANFILES) - -clean-generic: - -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) - -distclean-generic: - -rm -f Makefile $(DISTCLEANFILES) - -rm -f config.cache config.log stamp-h stamp-h[0-9]* - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -maintainer-clean-generic: - -test -z "$(MAINTAINERCLEANFILES)" || rm -f $(MAINTAINERCLEANFILES) - -test -z "$(BUILT_SOURCES)" || rm -f $(BUILT_SOURCES) -mostlyclean-am: mostlyclean-tags mostlyclean-generic - -clean-am: clean-tags clean-generic mostlyclean-am - -distclean-am: distclean-tags distclean-generic clean-am - -maintainer-clean-am: maintainer-clean-tags maintainer-clean-generic \ - distclean-am - -mostlyclean: mostlyclean-recursive mostlyclean-am - -clean: clean-recursive clean-am - -distclean: distclean-recursive distclean-am - -rm -f config.status - -rm -f libtool - -maintainer-clean: maintainer-clean-recursive maintainer-clean-am - @echo "This command is intended for maintainers to use;" - @echo "it deletes files that may require special tools to rebuild." - -rm -f config.status - -.PHONY: uninstall-aclocalDATA install-aclocalDATA install-data-recursive \ -uninstall-data-recursive install-exec-recursive \ -uninstall-exec-recursive installdirs-recursive uninstalldirs-recursive \ -all-recursive check-recursive installcheck-recursive info-recursive \ -dvi-recursive mostlyclean-recursive distclean-recursive clean-recursive \ -maintainer-clean-recursive tags tags-recursive mostlyclean-tags \ -distclean-tags clean-tags maintainer-clean-tags distdir info dvi \ -installcheck all-am install-data-am uninstall-am install-exec \ -install-data install uninstall all installdirs mostlyclean-generic \ -distclean-generic clean-generic maintainer-clean-generic clean \ -mostlyclean distclean maintainer-clean - - -# Tell versions [3.59,3.63) of GNU make to not export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: @@ -1,2294 +0,0 @@ -Guile NEWS --- history of user-visible changes. -*- text -*- -Copyright (C) 1996, 1997 Free Software Foundation, Inc. -See the end for copying conditions. - -Please send Guile bug reports to bug-guile@gnu.org. - -Changes since Guile 1.2: - -* Changes to the distribution - -** We renamed the SCHEME_LOAD_PATH environment variable to GUILE_LOAD_PATH. -To avoid conflicts, programs should name environment variables after -themselves, except when there's a common practice establishing some -other convention. - -For now, Guile supports both GUILE_LOAD_PATH and SCHEME_LOAD_PATH, -giving the former precedence, and printing a warning message if the -latter is set. Guile 1.4 will not recognize SCHEME_LOAD_PATH at all. - -** The header files related to multi-byte characters have been removed. -They were: libguile/extchrs.h and libguile/mbstrings.h. Any C code -which referred to these explicitly will probably need to be rewritten, -since the support for the variant string types has been removed; see -below. - -** The header files append.h and sequences.h have been removed. These -files implemented non-R4RS operations which would encourage -non-portable programming style and less easy-to-read code. - -* Changes to the stand-alone interpreter - -** New procedures have been added to implement a "batch mode": - -*** Function: batch-mode? - - Returns a boolean indicating whether the interpreter is in batch - mode. - -*** Function: set-batch-mode?! ARG - - If ARG is true, switches the interpreter to batch mode. The `#f' - case has not been implemented. - -** Guile now provides full command-line editing, when run interactively. -To use this feature, you must have the readline library installed. -The Guile build process will notice it, and automatically include -support for it. - -The readline library is available via anonymous FTP from any GNU -mirror site; the canonical location is "ftp://prep.ai.mit.edu/pub/gnu". - -** the-last-stack is now a fluid. - -* Changes to the procedure for linking libguile with your programs - -** You can now use the `guile-config' utility to build programs that use Guile. - -Guile now includes a command-line utility called `guile-config', which -can provide information about how to compile and link programs that -use Guile. - -*** `guile-config compile' prints any C compiler flags needed to use Guile. -You should include this command's output on the command line you use -to compile C or C++ code that #includes the Guile header files. It's -usually just a `-I' flag to help the compiler find the Guile headers. - - -*** `guile-config link' prints any linker flags necessary to link with Guile. - -This command writes to its standard output a list of flags which you -must pass to the linker to link your code against the Guile library. -The flags include '-lguile' itself, any other libraries the Guile -library depends upon, and any `-L' flags needed to help the linker -find those libraries. - -For example, here is a Makefile rule that builds a program named 'foo' -from the object files ${FOO_OBJECTS}, and links them against Guile: - - foo: ${FOO_OBJECTS} - ${CC} ${CFLAGS} ${FOO_OBJECTS} `guile-config link` -o foo - -Previous Guile releases recommended that you use autoconf to detect -which of a predefined set of libraries were present on your system. -It is more robust to use `guile-config', since it records exactly which -libraries the installed Guile library requires. - -This was originally called `build-guile', but was renamed to -`guile-config' before Guile 1.3 was released, to be consistent with -the analogous script for the GTK+ GUI toolkit, which is called -`gtk-config'. - - -** Use the GUILE_FLAGS macro in your configure.in file to find Guile. - -If you are using the GNU autoconf package to configure your program, -you can use the GUILE_FLAGS autoconf macro to call `guile-config' -(described above) and gather the necessary values for use in your -Makefiles. - -The GUILE_FLAGS macro expands to configure script code which runs the -`guile-config' script, to find out where Guile's header files and -libraries are installed. It sets two variables, marked for -substitution, as by AC_SUBST. - - GUILE_CFLAGS --- flags to pass to a C or C++ compiler to build - code that uses Guile header files. This is almost always just a - -I flag. - - GUILE_LDFLAGS --- flags to pass to the linker to link a - program against Guile. This includes `-lguile' for the Guile - library itself, any libraries that Guile itself requires (like - -lqthreads), and so on. It may also include a -L flag to tell the - compiler where to find the libraries. - -GUILE_FLAGS is defined in the file guile.m4, in the top-level -directory of the Guile distribution. You can copy it into your -package's aclocal.m4 file, and then use it in your configure.in file. - -If you are using the `aclocal' program, distributed with GNU automake, -to maintain your aclocal.m4 file, the Guile installation process -installs guile.m4 where aclocal will find it. All you need to do is -use GUILE_FLAGS in your configure.in file, and then run `aclocal'; -this will copy the definition of GUILE_FLAGS into your aclocal.m4 -file. - - -* Changes to Scheme functions and syntax - -** Multi-byte strings have been removed, as have multi-byte and wide -ports. We felt that these were the wrong approach to -internationalization support. - -** New function: readline [PROMPT] -Read a line from the terminal, and allow the user to edit it, -prompting with PROMPT. READLINE provides a large set of Emacs-like -editing commands, lets the user recall previously typed lines, and -works on almost every kind of terminal, including dumb terminals. - -READLINE assumes that the cursor is at the beginning of the line when -it is invoked. Thus, you can't print a prompt yourself, and then call -READLINE; you need to package up your prompt as a string, pass it to -the function, and let READLINE print the prompt itself. This is -because READLINE needs to know the prompt's screen width. - -For Guile to provide this function, you must have the readline library -installed on your system. - -See also ADD-HISTORY function. - -** New function: add-history STRING -Add STRING as the most recent line in the history used by the READLINE -command. READLINE does not add lines to the history itself; you must -call ADD-HISTORY to make previous input available to the user. - -** New module (ice-9 getopt-gnu-style): Parse command-line arguments. - -This module provides some simple argument parsing. It exports one -function: - -Function: getopt-gnu-style ARG-LS - Parse a list of program arguments into an alist of option - descriptions. - - Each item in the list of program arguments is examined to see if - it meets the syntax of a GNU long-named option. An argument like - `--MUMBLE' produces an element of the form (MUMBLE . #t) in the - returned alist, where MUMBLE is a keyword object with the same - name as the argument. An argument like `--MUMBLE=FROB' produces - an element of the form (MUMBLE . FROB), where FROB is a string. - - As a special case, the returned alist also contains a pair whose - car is the symbol `rest'. The cdr of this pair is a list - containing all the items in the argument list that are not options - of the form mentioned above. - - The argument `--' is treated specially: all items in the argument - list appearing after such an argument are not examined, and are - returned in the special `rest' list. - - This function does not parse normal single-character switches. - You will need to parse them out of the `rest' list yourself. - -** macro-eval! is removed. Use local-eval instead. - -** Some magic has been added to the printer to better handle user -written printing routines (like record printers, closure printers). - -The problem is that these user written routines must have access to -the current `print-state' to be able to handle fancy things like -detection of circular references. These print-states have to be -passed to the builtin printing routines (display, write, etc) to -properly continue the print chain. - -We didn't want to change all existing print code so that it -explicitely passes thru a print state in addition to a port. Instead, -we extented the possible values that the builtin printing routines -accept as a `port'. In addition to a normal port, they now also take -a pair of a normal port and a print-state. Printing will go to the -port and the print-state will be used to control the detection of -circular references, etc. If the builtin function does not care for a -print-state, it is simply ignored. - -User written callbacks are now called with such a pair as their -`port', but because every function now accepts this pair as a PORT -argument, you don't have to worry about that. In fact, it is probably -safest to not check for these pairs. - -However, it is sometimes necessary to continue a print chain on a -different port, for example to get a intermediate string -representation of the printed value, mangle that string somehow, and -then to finally print the mangled string. Use the new function - - inherit-print-state OLD-PORT NEW-PORT - -for this. It constructs a new `port' that prints to NEW-PORT but -inherits the print-state of OLD-PORT. - -** struct-vtable-offset renamed to vtable-offset-user - -** New constants: vtable-index-layout, vtable-index-vtable, vtable-index-printer - -** There is now a fourth (optional) argument to make-vtable-vtable and - make-struct when constructing new types (vtables). This argument - initializes field vtable-index-printer of the vtable. - -** The detection of circular references has been extended to structs. -That is, a structure that -- in the process of being printed -- prints -itself does not lead to infinite recursion. - -** There is now some basic support for fluids. Please read -"libguile/fluid.h" to find out more. It is accessible from Scheme with -the following functions and macros: - -Function: make-fluid - - Create a new fluid object. Fluids are not special variables or - some other extension to the semantics of Scheme, but rather - ordinary Scheme objects. You can store them into variables (that - are still lexically scoped, of course) or into any other place you - like. Every fluid has a initial value of `#f'. - -Function: fluid? OBJ - - Test whether OBJ is a fluid. - -Function: fluid-ref FLUID -Function: fluid-set! FLUID VAL - - Access/modify the fluid FLUID. Modifications are only visible - within the current dynamic root (that includes threads). - -Function: with-fluids* FLUIDS VALUES THUNK - - FLUIDS is a list of fluids and VALUES a corresponding list of - values for these fluids. Before THUNK gets called the values are - installed in the fluids and the old values of the fluids are - saved in the VALUES list. When the flow of control leaves THUNK - or reenters it, the values get swapped again. You might think of - this as a `safe-fluid-excursion'. Note that the VALUES list is - modified by `with-fluids*'. - -Macro: with-fluids ((FLUID VALUE) ...) FORM ... - - The same as `with-fluids*' but with a different syntax. It looks - just like `let', but both FLUID and VALUE are evaluated. Remember, - fluids are not special variables but ordinary objects. FLUID - should evaluate to a fluid. - -** Changes to system call interfaces: - -*** close-port, close-input-port and close-output-port now return a -boolean instead of an `unspecified' object. #t means that the port -was successfully closed, while #f means it was already closed. It is -also now possible for these procedures to raise an exception if an -error occurs (some errors from write can be delayed until close.) - -*** the first argument to chmod, fcntl, ftell and fseek can now be a -file descriptor. - -*** the third argument to fcntl is now optional. - -*** the first argument to chown can now be a file descriptor or a port. - -*** the argument to stat can now be a port. - -*** The following new procedures have been added (most use scsh -interfaces): - -*** procedure: close PORT/FD - Similar to close-port (*note close-port: Closing Ports.), but also - works on file descriptors. A side effect of closing a file - descriptor is that any ports using that file descriptor are moved - to a different file descriptor and have their revealed counts set - to zero. - -*** procedure: port->fdes PORT - Returns the integer file descriptor underlying PORT. As a side - effect the revealed count of PORT is incremented. - -*** procedure: fdes->ports FDES - Returns a list of existing ports which have FDES as an underlying - file descriptor, without changing their revealed counts. - -*** procedure: fdes->inport FDES - Returns an existing input port which has FDES as its underlying - file descriptor, if one exists, and increments its revealed count. - Otherwise, returns a new input port with a revealed count of 1. - -*** procedure: fdes->outport FDES - Returns an existing output port which has FDES as its underlying - file descriptor, if one exists, and increments its revealed count. - Otherwise, returns a new output port with a revealed count of 1. - - The next group of procedures perform a `dup2' system call, if NEWFD -(an integer) is supplied, otherwise a `dup'. The file descriptor to be -duplicated can be supplied as an integer or contained in a port. The -type of value returned varies depending on which procedure is used. - - All procedures also have the side effect when performing `dup2' that -any ports using NEWFD are moved to a different file descriptor and have -their revealed counts set to zero. - -*** procedure: dup->fdes PORT/FD [NEWFD] - Returns an integer file descriptor. - -*** procedure: dup->inport PORT/FD [NEWFD] - Returns a new input port using the new file descriptor. - -*** procedure: dup->outport PORT/FD [NEWFD] - Returns a new output port using the new file descriptor. - -*** procedure: dup PORT/FD [NEWFD] - Returns a new port if PORT/FD is a port, with the same mode as the - supplied port, otherwise returns an integer file descriptor. - -*** procedure: dup->port PORT/FD MODE [NEWFD] - Returns a new port using the new file descriptor. MODE supplies a - mode string for the port (*note open-file: File Ports.). - -*** procedure: setenv NAME VALUE - Modifies the environment of the current process, which is also the - default environment inherited by child processes. - - If VALUE is `#f', then NAME is removed from the environment. - Otherwise, the string NAME=VALUE is added to the environment, - replacing any existing string with name matching NAME. - - The return value is unspecified. - -*** procedure: truncate-file OBJ SIZE - Truncates the file referred to by OBJ to at most SIZE bytes. OBJ - can be a string containing a file name or an integer file - descriptor or port open for output on the file. The underlying - system calls are `truncate' and `ftruncate'. - - The return value is unspecified. - -*** procedure: setvbuf PORT MODE [SIZE] - Set the buffering mode for PORT. MODE can be: - `_IONBF' - non-buffered - - `_IOLBF' - line buffered - - `_IOFBF' - block buffered, using a newly allocated buffer of SIZE bytes. - However if SIZE is zero or unspecified, the port will be made - non-buffered. - - This procedure should not be used after I/O has been performed with - the port. - - Ports are usually block buffered by default, with a default buffer - size. Procedures e.g., *Note open-file: File Ports, which accept a - mode string allow `0' to be added to request an unbuffered port. - -*** procedure: fsync PORT/FD - Copies any unwritten data for the specified output file descriptor - to disk. If PORT/FD is a port, its buffer is flushed before the - underlying file descriptor is fsync'd. The return value is - unspecified. - -*** procedure: open-fdes PATH FLAGS [MODES] - Similar to `open' but returns a file descriptor instead of a port. - -*** procedure: execle PATH ENV [ARG] ... - Similar to `execl', but the environment of the new process is - specified by ENV, which must be a list of strings as returned by - the `environ' procedure. - - This procedure is currently implemented using the `execve' system - call, but we call it `execle' because of its Scheme calling - interface. - -*** procedure: strerror ERRNO - Returns the Unix error message corresponding to ERRNO, an integer. - -*** procedure: primitive-exit [STATUS] - Terminate the current process without unwinding the Scheme stack. - This is would typically be useful after a fork. The exit status - is STATUS if supplied, otherwise zero. - -*** procedure: times - Returns an object with information about real and processor time. - The following procedures accept such an object as an argument and - return a selected component: - - `tms:clock' - The current real time, expressed as time units relative to an - arbitrary base. - - `tms:utime' - The CPU time units used by the calling process. - - `tms:stime' - The CPU time units used by the system on behalf of the - calling process. - - `tms:cutime' - The CPU time units used by terminated child processes of the - calling process, whose status has been collected (e.g., using - `waitpid'). - - `tms:cstime' - Similarly, the CPU times units used by the system on behalf of - terminated child processes. - -** Removed: list-length -** Removed: list-append, list-append! -** Removed: list-reverse, list-reverse! - -** array-map renamed to array-map! - -** serial-array-map renamed to serial-array-map! - -** catch doesn't take #f as first argument any longer - -Previously, it was possible to pass #f instead of a key to `catch'. -That would cause `catch' to pass a jump buffer object to the procedure -passed as second argument. The procedure could then use this jump -buffer objekt as an argument to throw. - -This mechanism has been removed since its utility doesn't motivate the -extra complexity it introduces. - -** The `#/' notation for lists now provokes a warning message from Guile. -This syntax will be removed from Guile in the near future. - -To disable the warning message, set the GUILE_HUSH environment -variable to any non-empty value. - -* Changes to the gh_ interface - -** The gh_enter function now takes care of loading the Guile startup files. -gh_enter works by calling scm_boot_guile; see the remarks below. - -** Function: void gh_write (SCM x) - -Write the printed representation of the scheme object x to the current -output port. Corresponds to the scheme level `write'. - -** gh_list_length renamed to gh_length. - -** vector handling routines - -Several major changes. In particular, gh_vector() now resembles -(vector ...) (with a caveat -- see manual), and gh_make_vector() now -exists and behaves like (make-vector ...). gh_vset() and gh_vref() -have been renamed gh_vector_set_x() and gh_vector_ref(). Some missing -vector-related gh_ functions have been implemented. - -** pair and list routines - -Implemented several of the R4RS pair and list functions that were -missing. - -** gh_scm2doubles, gh_doubles2scm, gh_doubles2dvect - -New function. Converts double arrays back and forth between Scheme -and C. - -* Changes to the scm_ interface - -** The function scm_boot_guile now takes care of loading the startup files. - -Guile's primary initialization function, scm_boot_guile, now takes -care of loading `boot-9.scm', in the `ice-9' module, to initialize -Guile, define the module system, and put together some standard -bindings. It also loads `init.scm', which is intended to hold -site-specific initialization code. - -Since Guile cannot operate properly until boot-9.scm is loaded, there -is no reason to separate loading boot-9.scm from Guile's other -initialization processes. - -This job used to be done by scm_compile_shell_switches, which didn't -make much sense; in particular, it meant that people using Guile for -non-shell-like applications had to jump through hoops to get Guile -initialized properly. - -** The function scm_compile_shell_switches no longer loads the startup files. -Now, Guile always loads the startup files, whenever it is initialized; -see the notes above for scm_boot_guile and scm_load_startup_files. - -** Function: scm_load_startup_files -This new function takes care of loading Guile's initialization file -(`boot-9.scm'), and the site initialization file, `init.scm'. Since -this is always called by the Guile initialization process, it's -probably not too useful to call this yourself, but it's there anyway. - -** The semantics of smob marking have changed slightly. - -The smob marking function (the `mark' member of the scm_smobfuns -structure) is no longer responsible for setting the mark bit on the -smob. The generic smob handling code in the garbage collector will -set this bit. The mark function need only ensure that any other -objects the smob refers to get marked. - -Note that this change means that the smob's GC8MARK bit is typically -already set upon entry to the mark function. Thus, marking functions -which look like this: - - { - if (SCM_GC8MARKP (ptr)) - return SCM_BOOL_F; - SCM_SETGC8MARK (ptr); - ... mark objects to which the smob refers ... - } - -are now incorrect, since they will return early, and fail to mark any -other objects the smob refers to. Some code in the Guile library used -to work this way. - -** The semantics of the I/O port functions in scm_ptobfuns have changed. - -If you have implemented your own I/O port type, by writing the -functions required by the scm_ptobfuns and then calling scm_newptob, -you will need to change your functions slightly. - -The functions in a scm_ptobfuns structure now expect the port itself -as their argument; they used to expect the `stream' member of the -port's scm_port_table structure. This allows functions in an -scm_ptobfuns structure to easily access the port's cell (and any flags -it its CAR), and the port's scm_port_table structure. - -Guile now passes the I/O port itself as the `port' argument in the -following scm_ptobfuns functions: - - int (*free) (SCM port); - int (*fputc) (int, SCM port); - int (*fputs) (char *, SCM port); - scm_sizet (*fwrite) SCM_P ((char *ptr, - scm_sizet size, - scm_sizet nitems, - SCM port)); - int (*fflush) (SCM port); - int (*fgetc) (SCM port); - int (*fclose) (SCM port); - -The interfaces to the `mark', `print', `equalp', and `fgets' methods -are unchanged. - -If you have existing code which defines its own port types, it is easy -to convert your code to the new interface; simply apply SCM_STREAM to -the port argument to yield the value you code used to expect. - -Note that since both the port and the stream have the same type in the -C code --- they are both SCM values --- the C compiler will not remind -you if you forget to update your scm_ptobfuns functions. - - -** Function: int scm_internal_select (int fds, - SELECT_TYPE *rfds, - SELECT_TYPE *wfds, - SELECT_TYPE *efds, - struct timeval *timeout); - -This is a replacement for the `select' function provided by the OS. -It enables I/O blocking and sleeping to happen for one cooperative -thread without blocking other threads. It also avoids busy-loops in -these situations. It is intended that all I/O blocking and sleeping -will finally go through this function. Currently, this function is -only available on systems providing `gettimeofday' and `select'. - -** Function: SCM scm_internal_stack_catch (SCM tag, - scm_catch_body_t body, - void *body_data, - scm_catch_handler_t handler, - void *handler_data) - -A new sibling to the other two C level `catch' functions -scm_internal_catch and scm_internal_lazy_catch. Use it if you want -the stack to be saved automatically into the variable `the-last-stack' -(scm_the_last_stack_var) on error. This is necessary if you want to -use advanced error reporting, such as calling scm_display_error and -scm_display_backtrace. (They both take a stack object as argument.) - -** Function: SCM scm_spawn_thread (scm_catch_body_t body, - void *body_data, - scm_catch_handler_t handler, - void *handler_data) - -Spawns a new thread. It does a job similar to -scm_call_with_new_thread but takes arguments more suitable when -spawning threads from application C code. - -** The hook scm_error_callback has been removed. It was originally -intended as a way for the user to install his own error handler. But -that method works badly since it intervenes between throw and catch, -thereby changing the semantics of expressions like (catch #t ...). -The correct way to do it is to use one of the C level catch functions -in throw.c: scm_internal_catch/lazy_catch/stack_catch. - -** Removed functions: - -scm_obj_length, scm_list_length, scm_list_append, scm_list_append_x, -scm_list_reverse, scm_list_reverse_x - -** New macros: SCM_LISTn where n is one of the integers 0-9. - -These can be used for pretty list creation from C. The idea is taken -from Erick Gallesio's STk. - -** scm_array_map renamed to scm_array_map_x - -** mbstrings are now removed - -This means that the type codes scm_tc7_mb_string and -scm_tc7_mb_substring has been removed. - -** The macros SCM_TYP7D and SCM_TYP7SD has been removed. - -** The macro SCM_TYP7S has taken the role of the old SCM_TYP7D - -SCM_TYP7S now masks away the bit which distinguishes substrings from -strings. - -** All genio functions changed names and interfaces; new functions are -scm_putc, scm_puts, scm_lfwrite, scm_getc, scm_ungetc, and -scm_do_read_line. - -** scm_catch_body_t: Backward incompatible change! - -Body functions to scm_internal_catch and friends do not any longer -take a second argument. This is because it is no longer possible to -pass a #f arg to catch. - -** Calls to scm_protect_object and scm_unprotect now nest properly. - -The function scm_protect_object protects its argument from being freed -by the garbage collector. scm_unprotect_object removes that -protection. - -These functions now nest properly. That is, for every object O, there -is a counter which scm_protect_object(O) increments and -scm_unprotect_object(O) decrements, if the counter is greater than -zero. Every object's counter is zero when it is first created. If an -object's counter is greater than zero, the garbage collector will not -reclaim its storage. - -This allows you to use scm_protect_object in your code without -worrying that some other function you call will call -scm_unprotect_object, and allow it to be freed. Assuming that the -functions you call are well-behaved, and unprotect only those objects -they protect, you can follow the same rule and have confidence that -objects will be freed only at appropriate times. - - -Changes in Guile 1.2 (released Tuesday, June 24 1997): - -* Changes to the distribution - -** Nightly snapshots are now available from ftp.red-bean.com. -The old server, ftp.cyclic.com, has been relinquished to its rightful -owner. - -Nightly snapshots of the Guile development sources are now available via -anonymous FTP from ftp.red-bean.com, as /pub/guile/guile-snap.tar.gz. - -Via the web, that's: ftp://ftp.red-bean.com/pub/guile/guile-snap.tar.gz -For getit, that's: ftp.red-bean.com:/pub/guile/guile-snap.tar.gz - -** To run Guile without installing it, the procedure has changed a bit. - -If you used a separate build directory to compile Guile, you'll need -to include the build directory in SCHEME_LOAD_PATH, as well as the -source directory. See the `INSTALL' file for examples. - -* Changes to the procedure for linking libguile with your programs - -** The standard Guile load path for Scheme code now includes -$(datadir)/guile (usually /usr/local/share/guile). This means that -you can install your own Scheme files there, and Guile will find them. -(Previous versions of Guile only checked a directory whose name -contained the Guile version number, so you had to re-install or move -your Scheme sources each time you installed a fresh version of Guile.) - -The load path also includes $(datadir)/guile/site; we recommend -putting individual Scheme files there. If you want to install a -package with multiple source files, create a directory for them under -$(datadir)/guile. - -** Guile 1.2 will now use the Rx regular expression library, if it is -installed on your system. When you are linking libguile into your own -programs, this means you will have to link against -lguile, -lqt (if -you configured Guile with thread support), and -lrx. - -If you are using autoconf to generate configuration scripts for your -application, the following lines should suffice to add the appropriate -libraries to your link command: - -### Find Rx, quickthreads and libguile. -AC_CHECK_LIB(rx, main) -AC_CHECK_LIB(qt, main) -AC_CHECK_LIB(guile, scm_shell) - -The Guile 1.2 distribution does not contain sources for the Rx -library, as Guile 1.0 did. If you want to use Rx, you'll need to -retrieve it from a GNU FTP site and install it separately. - -* Changes to Scheme functions and syntax - -** The dynamic linking features of Guile are now enabled by default. -You can disable them by giving the `--disable-dynamic-linking' option -to configure. - - (dynamic-link FILENAME) - - Find the object file denoted by FILENAME (a string) and link it - into the running Guile application. When everything works out, - return a Scheme object suitable for representing the linked object - file. Otherwise an error is thrown. How object files are - searched is system dependent. - - (dynamic-object? VAL) - - Determine whether VAL represents a dynamically linked object file. - - (dynamic-unlink DYNOBJ) - - Unlink the indicated object file from the application. DYNOBJ - should be one of the values returned by `dynamic-link'. - - (dynamic-func FUNCTION DYNOBJ) - - Search the C function indicated by FUNCTION (a string or symbol) - in DYNOBJ and return some Scheme object that can later be used - with `dynamic-call' to actually call this function. Right now, - these Scheme objects are formed by casting the address of the - function to `long' and converting this number to its Scheme - representation. - - (dynamic-call FUNCTION DYNOBJ) - - Call the C function indicated by FUNCTION and DYNOBJ. The - function is passed no arguments and its return value is ignored. - When FUNCTION is something returned by `dynamic-func', call that - function and ignore DYNOBJ. When FUNCTION is a string (or symbol, - etc.), look it up in DYNOBJ; this is equivalent to - - (dynamic-call (dynamic-func FUNCTION DYNOBJ) #f) - - Interrupts are deferred while the C function is executing (with - SCM_DEFER_INTS/SCM_ALLOW_INTS). - - (dynamic-args-call FUNCTION DYNOBJ ARGS) - - Call the C function indicated by FUNCTION and DYNOBJ, but pass it - some arguments and return its return value. The C function is - expected to take two arguments and return an `int', just like - `main': - - int c_func (int argc, char **argv); - - ARGS must be a list of strings and is converted into an array of - `char *'. The array is passed in ARGV and its size in ARGC. The - return value is converted to a Scheme number and returned from the - call to `dynamic-args-call'. - -When dynamic linking is disabled or not supported on your system, -the above functions throw errors, but they are still available. - -Here is a small example that works on GNU/Linux: - - (define libc-obj (dynamic-link "libc.so")) - (dynamic-args-call 'rand libc-obj '()) - -See the file `libguile/DYNAMIC-LINKING' for additional comments. - -** The #/ syntax for module names is depreciated, and will be removed -in a future version of Guile. Instead of - - #/foo/bar/baz - -instead write - - (foo bar baz) - -The latter syntax is more consistent with existing Lisp practice. - -** Guile now does fancier printing of structures. Structures are the -underlying implementation for records, which in turn are used to -implement modules, so all of these object now print differently and in -a more informative way. - -The Scheme printer will examine the builtin variable *struct-printer* -whenever it needs to print a structure object. When this variable is -not `#f' it is deemed to be a procedure and will be applied to the -structure object and the output port. When *struct-printer* is `#f' -or the procedure return `#f' the structure object will be printed in -the boring #<struct 80458270> form. - -This hook is used by some routines in ice-9/boot-9.scm to implement -type specific printing routines. Please read the comments there about -"printing structs". - -One of the more specific uses of structs are records. The printing -procedure that could be passed to MAKE-RECORD-TYPE is now actually -called. It should behave like a *struct-printer* procedure (described -above). - -** Guile now supports a new R4RS-compliant syntax for keywords. A -token of the form #:NAME, where NAME has the same syntax as a Scheme -symbol, is the external representation of the keyword named NAME. -Keyword objects print using this syntax as well, so values containing -keyword objects can be read back into Guile. When used in an -expression, keywords are self-quoting objects. - -Guile suports this read syntax, and uses this print syntax, regardless -of the current setting of the `keyword' read option. The `keyword' -read option only controls whether Guile recognizes the `:NAME' syntax, -which is incompatible with R4RS. (R4RS says such token represent -symbols.) - -** Guile has regular expression support again. Guile 1.0 included -functions for matching regular expressions, based on the Rx library. -In Guile 1.1, the Guile/Rx interface was removed to simplify the -distribution, and thus Guile had no regular expression support. Guile -1.2 again supports the most commonly used functions, and supports all -of SCSH's regular expression functions. - -If your system does not include a POSIX regular expression library, -and you have not linked Guile with a third-party regexp library such as -Rx, these functions will not be available. You can tell whether your -Guile installation includes regular expression support by checking -whether the `*features*' list includes the `regex' symbol. - -*** regexp functions - -By default, Guile supports POSIX extended regular expressions. That -means that the characters `(', `)', `+' and `?' are special, and must -be escaped if you wish to match the literal characters. - -This regular expression interface was modeled after that implemented -by SCSH, the Scheme Shell. It is intended to be upwardly compatible -with SCSH regular expressions. - -**** Function: string-match PATTERN STR [START] - Compile the string PATTERN into a regular expression and compare - it with STR. The optional numeric argument START specifies the - position of STR at which to begin matching. - - `string-match' returns a "match structure" which describes what, - if anything, was matched by the regular expression. *Note Match - Structures::. If STR does not match PATTERN at all, - `string-match' returns `#f'. - - Each time `string-match' is called, it must compile its PATTERN -argument into a regular expression structure. This operation is -expensive, which makes `string-match' inefficient if the same regular -expression is used several times (for example, in a loop). For better -performance, you can compile a regular expression in advance and then -match strings against the compiled regexp. - -**** Function: make-regexp STR [FLAGS] - Compile the regular expression described by STR, and return the - compiled regexp structure. If STR does not describe a legal - regular expression, `make-regexp' throws a - `regular-expression-syntax' error. - - FLAGS may be the bitwise-or of one or more of the following: - -**** Constant: regexp/extended - Use POSIX Extended Regular Expression syntax when interpreting - STR. If not set, POSIX Basic Regular Expression syntax is used. - If the FLAGS argument is omitted, we assume regexp/extended. - -**** Constant: regexp/icase - Do not differentiate case. Subsequent searches using the - returned regular expression will be case insensitive. - -**** Constant: regexp/newline - Match-any-character operators don't match a newline. - - A non-matching list ([^...]) not containing a newline matches a - newline. - - Match-beginning-of-line operator (^) matches the empty string - immediately after a newline, regardless of whether the FLAGS - passed to regexp-exec contain regexp/notbol. - - Match-end-of-line operator ($) matches the empty string - immediately before a newline, regardless of whether the FLAGS - passed to regexp-exec contain regexp/noteol. - -**** Function: regexp-exec REGEXP STR [START [FLAGS]] - Match the compiled regular expression REGEXP against `str'. If - the optional integer START argument is provided, begin matching - from that position in the string. Return a match structure - describing the results of the match, or `#f' if no match could be - found. - - FLAGS may be the bitwise-or of one or more of the following: - -**** Constant: regexp/notbol - The match-beginning-of-line operator always fails to match (but - see the compilation flag regexp/newline above) This flag may be - used when different portions of a string are passed to - regexp-exec and the beginning of the string should not be - interpreted as the beginning of the line. - -**** Constant: regexp/noteol - The match-end-of-line operator always fails to match (but see the - compilation flag regexp/newline above) - -**** Function: regexp? OBJ - Return `#t' if OBJ is a compiled regular expression, or `#f' - otherwise. - - Regular expressions are commonly used to find patterns in one string -and replace them with the contents of another string. - -**** Function: regexp-substitute PORT MATCH [ITEM...] - Write to the output port PORT selected contents of the match - structure MATCH. Each ITEM specifies what should be written, and - may be one of the following arguments: - - * A string. String arguments are written out verbatim. - - * An integer. The submatch with that number is written. - - * The symbol `pre'. The portion of the matched string preceding - the regexp match is written. - - * The symbol `post'. The portion of the matched string - following the regexp match is written. - - PORT may be `#f', in which case nothing is written; instead, - `regexp-substitute' constructs a string from the specified ITEMs - and returns that. - -**** Function: regexp-substitute/global PORT REGEXP TARGET [ITEM...] - Similar to `regexp-substitute', but can be used to perform global - substitutions on STR. Instead of taking a match structure as an - argument, `regexp-substitute/global' takes two string arguments: a - REGEXP string describing a regular expression, and a TARGET string - which should be matched against this regular expression. - - Each ITEM behaves as in REGEXP-SUBSTITUTE, with the following - exceptions: - - * A function may be supplied. When this function is called, it - will be passed one argument: a match structure for a given - regular expression match. It should return a string to be - written out to PORT. - - * The `post' symbol causes `regexp-substitute/global' to recurse - on the unmatched portion of STR. This *must* be supplied in - order to perform global search-and-replace on STR; if it is - not present among the ITEMs, then `regexp-substitute/global' - will return after processing a single match. - -*** Match Structures - - A "match structure" is the object returned by `string-match' and -`regexp-exec'. It describes which portion of a string, if any, matched -the given regular expression. Match structures include: a reference to -the string that was checked for matches; the starting and ending -positions of the regexp match; and, if the regexp included any -parenthesized subexpressions, the starting and ending positions of each -submatch. - - In each of the regexp match functions described below, the `match' -argument must be a match structure returned by a previous call to -`string-match' or `regexp-exec'. Most of these functions return some -information about the original target string that was matched against a -regular expression; we will call that string TARGET for easy reference. - -**** Function: regexp-match? OBJ - Return `#t' if OBJ is a match structure returned by a previous - call to `regexp-exec', or `#f' otherwise. - -**** Function: match:substring MATCH [N] - Return the portion of TARGET matched by subexpression number N. - Submatch 0 (the default) represents the entire regexp match. If - the regular expression as a whole matched, but the subexpression - number N did not match, return `#f'. - -**** Function: match:start MATCH [N] - Return the starting position of submatch number N. - -**** Function: match:end MATCH [N] - Return the ending position of submatch number N. - -**** Function: match:prefix MATCH - Return the unmatched portion of TARGET preceding the regexp match. - -**** Function: match:suffix MATCH - Return the unmatched portion of TARGET following the regexp match. - -**** Function: match:count MATCH - Return the number of parenthesized subexpressions from MATCH. - Note that the entire regular expression match itself counts as a - subexpression, and failed submatches are included in the count. - -**** Function: match:string MATCH - Return the original TARGET string. - -*** Backslash Escapes - - Sometimes you will want a regexp to match characters like `*' or `$' -exactly. For example, to check whether a particular string represents -a menu entry from an Info node, it would be useful to match it against -a regexp like `^* [^:]*::'. However, this won't work; because the -asterisk is a metacharacter, it won't match the `*' at the beginning of -the string. In this case, we want to make the first asterisk un-magic. - - You can do this by preceding the metacharacter with a backslash -character `\'. (This is also called "quoting" the metacharacter, and -is known as a "backslash escape".) When Guile sees a backslash in a -regular expression, it considers the following glyph to be an ordinary -character, no matter what special meaning it would ordinarily have. -Therefore, we can make the above example work by changing the regexp to -`^\* [^:]*::'. The `\*' sequence tells the regular expression engine -to match only a single asterisk in the target string. - - Since the backslash is itself a metacharacter, you may force a -regexp to match a backslash in the target string by preceding the -backslash with itself. For example, to find variable references in a -TeX program, you might want to find occurrences of the string `\let\' -followed by any number of alphabetic characters. The regular expression -`\\let\\[A-Za-z]*' would do this: the double backslashes in the regexp -each match a single backslash in the target string. - -**** Function: regexp-quote STR - Quote each special character found in STR with a backslash, and - return the resulting string. - - *Very important:* Using backslash escapes in Guile source code (as -in Emacs Lisp or C) can be tricky, because the backslash character has -special meaning for the Guile reader. For example, if Guile encounters -the character sequence `\n' in the middle of a string while processing -Scheme code, it replaces those characters with a newline character. -Similarly, the character sequence `\t' is replaced by a horizontal tab. -Several of these "escape sequences" are processed by the Guile reader -before your code is executed. Unrecognized escape sequences are -ignored: if the characters `\*' appear in a string, they will be -translated to the single character `*'. - - This translation is obviously undesirable for regular expressions, -since we want to be able to include backslashes in a string in order to -escape regexp metacharacters. Therefore, to make sure that a backslash -is preserved in a string in your Guile program, you must use *two* -consecutive backslashes: - - (define Info-menu-entry-pattern (make-regexp "^\\* [^:]*")) - - The string in this example is preprocessed by the Guile reader before -any code is executed. The resulting argument to `make-regexp' is the -string `^\* [^:]*', which is what we really want. - - This also means that in order to write a regular expression that -matches a single backslash character, the regular expression string in -the source code must include *four* backslashes. Each consecutive pair -of backslashes gets translated by the Guile reader to a single -backslash, and the resulting double-backslash is interpreted by the -regexp engine as matching a single backslash character. Hence: - - (define tex-variable-pattern (make-regexp "\\\\let\\\\=[A-Za-z]*")) - - The reason for the unwieldiness of this syntax is historical. Both -regular expression pattern matchers and Unix string processing systems -have traditionally used backslashes with the special meanings described -above. The POSIX regular expression specification and ANSI C standard -both require these semantics. Attempting to abandon either convention -would cause other kinds of compatibility problems, possibly more severe -ones. Therefore, without extending the Scheme reader to support -strings with different quoting conventions (an ungainly and confusing -extension when implemented in other languages), we must adhere to this -cumbersome escape syntax. - -* Changes to the gh_ interface - -* Changes to the scm_ interface - -* Changes to system call interfaces: - -** The value returned by `raise' is now unspecified. It throws an exception -if an error occurs. - -*** A new procedure `sigaction' can be used to install signal handlers - -(sigaction signum [action] [flags]) - -signum is the signal number, which can be specified using the value -of SIGINT etc. - -If action is omitted, sigaction returns a pair: the CAR is the current -signal hander, which will be either an integer with the value SIG_DFL -(default action) or SIG_IGN (ignore), or the Scheme procedure which -handles the signal, or #f if a non-Scheme procedure handles the -signal. The CDR contains the current sigaction flags for the handler. - -If action is provided, it is installed as the new handler for signum. -action can be a Scheme procedure taking one argument, or the value of -SIG_DFL (default action) or SIG_IGN (ignore), or #f to restore -whatever signal handler was installed before sigaction was first used. -Flags can optionally be specified for the new handler (SA_RESTART is -always used if the system provides it, so need not be specified.) The -return value is a pair with information about the old handler as -described above. - -This interface does not provide access to the "signal blocking" -facility. Maybe this is not needed, since the thread support may -provide solutions to the problem of consistent access to data -structures. - -*** A new procedure `flush-all-ports' is equivalent to running -`force-output' on every port open for output. - -** Guile now provides information on how it was built, via the new -global variable, %guile-build-info. This variable records the values -of the standard GNU makefile directory variables as an assocation -list, mapping variable names (symbols) onto directory paths (strings). -For example, to find out where the Guile link libraries were -installed, you can say: - -guile -c "(display (assq-ref %guile-build-info 'libdir)) (newline)" - - -* Changes to the scm_ interface - -** The new function scm_handle_by_message_noexit is just like the -existing scm_handle_by_message function, except that it doesn't call -exit to terminate the process. Instead, it prints a message and just -returns #f. This might be a more appropriate catch-all handler for -new dynamic roots and threads. - - -Changes in Guile 1.1 (released Friday, May 16 1997): - -* Changes to the distribution. - -The Guile 1.0 distribution has been split up into several smaller -pieces: -guile-core --- the Guile interpreter itself. -guile-tcltk --- the interface between the Guile interpreter and - Tcl/Tk; Tcl is an interpreter for a stringy language, and Tk - is a toolkit for building graphical user interfaces. -guile-rgx-ctax --- the interface between Guile and the Rx regular - expression matcher, and the translator for the Ctax - programming language. These are packaged together because the - Ctax translator uses Rx to parse Ctax source code. - -This NEWS file describes the changes made to guile-core since the 1.0 -release. - -We no longer distribute the documentation, since it was either out of -date, or incomplete. As soon as we have current documentation, we -will distribute it. - - - -* Changes to the stand-alone interpreter - -** guile now accepts command-line arguments compatible with SCSH, Olin -Shivers' Scheme Shell. - -In general, arguments are evaluated from left to right, but there are -exceptions. The following switches stop argument processing, and -stash all remaining command-line arguments as the value returned by -the (command-line) function. - -s SCRIPT load Scheme source code from FILE, and exit - -c EXPR evalute Scheme expression EXPR, and exit - -- stop scanning arguments; run interactively - -The switches below are processed as they are encountered. - -l FILE load Scheme source code from FILE - -e FUNCTION after reading script, apply FUNCTION to - command line arguments - -ds do -s script at this point - --emacs enable Emacs protocol (experimental) - -h, --help display this help and exit - -v, --version display version information and exit - \ read arguments from following script lines - -So, for example, here is a Guile script named `ekko' (thanks, Olin) -which re-implements the traditional "echo" command: - -#!/usr/local/bin/guile -s -!# -(define (main args) - (map (lambda (arg) (display arg) (display " ")) - (cdr args)) - (newline)) - -(main (command-line)) - -Suppose we invoke this script as follows: - - ekko a speckled gecko - -Through the magic of Unix script processing (triggered by the `#!' -token at the top of the file), /usr/local/bin/guile receives the -following list of command-line arguments: - - ("-s" "./ekko" "a" "speckled" "gecko") - -Unix inserts the name of the script after the argument specified on -the first line of the file (in this case, "-s"), and then follows that -with the arguments given to the script. Guile loads the script, which -defines the `main' function, and then applies it to the list of -remaining command-line arguments, ("a" "speckled" "gecko"). - -In Unix, the first line of a script file must take the following form: - -#!INTERPRETER ARGUMENT - -where INTERPRETER is the absolute filename of the interpreter -executable, and ARGUMENT is a single command-line argument to pass to -the interpreter. - -You may only pass one argument to the interpreter, and its length is -limited. These restrictions can be annoying to work around, so Guile -provides a general mechanism (borrowed from, and compatible with, -SCSH) for circumventing them. - -If the ARGUMENT in a Guile script is a single backslash character, -`\', Guile will open the script file, parse arguments from its second -and subsequent lines, and replace the `\' with them. So, for example, -here is another implementation of the `ekko' script: - -#!/usr/local/bin/guile \ --e main -s -!# -(define (main args) - (for-each (lambda (arg) (display arg) (display " ")) - (cdr args)) - (newline)) - -If the user invokes this script as follows: - - ekko a speckled gecko - -Unix expands this into - - /usr/local/bin/guile \ ekko a speckled gecko - -When Guile sees the `\' argument, it replaces it with the arguments -read from the second line of the script, producing: - - /usr/local/bin/guile -e main -s ekko a speckled gecko - -This tells Guile to load the `ekko' script, and apply the function -`main' to the argument list ("a" "speckled" "gecko"). - -Here is how Guile parses the command-line arguments: -- Each space character terminates an argument. This means that two - spaces in a row introduce an empty-string argument. -- The tab character is not permitted (unless you quote it with the - backslash character, as described below), to avoid confusion. -- The newline character terminates the sequence of arguments, and will - also terminate a final non-empty argument. (However, a newline - following a space will not introduce a final empty-string argument; - it only terminates the argument list.) -- The backslash character is the escape character. It escapes - backslash, space, tab, and newline. The ANSI C escape sequences - like \n and \t are also supported. These produce argument - constituents; the two-character combination \n doesn't act like a - terminating newline. The escape sequence \NNN for exactly three - octal digits reads as the character whose ASCII code is NNN. As - above, characters produced this way are argument constituents. - Backslash followed by other characters is not allowed. - -* Changes to the procedure for linking libguile with your programs - -** Guile now builds and installs a shared guile library, if your -system support shared libraries. (It still builds a static library on -all systems.) Guile automatically detects whether your system -supports shared libraries. To prevent Guile from buildisg shared -libraries, pass the `--disable-shared' flag to the configure script. - -Guile takes longer to compile when it builds shared libraries, because -it must compile every file twice --- once to produce position- -independent object code, and once to produce normal object code. - -** The libthreads library has been merged into libguile. - -To link a program against Guile, you now need only link against --lguile and -lqt; -lthreads is no longer needed. If you are using -autoconf to generate configuration scripts for your application, the -following lines should suffice to add the appropriate libraries to -your link command: - -### Find quickthreads and libguile. -AC_CHECK_LIB(qt, main) -AC_CHECK_LIB(guile, scm_shell) - -* Changes to Scheme functions - -** Guile Scheme's special syntax for keyword objects is now optional, -and disabled by default. - -The syntax variation from R4RS made it difficult to port some -interesting packages to Guile. The routines which accepted keyword -arguments (mostly in the module system) have been modified to also -accept symbols whose names begin with `:'. - -To change the keyword syntax, you must first import the (ice-9 debug) -module: - (use-modules (ice-9 debug)) - -Then you can enable the keyword syntax as follows: - (read-set! keywords 'prefix) - -To disable keyword syntax, do this: - (read-set! keywords #f) - -** Many more primitive functions accept shared substrings as -arguments. In the past, these functions required normal, mutable -strings as arguments, although they never made use of this -restriction. - -** The uniform array functions now operate on byte vectors. These -functions are `array-fill!', `serial-array-copy!', `array-copy!', -`serial-array-map', `array-map', `array-for-each', and -`array-index-map!'. - -** The new functions `trace' and `untrace' implement simple debugging -support for Scheme functions. - -The `trace' function accepts any number of procedures as arguments, -and tells the Guile interpreter to display each procedure's name and -arguments each time the procedure is invoked. When invoked with no -arguments, `trace' returns the list of procedures currently being -traced. - -The `untrace' function accepts any number of procedures as arguments, -and tells the Guile interpreter not to trace them any more. When -invoked with no arguments, `untrace' untraces all curretly traced -procedures. - -The tracing in Guile has an advantage over most other systems: we -don't create new procedure objects, but mark the procedure objects -themselves. This means that anonymous and internal procedures can be -traced. - -** The function `assert-repl-prompt' has been renamed to -`set-repl-prompt!'. It takes one argument, PROMPT. -- If PROMPT is #f, the Guile read-eval-print loop will not prompt. -- If PROMPT is a string, we use it as a prompt. -- If PROMPT is a procedure accepting no arguments, we call it, and - display the result as a prompt. -- Otherwise, we display "> ". - -** The new function `eval-string' reads Scheme expressions from a -string and evaluates them, returning the value of the last expression -in the string. If the string contains no expressions, it returns an -unspecified value. - -** The new function `thunk?' returns true iff its argument is a -procedure of zero arguments. - -** `defined?' is now a builtin function, instead of syntax. This -means that its argument should be quoted. It returns #t iff its -argument is bound in the current module. - -** The new syntax `use-modules' allows you to add new modules to your -environment without re-typing a complete `define-module' form. It -accepts any number of module names as arguments, and imports their -public bindings into the current module. - -** The new function (module-defined? NAME MODULE) returns true iff -NAME, a symbol, is defined in MODULE, a module object. - -** The new function `builtin-bindings' creates and returns a hash -table containing copies of all the root module's bindings. - -** The new function `builtin-weak-bindings' does the same as -`builtin-bindings', but creates a doubly-weak hash table. - -** The `equal?' function now considers variable objects to be -equivalent if they have the same name and the same value. - -** The new function `command-line' returns the command-line arguments -given to Guile, as a list of strings. - -When using guile as a script interpreter, `command-line' returns the -script's arguments; those processed by the interpreter (like `-s' or -`-c') are omitted. (In other words, you get the normal, expected -behavior.) Any application that uses scm_shell to process its -command-line arguments gets this behavior as well. - -** The new function `load-user-init' looks for a file called `.guile' -in the user's home directory, and loads it if it exists. This is -mostly for use by the code generated by scm_compile_shell_switches, -but we thought it might also be useful in other circumstances. - -** The new function `log10' returns the base-10 logarithm of its -argument. - -** Changes to I/O functions - -*** The functions `read', `primitive-load', `read-and-eval!', and -`primitive-load-path' no longer take optional arguments controlling -case insensitivity and a `#' parser. - -Case sensitivity is now controlled by a read option called -`case-insensitive'. The user can add new `#' syntaxes with the -`read-hash-extend' function (see below). - -*** The new function `read-hash-extend' allows the user to change the -syntax of Guile Scheme in a somewhat controlled way. - -(read-hash-extend CHAR PROC) - When parsing S-expressions, if we read a `#' character followed by - the character CHAR, use PROC to parse an object from the stream. - If PROC is #f, remove any parsing procedure registered for CHAR. - - The reader applies PROC to two arguments: CHAR and an input port. - -*** The new functions read-delimited and read-delimited! provide a -general mechanism for doing delimited input on streams. - -(read-delimited DELIMS [PORT HANDLE-DELIM]) - Read until we encounter one of the characters in DELIMS (a string), - or end-of-file. PORT is the input port to read from; it defaults to - the current input port. The HANDLE-DELIM parameter determines how - the terminating character is handled; it should be one of the - following symbols: - - 'trim omit delimiter from result - 'peek leave delimiter character in input stream - 'concat append delimiter character to returned value - 'split return a pair: (RESULT . TERMINATOR) - - HANDLE-DELIM defaults to 'peek. - -(read-delimited! DELIMS BUF [PORT HANDLE-DELIM START END]) - A side-effecting variant of `read-delimited'. - - The data is written into the string BUF at the indices in the - half-open interval [START, END); the default interval is the whole - string: START = 0 and END = (string-length BUF). The values of - START and END must specify a well-defined interval in BUF, i.e. - 0 <= START <= END <= (string-length BUF). - - It returns NBYTES, the number of bytes read. If the buffer filled - up without a delimiter character being found, it returns #f. If the - port is at EOF when the read starts, it returns the EOF object. - - If an integer is returned (i.e., the read is successfully terminated - by reading a delimiter character), then the HANDLE-DELIM parameter - determines how to handle the terminating character. It is described - above, and defaults to 'peek. - -(The descriptions of these functions were borrowed from the SCSH -manual, by Olin Shivers and Brian Carlstrom.) - -*** The `%read-delimited!' function is the primitive used to implement -`read-delimited' and `read-delimited!'. - -(%read-delimited! DELIMS BUF GOBBLE? [PORT START END]) - -This returns a pair of values: (TERMINATOR . NUM-READ). -- TERMINATOR describes why the read was terminated. If it is a - character or the eof object, then that is the value that terminated - the read. If it is #f, the function filled the buffer without finding - a delimiting character. -- NUM-READ is the number of characters read into BUF. - -If the read is successfully terminated by reading a delimiter -character, then the gobble? parameter determines what to do with the -terminating character. If true, the character is removed from the -input stream; if false, the character is left in the input stream -where a subsequent read operation will retrieve it. In either case, -the character is also the first value returned by the procedure call. - -(The descriptions of this function was borrowed from the SCSH manual, -by Olin Shivers and Brian Carlstrom.) - -*** The `read-line' and `read-line!' functions have changed; they now -trim the terminator by default; previously they appended it to the -returned string. For the old behavior, use (read-line PORT 'concat). - -*** The functions `uniform-array-read!' and `uniform-array-write!' now -take new optional START and END arguments, specifying the region of -the array to read and write. - -*** The `ungetc-char-ready?' function has been removed. We feel it's -inappropriate for an interface to expose implementation details this -way. - -** Changes to the Unix library and system call interface - -*** The new fcntl function provides access to the Unix `fcntl' system -call. - -(fcntl PORT COMMAND VALUE) - Apply COMMAND to PORT's file descriptor, with VALUE as an argument. - Values for COMMAND are: - - F_DUPFD duplicate a file descriptor - F_GETFD read the descriptor's close-on-exec flag - F_SETFD set the descriptor's close-on-exec flag to VALUE - F_GETFL read the descriptor's flags, as set on open - F_SETFL set the descriptor's flags, as set on open to VALUE - F_GETOWN return the process ID of a socket's owner, for SIGIO - F_SETOWN set the process that owns a socket to VALUE, for SIGIO - FD_CLOEXEC not sure what this is - -For details, see the documentation for the fcntl system call. - -*** The arguments to `select' have changed, for compatibility with -SCSH. The TIMEOUT parameter may now be non-integral, yielding the -expected behavior. The MILLISECONDS parameter has been changed to -MICROSECONDS, to more closely resemble the underlying system call. -The RVEC, WVEC, and EVEC arguments can now be vectors; the type of the -corresponding return set will be the same. - -*** The arguments to the `mknod' system call have changed. They are -now: - -(mknod PATH TYPE PERMS DEV) - Create a new file (`node') in the file system. PATH is the name of - the file to create. TYPE is the kind of file to create; it should - be 'fifo, 'block-special, or 'char-special. PERMS specifies the - permission bits to give the newly created file. If TYPE is - 'block-special or 'char-special, DEV specifies which device the - special file refers to; its interpretation depends on the kind of - special file being created. - -*** The `fork' function has been renamed to `primitive-fork', to avoid -clashing with various SCSH forks. - -*** The `recv' and `recvfrom' functions have been renamed to `recv!' -and `recvfrom!'. They no longer accept a size for a second argument; -you must pass a string to hold the received value. They no longer -return the buffer. Instead, `recv' returns the length of the message -received, and `recvfrom' returns a pair containing the packet's length -and originating address. - -*** The file descriptor datatype has been removed, as have the -`read-fd', `write-fd', `close', `lseek', and `dup' functions. -We plan to replace these functions with a SCSH-compatible interface. - -*** The `create' function has been removed; it's just a special case -of `open'. - -*** There are new functions to break down process termination status -values. In the descriptions below, STATUS is a value returned by -`waitpid'. - -(status:exit-val STATUS) - If the child process exited normally, this function returns the exit - code for the child process (i.e., the value passed to exit, or - returned from main). If the child process did not exit normally, - this function returns #f. - -(status:stop-sig STATUS) - If the child process was suspended by a signal, this function - returns the signal that suspended the child. Otherwise, it returns - #f. - -(status:term-sig STATUS) - If the child process terminated abnormally, this function returns - the signal that terminated the child. Otherwise, this function - returns false. - -POSIX promises that exactly one of these functions will return true on -a valid STATUS value. - -These functions are compatible with SCSH. - -*** There are new accessors and setters for the broken-out time vectors -returned by `localtime', `gmtime', and that ilk. They are: - - Component Accessor Setter - ========================= ============ ============ - seconds tm:sec set-tm:sec - minutes tm:min set-tm:min - hours tm:hour set-tm:hour - day of the month tm:mday set-tm:mday - month tm:mon set-tm:mon - year tm:year set-tm:year - day of the week tm:wday set-tm:wday - day in the year tm:yday set-tm:yday - daylight saving time tm:isdst set-tm:isdst - GMT offset, seconds tm:gmtoff set-tm:gmtoff - name of time zone tm:zone set-tm:zone - -*** There are new accessors for the vectors returned by `uname', -describing the host system: - - Component Accessor - ============================================== ================ - name of the operating system implementation utsname:sysname - network name of this machine utsname:nodename - release level of the operating system utsname:release - version level of the operating system utsname:version - machine hardware platform utsname:machine - -*** There are new accessors for the vectors returned by `getpw', -`getpwnam', `getpwuid', and `getpwent', describing entries from the -system's user database: - - Component Accessor - ====================== ================= - user name passwd:name - user password passwd:passwd - user id passwd:uid - group id passwd:gid - real name passwd:gecos - home directory passwd:dir - shell program passwd:shell - -*** There are new accessors for the vectors returned by `getgr', -`getgrnam', `getgrgid', and `getgrent', describing entries from the -system's group database: - - Component Accessor - ======================= ============ - group name group:name - group password group:passwd - group id group:gid - group members group:mem - -*** There are new accessors for the vectors returned by `gethost', -`gethostbyaddr', `gethostbyname', and `gethostent', describing -internet hosts: - - Component Accessor - ========================= =============== - official name of host hostent:name - alias list hostent:aliases - host address type hostent:addrtype - length of address hostent:length - list of addresses hostent:addr-list - -*** There are new accessors for the vectors returned by `getnet', -`getnetbyaddr', `getnetbyname', and `getnetent', describing internet -networks: - - Component Accessor - ========================= =============== - official name of net netent:name - alias list netent:aliases - net number type netent:addrtype - net number netent:net - -*** There are new accessors for the vectors returned by `getproto', -`getprotobyname', `getprotobynumber', and `getprotoent', describing -internet protocols: - - Component Accessor - ========================= =============== - official protocol name protoent:name - alias list protoent:aliases - protocol number protoent:proto - -*** There are new accessors for the vectors returned by `getserv', -`getservbyname', `getservbyport', and `getservent', describing -internet protocols: - - Component Accessor - ========================= =============== - official service name servent:name - alias list servent:aliases - port number servent:port - protocol to use servent:proto - -*** There are new accessors for the sockaddr structures returned by -`accept', `getsockname', `getpeername', `recvfrom!': - - Component Accessor - ======================================== =============== - address format (`family') sockaddr:fam - path, for file domain addresses sockaddr:path - address, for internet domain addresses sockaddr:addr - TCP or UDP port, for internet sockaddr:port - -*** The `getpwent', `getgrent', `gethostent', `getnetent', -`getprotoent', and `getservent' functions now return #f at the end of -the user database. (They used to throw an exception.) - -Note that calling MUMBLEent function is equivalent to calling the -corresponding MUMBLE function with no arguments. - -*** The `setpwent', `setgrent', `sethostent', `setnetent', -`setprotoent', and `setservent' routines now take no arguments. - -*** The `gethost', `getproto', `getnet', and `getserv' functions now -provide more useful information when they throw an exception. - -*** The `lnaof' function has been renamed to `inet-lnaof'. - -*** Guile now claims to have the `current-time' feature. - -*** The `mktime' function now takes an optional second argument ZONE, -giving the time zone to use for the conversion. ZONE should be a -string, in the same format as expected for the "TZ" environment variable. - -*** The `strptime' function now returns a pair (TIME . COUNT), where -TIME is the parsed time as a vector, and COUNT is the number of -characters from the string left unparsed. This function used to -return the remaining characters as a string. - -*** The `gettimeofday' function has replaced the old `time+ticks' function. -The return value is now (SECONDS . MICROSECONDS); the fractional -component is no longer expressed in "ticks". - -*** The `ticks/sec' constant has been removed, in light of the above change. - -* Changes to the gh_ interface - -** gh_eval_str() now returns an SCM object which is the result of the -evaluation - -** gh_scm2str() now copies the Scheme data to a caller-provided C -array - -** gh_scm2newstr() now makes a C array, copies the Scheme data to it, -and returns the array - -** gh_scm2str0() is gone: there is no need to distinguish -null-terminated from non-null-terminated, since gh_scm2newstr() allows -the user to interpret the data both ways. - -* Changes to the scm_ interface - -** The new function scm_symbol_value0 provides an easy way to get a -symbol's value from C code: - -SCM scm_symbol_value0 (char *NAME) - Return the value of the symbol named by the null-terminated string - NAME in the current module. If the symbol named NAME is unbound in - the current module, return SCM_UNDEFINED. - -** The new function scm_sysintern0 creates new top-level variables, -without assigning them a value. - -SCM scm_sysintern0 (char *NAME) - Create a new Scheme top-level variable named NAME. NAME is a - null-terminated string. Return the variable's value cell. - -** The function scm_internal_catch is the guts of catch. It handles -all the mechanics of setting up a catch target, invoking the catch -body, and perhaps invoking the handler if the body does a throw. - -The function is designed to be usable from C code, but is general -enough to implement all the semantics Guile Scheme expects from throw. - -TAG is the catch tag. Typically, this is a symbol, but this function -doesn't actually care about that. - -BODY is a pointer to a C function which runs the body of the catch; -this is the code you can throw from. We call it like this: - BODY (BODY_DATA, JMPBUF) -where: - BODY_DATA is just the BODY_DATA argument we received; we pass it - through to BODY as its first argument. The caller can make - BODY_DATA point to anything useful that BODY might need. - JMPBUF is the Scheme jmpbuf object corresponding to this catch, - which we have just created and initialized. - -HANDLER is a pointer to a C function to deal with a throw to TAG, -should one occur. We call it like this: - HANDLER (HANDLER_DATA, THROWN_TAG, THROW_ARGS) -where - HANDLER_DATA is the HANDLER_DATA argument we recevied; it's the - same idea as BODY_DATA above. - THROWN_TAG is the tag that the user threw to; usually this is - TAG, but it could be something else if TAG was #t (i.e., a - catch-all), or the user threw to a jmpbuf. - THROW_ARGS is the list of arguments the user passed to the THROW - function. - -BODY_DATA is just a pointer we pass through to BODY. HANDLER_DATA -is just a pointer we pass through to HANDLER. We don't actually -use either of those pointers otherwise ourselves. The idea is -that, if our caller wants to communicate something to BODY or -HANDLER, it can pass a pointer to it as MUMBLE_DATA, which BODY and -HANDLER can then use. Think of it as a way to make BODY and -HANDLER closures, not just functions; MUMBLE_DATA points to the -enclosed variables. - -Of course, it's up to the caller to make sure that any data a -MUMBLE_DATA needs is protected from GC. A common way to do this is -to make MUMBLE_DATA a pointer to data stored in an automatic -structure variable; since the collector must scan the stack for -references anyway, this assures that any references in MUMBLE_DATA -will be found. - -** The new function scm_internal_lazy_catch is exactly like -scm_internal_catch, except: - -- It does not unwind the stack (this is the major difference). -- If handler returns, its value is returned from the throw. -- BODY always receives #f as its JMPBUF argument (since there's no - jmpbuf associated with a lazy catch, because we don't unwind the - stack.) - -** scm_body_thunk is a new body function you can pass to -scm_internal_catch if you want the body to be like Scheme's `catch' ---- a thunk, or a function of one argument if the tag is #f. - -BODY_DATA is a pointer to a scm_body_thunk_data structure, which -contains the Scheme procedure to invoke as the body, and the tag -we're catching. If the tag is #f, then we pass JMPBUF (created by -scm_internal_catch) to the body procedure; otherwise, the body gets -no arguments. - -** scm_handle_by_proc is a new handler function you can pass to -scm_internal_catch if you want the handler to act like Scheme's catch ---- call a procedure with the tag and the throw arguments. - -If the user does a throw to this catch, this function runs a handler -procedure written in Scheme. HANDLER_DATA is a pointer to an SCM -variable holding the Scheme procedure object to invoke. It ought to -be a pointer to an automatic variable (i.e., one living on the stack), -or the procedure object should be otherwise protected from GC. - -** scm_handle_by_message is a new handler function to use with -`scm_internal_catch' if you want Guile to print a message and die. -It's useful for dealing with throws to uncaught keys at the top level. - -HANDLER_DATA, if non-zero, is assumed to be a char * pointing to a -message header to print; if zero, we use "guile" instead. That -text is followed by a colon, then the message described by ARGS. - -** The return type of scm_boot_guile is now void; the function does -not return a value, and indeed, never returns at all. - -** The new function scm_shell makes it easy for user applications to -process command-line arguments in a way that is compatible with the -stand-alone guile interpreter (which is in turn compatible with SCSH, -the Scheme shell). - -To use the scm_shell function, first initialize any guile modules -linked into your application, and then call scm_shell with the values -of ARGC and ARGV your `main' function received. scm_shell will add -any SCSH-style meta-arguments from the top of the script file to the -argument vector, and then process the command-line arguments. This -generally means loading a script file or starting up an interactive -command interpreter. For details, see "Changes to the stand-alone -interpreter" above. - -** The new functions scm_get_meta_args and scm_count_argv help you -implement the SCSH-style meta-argument, `\'. - -char **scm_get_meta_args (int ARGC, char **ARGV) - If the second element of ARGV is a string consisting of a single - backslash character (i.e. "\\" in Scheme notation), open the file - named by the following argument, parse arguments from it, and return - the spliced command line. The returned array is terminated by a - null pointer. - - For details of argument parsing, see above, under "guile now accepts - command-line arguments compatible with SCSH..." - -int scm_count_argv (char **ARGV) - Count the arguments in ARGV, assuming it is terminated by a null - pointer. - -For an example of how these functions might be used, see the source -code for the function scm_shell in libguile/script.c. - -You will usually want to use scm_shell instead of calling this -function yourself. - -** The new function scm_compile_shell_switches turns an array of -command-line arguments into Scheme code to carry out the actions they -describe. Given ARGC and ARGV, it returns a Scheme expression to -evaluate, and calls scm_set_program_arguments to make any remaining -command-line arguments available to the Scheme code. For example, -given the following arguments: - - -e main -s ekko a speckled gecko - -scm_set_program_arguments will return the following expression: - - (begin (load "ekko") (main (command-line)) (quit)) - -You will usually want to use scm_shell instead of calling this -function yourself. - -** The function scm_shell_usage prints a usage message appropriate for -an interpreter that uses scm_compile_shell_switches to handle its -command-line arguments. - -void scm_shell_usage (int FATAL, char *MESSAGE) - Print a usage message to the standard error output. If MESSAGE is - non-zero, write it before the usage message, followed by a newline. - If FATAL is non-zero, exit the process, using FATAL as the - termination status. (If you want to be compatible with Guile, - always use 1 as the exit status when terminating due to command-line - usage problems.) - -You will usually want to use scm_shell instead of calling this -function yourself. - -** scm_eval_0str now returns SCM_UNSPECIFIED if the string contains no -expressions. It used to return SCM_EOL. Earth-shattering. - -** The macros for declaring scheme objects in C code have been -rearranged slightly. They are now: - -SCM_SYMBOL (C_NAME, SCHEME_NAME) - Declare a static SCM variable named C_NAME, and initialize it to - point to the Scheme symbol whose name is SCHEME_NAME. C_NAME should - be a C identifier, and SCHEME_NAME should be a C string. - -SCM_GLOBAL_SYMBOL (C_NAME, SCHEME_NAME) - Just like SCM_SYMBOL, but make C_NAME globally visible. - -SCM_VCELL (C_NAME, SCHEME_NAME) - Create a global variable at the Scheme level named SCHEME_NAME. - Declare a static SCM variable named C_NAME, and initialize it to - point to the Scheme variable's value cell. - -SCM_GLOBAL_VCELL (C_NAME, SCHEME_NAME) - Just like SCM_VCELL, but make C_NAME globally visible. - -The `guile-snarf' script writes initialization code for these macros -to its standard output, given C source code as input. - -The SCM_GLOBAL macro is gone. - -** The scm_read_line and scm_read_line_x functions have been replaced -by Scheme code based on the %read-delimited! procedure (known to C -code as scm_read_delimited_x). See its description above for more -information. - -** The function scm_sys_open has been renamed to scm_open. It now -returns a port instead of an FD object. - -* The dynamic linking support has changed. For more information, see -libguile/DYNAMIC-LINKING. - - -Guile 1.0b3 - -User-visible changes from Thursday, September 5, 1996 until Guile 1.0 -(Sun 5 Jan 1997): - -* Changes to the 'guile' program: - -** Guile now loads some new files when it starts up. Guile first -searches the load path for init.scm, and loads it if found. Then, if -Guile is not being used to execute a script, and the user's home -directory contains a file named `.guile', Guile loads that. - -** You can now use Guile as a shell script interpreter. - -To paraphrase the SCSH manual: - - When Unix tries to execute an executable file whose first two - characters are the `#!', it treats the file not as machine code to - be directly executed by the native processor, but as source code - to be executed by some interpreter. The interpreter to use is - specified immediately after the #! sequence on the first line of - the source file. The kernel reads in the name of the interpreter, - and executes that instead. It passes the interpreter the source - filename as its first argument, with the original arguments - following. Consult the Unix man page for the `exec' system call - for more information. - -Now you can use Guile as an interpreter, using a mechanism which is a -compatible subset of that provided by SCSH. - -Guile now recognizes a '-s' command line switch, whose argument is the -name of a file of Scheme code to load. It also treats the two -characters `#!' as the start of a comment, terminated by `!#'. Thus, -to make a file of Scheme code directly executable by Unix, insert the -following two lines at the top of the file: - -#!/usr/local/bin/guile -s -!# - -Guile treats the argument of the `-s' command-line switch as the name -of a file of Scheme code to load, and treats the sequence `#!' as the -start of a block comment, terminated by `!#'. - -For example, here's a version of 'echo' written in Scheme: - -#!/usr/local/bin/guile -s -!# -(let loop ((args (cdr (program-arguments)))) - (if (pair? args) - (begin - (display (car args)) - (if (pair? (cdr args)) - (display " ")) - (loop (cdr args))))) -(newline) - -Why does `#!' start a block comment terminated by `!#', instead of the -end of the line? That is the notation SCSH uses, and although we -don't yet support the other SCSH features that motivate that choice, -we would like to be backward-compatible with any existing Guile -scripts once we do. Furthermore, if the path to Guile on your system -is too long for your kernel, you can start the script with this -horrible hack: - -#!/bin/sh -exec /really/long/path/to/guile -s "$0" ${1+"$@"} -!# - -Note that some very old Unix systems don't support the `#!' syntax. - - -** You can now run Guile without installing it. - -Previous versions of the interactive Guile interpreter (`guile') -couldn't start up unless Guile's Scheme library had been installed; -they used the value of the environment variable `SCHEME_LOAD_PATH' -later on in the startup process, but not to find the startup code -itself. Now Guile uses `SCHEME_LOAD_PATH' in all searches for Scheme -code. - -To run Guile without installing it, build it in the normal way, and -then set the environment variable `SCHEME_LOAD_PATH' to a -colon-separated list of directories, including the top-level directory -of the Guile sources. For example, if you unpacked Guile so that the -full filename of this NEWS file is /home/jimb/guile-1.0b3/NEWS, then -you might say - - export SCHEME_LOAD_PATH=/home/jimb/my-scheme:/home/jimb/guile-1.0b3 - - -** Guile's read-eval-print loop no longer prints #<unspecified> -results. If the user wants to see this, she can evaluate the -expression (assert-repl-print-unspecified #t), perhaps in her startup -file. - -** Guile no longer shows backtraces by default when an error occurs; -however, it does display a message saying how to get one, and how to -request that they be displayed by default. After an error, evaluate - (backtrace) -to see a backtrace, and - (debug-enable 'backtrace) -to see them by default. - - - -* Changes to Guile Scheme: - -** Guile now distinguishes between #f and the empty list. - -This is for compatibility with the IEEE standard, the (possibly) -upcoming Revised^5 Report on Scheme, and many extant Scheme -implementations. - -Guile used to have #f and '() denote the same object, to make Scheme's -type system more compatible with Emacs Lisp's. However, the change -caused too much trouble for Scheme programmers, and we found another -way to reconcile Emacs Lisp with Scheme that didn't require this. - - -** Guile's delq, delv, delete functions, and their destructive -counterparts, delq!, delv!, and delete!, now remove all matching -elements from the list, not just the first. This matches the behavior -of the corresponding Emacs Lisp functions, and (I believe) the Maclisp -functions which inspired them. - -I recognize that this change may break code in subtle ways, but it -seems best to make the change before the FSF's first Guile release, -rather than after. - - -** The compiled-library-path function has been deleted from libguile. - -** The facilities for loading Scheme source files have changed. - -*** The variable %load-path now tells Guile which directories to search -for Scheme code. Its value is a list of strings, each of which names -a directory. - -*** The variable %load-extensions now tells Guile which extensions to -try appending to a filename when searching the load path. Its value -is a list of strings. Its default value is ("" ".scm"). - -*** (%search-load-path FILENAME) searches the directories listed in the -value of the %load-path variable for a Scheme file named FILENAME, -with all the extensions listed in %load-extensions. If it finds a -match, then it returns its full filename. If FILENAME is absolute, it -returns it unchanged. Otherwise, it returns #f. - -%search-load-path will not return matches that refer to directories. - -*** (primitive-load FILENAME :optional CASE-INSENSITIVE-P SHARP) -uses %seach-load-path to find a file named FILENAME, and loads it if -it finds it. If it can't read FILENAME for any reason, it throws an -error. - -The arguments CASE-INSENSITIVE-P and SHARP are interpreted as by the -`read' function. - -*** load uses the same searching semantics as primitive-load. - -*** The functions %try-load, try-load-with-path, %load, load-with-path, -basic-try-load-with-path, basic-load-with-path, try-load-module-with- -path, and load-module-with-path have been deleted. The functions -above should serve their purposes. - -*** If the value of the variable %load-hook is a procedure, -`primitive-load' applies its value to the name of the file being -loaded (without the load path directory name prepended). If its value -is #f, it is ignored. Otherwise, an error occurs. - -This is mostly useful for printing load notification messages. - - -** The function `eval!' is no longer accessible from the scheme level. -We can't allow operations which introduce glocs into the scheme level, -because Guile's type system can't handle these as data. Use `eval' or -`read-and-eval!' (see below) as replacement. - -** The new function read-and-eval! reads an expression from PORT, -evaluates it, and returns the result. This is more efficient than -simply calling `read' and `eval', since it is not necessary to make a -copy of the expression for the evaluator to munge. - -Its optional arguments CASE_INSENSITIVE_P and SHARP are interpreted as -for the `read' function. - - -** The function `int?' has been removed; its definition was identical -to that of `integer?'. - -** The functions `<?', `<?', `<=?', `=?', `>?', and `>=?'. Code should -use the R4RS names for these functions. - -** The function object-properties no longer returns the hash handle; -it simply returns the object's property list. - -** Many functions have been changed to throw errors, instead of -returning #f on failure. The point of providing exception handling in -the language is to simplify the logic of user code, but this is less -useful if Guile's primitives don't throw exceptions. - -** The function `fileno' has been renamed from `%fileno'. - -** The function primitive-mode->fdes returns #t or #f now, not 1 or 0. - - -* Changes to Guile's C interface: - -** The library's initialization procedure has been simplified. -scm_boot_guile now has the prototype: - -void scm_boot_guile (int ARGC, - char **ARGV, - void (*main_func) (), - void *closure); - -scm_boot_guile calls MAIN_FUNC, passing it CLOSURE, ARGC, and ARGV. -MAIN_FUNC should do all the work of the program (initializing other -packages, reading user input, etc.) before returning. When MAIN_FUNC -returns, call exit (0); this function never returns. If you want some -other exit value, MAIN_FUNC may call exit itself. - -scm_boot_guile arranges for program-arguments to return the strings -given by ARGC and ARGV. If MAIN_FUNC modifies ARGC/ARGV, should call -scm_set_program_arguments with the final list, so Scheme code will -know which arguments have been processed. - -scm_boot_guile establishes a catch-all catch handler which prints an -error message and exits the process. This means that Guile exits in a -coherent way when system errors occur and the user isn't prepared to -handle it. If the user doesn't like this behavior, they can establish -their own universal catcher in MAIN_FUNC to shadow this one. - -Why must the caller do all the real work from MAIN_FUNC? The garbage -collector assumes that all local variables of type SCM will be above -scm_boot_guile's stack frame on the stack. If you try to manipulate -SCM values after this function returns, it's the luck of the draw -whether the GC will be able to find the objects you allocate. So, -scm_boot_guile function exits, rather than returning, to discourage -people from making that mistake. - -The IN, OUT, and ERR arguments were removed; there are other -convenient ways to override these when desired. - -The RESULT argument was deleted; this function should never return. - -The BOOT_CMD argument was deleted; the MAIN_FUNC argument is more -general. - - -** Guile's header files should no longer conflict with your system's -header files. - -In order to compile code which #included <libguile.h>, previous -versions of Guile required you to add a directory containing all the -Guile header files to your #include path. This was a problem, since -Guile's header files have names which conflict with many systems' -header files. - -Now only <libguile.h> need appear in your #include path; you must -refer to all Guile's other header files as <libguile/mumble.h>. -Guile's installation procedure puts libguile.h in $(includedir), and -the rest in $(includedir)/libguile. - - -** Two new C functions, scm_protect_object and scm_unprotect_object, -have been added to the Guile library. - -scm_protect_object (OBJ) protects OBJ from the garbage collector. -OBJ will not be freed, even if all other references are dropped, -until someone does scm_unprotect_object (OBJ). Both functions -return OBJ. - -Note that calls to scm_protect_object do not nest. You can call -scm_protect_object any number of times on a given object, and the -next call to scm_unprotect_object will unprotect it completely. - -Basically, scm_protect_object and scm_unprotect_object just -maintain a list of references to things. Since the GC knows about -this list, all objects it mentions stay alive. scm_protect_object -adds its argument to the list; scm_unprotect_object remove its -argument from the list. - - -** scm_eval_0str now returns the value of the last expression -evaluated. - -** The new function scm_read_0str reads an s-expression from a -null-terminated string, and returns it. - -** The new function `scm_stdio_to_port' converts a STDIO file pointer -to a Scheme port object. - -** The new function `scm_set_program_arguments' allows C code to set -the value teruturned by the Scheme `program-arguments' function. - - -Older changes: - -* Guile no longer includes sophisticated Tcl/Tk support. - -The old Tcl/Tk support was unsatisfying to us, because it required the -user to link against the Tcl library, as well as Tk and Guile. The -interface was also un-lispy, in that it preserved Tcl/Tk's practice of -referring to widgets by names, rather than exporting widgets to Scheme -code as a special datatype. - -In the Usenix Tk Developer's Workshop held in July 1996, the Tcl/Tk -maintainers described some very interesting changes in progress to the -Tcl/Tk internals, which would facilitate clean interfaces between lone -Tk and other interpreters --- even for garbage-collected languages -like Scheme. They expected the new Tk to be publicly available in the -fall of 1996. - -Since it seems that Guile might soon have a new, cleaner interface to -lone Tk, and that the old Guile/Tk glue code would probably need to be -completely rewritten, we (Jim Blandy and Richard Stallman) have -decided not to support the old code. We'll spend the time instead on -a good interface to the newer Tk, as soon as it is available. - -Until then, gtcltk-lib provides trivial, low-maintenance functionality. - - -Copyright information: - -Copyright (C) 1996,1997 Free Software Foundation, Inc. - - Permission is granted to anyone to make or distribute verbatim copies - of this document as received, in any medium, provided that the - copyright notice and this permission notice are preserved, - thus giving the recipient permission to redistribute in turn. - - Permission is granted to distribute modified versions - of this document, or of portions of it, - under the above conditions, provided also that they - carry prominent notices stating who last changed them. - - -Local variables: -mode: outline -paragraph-separate: "[ ]*$" -end: - diff --git a/NOTES b/NOTES deleted file mode 100644 index 73262c0ea..000000000 --- a/NOTES +++ /dev/null @@ -1,70 +0,0 @@ -This is the Guile developer notice-board. -*- change-log -*- ----------------------------------------------------------------------- -CONTENTS: Notes of various kinds which the Guile developers want to -share among eachother, e. g., a memo about something which needs -fixing. Describing a certain problem here means that everyone is free -to fix it when and as he wishes. (Of course it can sometimes be suitable -to discuss it first.) - -RULES: Entries should have a date and the name of the author. Entries -should be sufficiently detailed to enable other members of the team to -understand them, but they need not be comprehensible to people who -don't spend much time on Guile. This file should not go into -snapshots or distributions, but is a strictly internal document. - -CONVENTIONS: ChangeLog format. (Reverse chronological order.) ----------------------------------------------------------------------- - -Sun Mar 9 15:45:14 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * We need to discuss the long-term solution to Guile configuration - and customization. - - * Some day when more important stuff (module system, threads, Tk - interface etc) has been completed, we should split up SCM's - ChangeLog among us, and go through all changes since the birth of - Guile. We might find many nice bug fixes and improvements... - - * libguile/gc.c (scm_gc_sweep): The probability of collecting a - free cell should be very low (only occurring when a signal has - interrupted allocation). Nevertheless, the GC immediately exits - when the free cell test is enabled in the sweeper. Where does - this free cell come from? - - * libguile/arbiters.c: Remove this file? When we've implemented - POSIX thread support, "arbiters" will be superfluous. - -Thu Mar 6 00:54:59 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * libguile/unif.c: Introduce "fancy printing" for vectors. "Fancy - printing" is performed by the printer when the `fancyp' flag is - set in the print state (see print.h). One of its effects is that - sequences should be printed with maximum `length' objects. (This - is currently only used in backtraces and error messages). - This works for lists, but not yet for vectors and arrays. - -Wed Mar 5 22:56:19 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * libguile/struct.c, libguile/struct.h, libguile/gc.c: Structs - need reimplementation. Both user interface and representation - need to be improved. E. g., the struct part of scm_gc_mark need - to be a lot more efficient. We should probably do this redesign - when designing(/porting) the object system. - - * libguile/symbols.c (SCM_SYMBOL_HASH): This is slot is currently - not used for anything (except that it is used by symbol-hash). I - suppose it was originally intended to avoid doing multiple hashing - steps when handling symbols. - -Mon Mar 3 21:36:58 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * libguile/procprop.c: The current implementation of procedure - properties of closures uses a special property slot - (SCM_PROCPROPS (closure)), but primitive procedures don't have - such a slot. Setting or getting source properties for primitive - procedures currently involves making fake closures. These are - stored in an alist => finding the properties of a primitive - procedure is O (n primitive procedures with properties) which is - unacceptable. - -
\ No newline at end of file diff --git a/README b/README deleted file mode 100644 index efe772842..000000000 --- a/README +++ /dev/null @@ -1,146 +0,0 @@ -This is beta release 1.2.90 of Guile, a portable, embeddable Scheme -implementation written in C. Guile provides a machine independent -execution platform that can be linked in as a library when building -extensible programs. - -Please send bug reports to bug-guile@gnu.org. - -About This Distribution ============================================== - -Building and installing this distribution gives you: -guile --- a stand-alone interpreter for Guile, usually installed in - /usr/local/bin. With no arguments, this is a simple - interactive Scheme interpreter. It can also be used as an - interpreter for script files; see the NEWS file for details. -guile-config --- a Guile script which provides the information necessary - to link your programs against the Guile library. -libguile.a --- an object library containing the Guile interpreter, - usually installed in /usr/local/lib. You can use Guile in - your own programs by linking against this. -libqthreads.a --- an object library containing the QuickThreads - primitives. If you enabled thread support when you configured - Guile, you will need to link your code against this too. -<libguile.h>, <libguile/*.h> --- header files for libguile.a, usually - installed in /usr/local/include. -ice-9, ice-9/*.scm --- run-time support for Guile: the module - system, read-eval-print loop, some R4RS code and other - infrastructure. Usually installed in - /usr/local/share/guile/<version>. - -Interesting files include: -- INSTALL, which contains instructions on building and installing Guile. -- NEWS, which describes user-visible changes since the last release of Guile. -- COPYING, which describes the terms under which you may redistribute - Guile, and explains that there is no warranty. - -The Guile source tree is laid out as follows: - -libguile: - The Guile Scheme interpreter --- both the object library - for you to link with your programs, and the executable you can run. -ice-9: Guile's module system, initialization code, and other infrastructure. -guile-config: - Source for the guile-config script. -qt: A cooperative threads package from the University of Washington, - which Guile can use. If you configure Guile with the - --with-threads flag, you will need to link against the -lqt - library, found in this directory. Qt is under a separate - copyright; see `qt/README' for more details. -doc: Some preliminary documentation for Guile. The real Guile - manual is incomplete, and is currently being revised.. - - -Anonymous CVS Access and FTP snapshots =============================== - -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. - - -Hacking It Yourself ================================================== - -As distributed, Guile needs only an ANSI C compiler and a Unix system -to compile. However, Guile's makefiles, configuration scripts, and a -few other files are automatically generated, not written by hand. If -you want to make changes to the system (which we encourage!) you will -find it helpful to have the tools we use to develop Guile. They -are the following: - -Autoconf 2.12 --- a system for automatically generating `configure' - scripts from templates which list the non-portable features a - program would like to use. Available in - "ftp://prep.ai.mit.edu/pub/gnu". - -Automake 1.3 --- a system for automatically generating Makefiles that - conform to the (rather Byzantine) GNU coding standards. The - nice thing is that it takes care of hairy targets like 'make - dist' and 'make distclean', and automatically generates - Makefile dependencies. Automake is available in - "ftp://prep.ai.mit.edu/pub/gnu". - - Before using automake, you may need to copy `threads.m4' and - `guile.m4' from the top directory of the Guile core disty to - `/usr/local/share/aclocal. - -libtool 1.2 --- a system for managing the zillion hairy options needed - on various systems to produce shared libraries. Available in - "ftp://prep.ai.mit.edu/pub/gnu". - -You are lost in a little maze of automatically generated files, all -different. -> - - -Obtaining Guile ====================================================== - -This beta release of Guile is available via anonymous FTP from -ftp.red-bean.com, as pub/guile/guile-1.2.90.tar.gz. - -The latest official Guile release is available via anonymous FTP from -prep.ai.mit.edu, as /pub/gnu/guile-1.2.tar.gz. - -Via the web, that's: ftp://prep.ai.mit.edu/pub/gnu/guile-1.2.tar.gz -For getit, that's: prep.ai.mit.edu:/pub/gnu/guile-1.2.tar.gz - -The mailing list `guile@cygnus.com' carries discussions, questions, -and often answers, about Guile. To subscribe, send mail to -guile-request@cygnus.com. Of course, please send bug reports (and -fixes!) to bug-guile@gnu.org. - - -Authors And Contributors ============================================= - -Many people have generously contributed to Guile. However, any errors -are the responsibility of the primary Guile maintainer, Jim Blandy. - -Mikael Djurfeldt designed and implemented: -* the source-level debugging support (although the debugger's user - interface is not yet complete) -* stack overflow detection, -* the GDB patches to support debugging mixed Scheme/C code, -* the original implementation of weak hash tables, -* enhancements to the `threads' interface (based on Anthony Green's - work), and -* detection of circular references during printing. - -Mark Galassi contributed the Guile high-level functions (gh_*), and -wrote the guile-programmer and guile-user manuals. (These are in the -process of revision.) - -Anthony Green wrote the original version of `threads', the interface -between Guile and qt. - -Gary Houston wrote much of the Unix system call support, including the -socket support, and did a lot of work on the error handling code. - -Tom Lord librarified SCM, yielding Guile. He wrote Guile's operating -system, Ice-9, and connected Guile to Tcl/Tk and the `rx' regular -expression matcher. - -Aubrey Jaffer is the author of SCM upon which Guile is based. Guile -started from SCM version 4e1 in November -94 and is still largely -composed of the original SCM code. - -George Carrette wrote SIOD, a stand-alone scheme interpreter. -Although most of this code as been rewritten or replaced over time, -the garbage collector from SIOD is still an important part of Guile. diff --git a/RELEASE b/RELEASE deleted file mode 100644 index 3ed4b0677..000000000 --- a/RELEASE +++ /dev/null @@ -1,78 +0,0 @@ -This is a checklist for making Guile releases. -It's specific to the FSF's development environment; please don't put -it in the distribution. - -In release 1.3: -- (done) make #/ generate a warning. -- (done) make SCHEME_LOAD_PATH generate a warning. -- Perry Metzger <perry@piermont.com> is willing to do beta-testing - for NetBSD. - -In release 1.4: -- remove #/ syntax -- Remove SCHEME_LOAD_PATH. - -Platforms for test builds: -SunOS (gcc and pcc) --- galapas.ai.mit.edu -Solaris (gcc and SUN cc) --- saturn.ai.mit.edu -NetBSD (gcc) --- repo-man.ai.mit.edu (use /home/repo/jimb) -HP/UX (gcc, HP cc) --- nutrimat.gnu.ai.mit.edu - - -1) Check that the versions of aclocal, automake, autoconf, and autoheader - in your PATH match those given in README. Note that the `make - dist' process always invokes these tools, even when all the - generated files are up to date. -2) Verify that Guile builds and runs in your working directory. I - hope that we'll eventually have a test suite to make this more - concrete, but for the moment, just make sure things seem sane. -3) Make sure NEWS and the docs are up to date: - a) Scan the ChangeLogs for user-visible changes, marked with an asterisk - at the left margin. - b) Update NEWS and the Texinfo documentation as appropriate. - c) Remove the user-visible markers from the log entries once they're - documented. - d) Check for any [[incomplete]] sections of NEWS. -4) Scan output from `cvs log' to find files that have changed a lot, but - do not have up-to-date copyright notices. -5) Update the version numbers in GUILE-VERSION, and README. The Guile - version number should be of the form N.M for a major release, and - N.M.L for snapshots and beta releases; L should be even for beta - releases, and odd for snapshots. -6) Set up README appropriately for the release; check name spellings - in THANKS, and reformat. -7) Choose new interface numbers for shared libraries. -8) Do a `cvs update -A', to get rid of any sticky tags. -9) Rebuild all generated files in the source tree: - a) Install the .m4 files where aclocal will find them. - b) Run aclocal. - c) Run automake. - d) Run autoconf. - e) Run autoheader. -10) Commit all changes to the CVS repository. -11) Verify that the disty works, too: - a) Make a disty, using 'make dist'. - b) Unpack it somewhere else. - c) Remove automake and autoconf from your path, or turn off their - execute bits, or something. (Users should be able to build disty - without installing those tools.) - d) Configure, make, and install. - e) Test the installed version; don't forget to unset GUILE_LOAD_PATH. - f) If you made any fixes, commit them, and start from a) again -12) Tag the entire source tree with a tag of the form "release_N_M". -13) Copy the tar file over to the GNU machines, and ask the appropriate - person to put it on prep. At the time of this writing, Joel Weber - <devnull@gnu.org> has been generous about helping with that. -14) Send an announcement message to gnu-announce@gnu.org. Put - "Obtaining Guile" first, then a brief summary of the changes in - this release, then "Thanks," "About This Distribution," and - "Nightly Snapshots." If I remember correctly, the moderator will - delay it until the tar file appears on prep. The announcement - text should be mostly taken from Guile's README file. -15) Notify freshmeat.net, although they're probably watching anyway. -16) Tweak the version numbers in GUILE-VERSION, and README to indicate that - the sources are snapshot again. Snapshots should have version numbers - of the form "N.M.L", where L is odd. -17) Start a new section of the NEWS file. -18) Send mail to majordomo-owner@cygnus.com updating the message you get - when you ask majordomo for "info guile". diff --git a/SNAPSHOTS b/SNAPSHOTS deleted file mode 100644 index 6fdd9bc9c..000000000 --- a/SNAPSHOTS +++ /dev/null @@ -1,28 +0,0 @@ -FTP Snapshots ======================================================== - -Each night, we make the current Guile sources available via anonymous -FTP. Please keep in mind that these sources are strictly -experimental; they will usually not be well-tested, and may not even -compile on some systems. They may contain interfaces which will -change. They will usually not be of sufficient quality for use by -people not comfortable hacking the innards of Guile. Caveat! - -However, we're providing them anyway for several reasons. We'd like -to encourage people to get involved in developing Guile. People -willing to use the bleeding edge of development can get earlier access -to new, experimental features. Patches submitted relative to recent -snapshots will be easier for us to evaluate and install, since the -patch's original sources will be closer to what we're working with. -And it allows us to start testing features earlier. - -Nightly snapshots of the Guile development sources are available via -anonymous FTP from ftp.red-bean.com, as /pub/guile/guile-core-snap.tar.gz. - -Via the web, that's: ftp://ftp.red-bean.com/pub/guile/guile-core-snap.tar.gz -For getit, that's: ftp.red-bean.com:/pub/guile/guile-core-snap.tar.gz - -The snapshot FTP site is mirrored at the following locations: - Austria: ftp://ftp.aec.at/pub/guile - Japan: ftp://ftp.jaist.ac.jp/pub/lang/scheme/guile - - diff --git a/THANKS b/THANKS deleted file mode 100644 index 04f43d7e5..000000000 --- a/THANKS +++ /dev/null @@ -1,64 +0,0 @@ -The Guile core distribution: -- Marcus Daniels contributed changes to make Guile work under Windows NT - (using the cygwin32 DLL). -- Bernard Urban, for his work on the Hobbit Scheme->C compiler -- Tim Pierce, for faster line-oriented I/O (%read-line and friends) - -Bug reports and fixes from: - - Lauri Alanko - Andrew Archibald - Greg Badros - Aleksandar Bakic - Per Bothner - Ben Caradoc-Davies - Marcus Daniels - Doug Evans - Fred Fish - Jesse N. Glick - Eric Hanchrow - Greg Harvey - Karl M. Hegbloom - Dirk Herrmann - Gary Houston - Charbel Jacquin - Bill Janssen - Steven G. Johnson - Roland Kaufmann - Shiro Kawai -Christopher Lee - Michael N. Livshin - Christian Lynbech - Roland McGrath - Clark McGrew - Russ McManus - Harald Meland - Perry Metzger - Thomas Morgan - Shuji Narazaki - Nicolas Neuss - Thien-Thi Nguyen - Robert Pluim - Richard Polton - Chet Ramey - Jim Ravan - John Redford - Daniel Risacher - Ole Myren Röhne - Julian Satchell - Larry Schwimmer - Radey Shouman - Miroslav Silovic - Maciej Stachowiak - Harvey J. Stein - Eiichi Takamori - David Tillman - John Tobey - Greg Troxel - Bernard Urban - -Also, thanks to: -- Pat Eyler, for his continuing work on the Guile web pages -- Oliver Frommel, for setting up the European mirror of the - Guile development FTP server -- MORIOKA Tomohiko, for setting up the Japan mirror site @@ -1,38 +0,0 @@ -* Add facilities for debugging Scheme programs. - -The low-level debugging support is done, and we are now working on the -user interface. - -* Documentation. - -We have a new layout for the reference manual which covers the -C/Scheme interface, as well as the scheme variants. We also want a -more thorough tutorial manual, but we haven't sketched that out yet. - - -Desired later on - -* Good interface to Tk - -* Add a convenient facility for running a pipeline of processes -with redirections. Gary Houston <ghouston@actrix.gen.nz> -is working on this. - -* Make it possible to link Guile and TK without using libtcl.a, by -providing Guile-based replacements for the libtcl.a functions that TK -requires. - -* Make ordinary lambda functions work as callbacks for Tk; -eliminate the need for tcl-lambda. - -* Translators for additional languages; in particular, Perl, Python, -TCL, Emacs Lisp, and Rexx. - -* Clean up declarations of C functions to use a PROTO macro -for conditional prototypes, instead of explicit conditionals. - -* A package for time conversions and formatting. - -* Make GDB work with Guile - -This would permit programmable debugging and a nice integrated GUI. diff --git a/acconfig.h b/acconfig.h deleted file mode 100644 index ba22ae367..000000000 --- a/acconfig.h +++ /dev/null @@ -1,106 +0,0 @@ -/* acconfig.h --- documentation for symbols possibly defined in scmconfig.h - Jim Blandy <jimb@cyclic.com> --- August 1996 - The `autoheader' command, from the autoconf suite, generates - libguile/scmconfig.h, based on configure.in and this file. */ - -/* Define these two if you want support for debugging of Scheme - programs. */ -#undef DEBUG_EXTENSIONS -#undef READER_EXTENSIONS - -/* Define this if your system has a way to set a stdio stream's file - descriptor. */ -#undef FD_SETTER - -/* Set this to the name of a field in FILE which contains the number - of buffered characters waiting to be read. */ -#undef FILE_CNT_FIELD - -/* Define this if your stdio has _gptr and _egptr fields which can - be compared to give the number of buffered characters waiting to - be read. */ -#undef FILE_CNT_GPTR - -/* Define this if your stdio has _IO_read_ptr and _IO_read_end fields - which can be compared to give the number of buffered characters - waiting to be read. */ -#undef FILE_CNT_READPTR - -/* Define this if your system defines struct linger, for use with the - getsockopt and setsockopt system calls. */ -#undef HAVE_STRUCT_LINGER - -/* Define this if floats are the same size as longs. */ -#undef SCM_SINGLES - -/* Define this if a callee's stack frame has a higher address than the - caller's stack frame. On most machines, this is not the case. */ -#undef SCM_STACK_GROWS_UP - -/* Define this if <utime.h> doesn't define struct utimbuf unless - _POSIX_SOURCE is #defined. See GUILE_STRUCT_UTIMBUF in aclocal.m4. */ -#undef UTIMBUF_NEEDS_POSIX - -/* Define this if we should #include <libc.h> when we've already - #included <unistd.h>. On some systems, they conflict, and libc.h - should be omitted. See GUILE_HEADER_LIBC_WITH_UNISTD in - aclocal.m4. */ -#undef LIBC_H_WITH_UNISTD_H - -/* Define this to include various undocumented functions used to debug - the Guile library itself. */ -#undef GUILE_DEBUG - -/* Define to implement scm_internal_select */ -#undef GUILE_ISELECT - -/* Define if using cooperative multithreading. */ -#undef USE_COOP_THREADS - -/* Define if using "FSU" pthreads. */ -#undef USE_FSU_PTHREADS - -/* Define if using MIT pthreads. */ -#undef USE_MIT_PTHREADS - -/* Define if using PCthreads pthreads. */ -#undef USE_PCTHREADS_PTHREADS - -/* Define if using any sort of threads. */ -#undef USE_THREADS - -/* Define if you want support for dynamic linking. */ -#undef DYNAMIC_LINKING - -/* Define if symbol tables on this system use leading underscores. */ -#undef USCORE - -/* Define if dlsym automatically supplies a leading underscore. */ -#undef DLSYM_ADDS_USCORE - -/* Define if the operating system can restart system calls. */ -#undef HAVE_RESTARTS - -/* Define if the system supports Unix-domain (file-domain) sockets. */ -#undef HAVE_UNIX_DOMAIN_SOCKETS - -/* This is included as part of a workaround for a autoheader bug. */ -#undef HAVE_REGCOMP - -/* Define if the operating system supplies bzero without declaring it. */ -#undef MISSING_BZERO_DECL - -/* Define if the operating system supplies strptime without declaring it. */ -#undef MISSING_STRPTIME_DECL - -/* Define if the operating system supplies sleep without declaring it. */ -#undef MISSING_SLEEP_DECL - -/* Define if the operating system supplies usleep without declaring it. */ -#undef MISSING_USLEEP_DECL - -/* Define if the system headers declare usleep to return void. */ -#undef USLEEP_RETURNS_VOID - -/* Define if your readline library has the rl_getc_function variable. */ -#undef HAVE_RL_GETC_FUNCTION diff --git a/acinclude.m4 b/acinclude.m4 deleted file mode 100644 index dfa1a6260..000000000 --- a/acinclude.m4 +++ /dev/null @@ -1,143 +0,0 @@ -dnl On the NeXT, #including <utime.h> doesn't give you a definition for -dnl struct utime, unless you #define _POSIX_SOURCE. - -AC_DEFUN(GUILE_STRUCT_UTIMBUF, [ - AC_CACHE_CHECK([whether we need POSIX to get struct utimbuf], - guile_cv_struct_utimbuf_needs_posix, - [AC_TRY_CPP([ -#ifdef __EMX__ -#include <sys/utime.h> -#else -#include <utime.h> -#endif -struct utime blah; -], - guile_cv_struct_utimbuf_needs_posix=no, - guile_cv_struct_utimbuf_needs_posix=yes)]) - if test "$guile_cv_struct_utimbuf_needs_posix" = yes; then - AC_DEFINE(UTIMBUF_NEEDS_POSIX) - fi]) - - - - -dnl -dnl Apparently, at CMU they have a weird version of libc.h that is -dnl installed in /usr/local/include and conflicts with unistd.h. -dnl In these situations, we should not #include libc.h. -dnl This test arranges to #define LIBC_H_WITH_UNISTD_H iff libc.h is -dnl present on the system, and is safe to #include. -dnl -AC_DEFUN([GUILE_HEADER_LIBC_WITH_UNISTD], - [ - AC_CHECK_HEADERS(libc.h unistd.h) - AC_CACHE_CHECK( - "whether libc.h and unistd.h can be included together", - guile_cv_header_libc_with_unistd, - [ - if test "$ac_cv_header_libc_h" = "no"; then - guile_cv_header_libc_with_unistd="no" - elif test "$ac_cv_header_unistd.h" = "no"; then - guile_cv_header_libc_with_unistd="yes" - else - AC_TRY_COMPILE( - [ -# include <libc.h> -# include <unistd.h> - ], - [], - [guile_cv_header_libc_with_unistd=yes], - [guile_cv_header_libc_with_unistd=no] - ) - fi - ] - ) - if test "$guile_cv_header_libc_with_unistd" = yes; then - AC_DEFINE(LIBC_H_WITH_UNISTD_H) - fi - ] -) - - - -dnl This is needed when we want to check for the same function repeatedly -dnl with other parameters, such as libraries, varying. -dnl -dnl GUILE_NAMED_CHECK_FUNC(FUNCTION, TESTNAME, -dnl [ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]]) -AC_DEFUN(GUILE_NAMED_CHECK_FUNC, -[AC_MSG_CHECKING([for $1]) -AC_CACHE_VAL(ac_cv_func_$1_$2, -[AC_TRY_LINK( -dnl Don't include <ctype.h> because on OSF/1 3.0 it includes <sys/types.h> -dnl which includes <sys/select.h> which contains a prototype for -dnl select. Similarly for bzero. -[/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $1(); below. */ -#include <assert.h> -/* Override any gcc2 internal prototype to avoid an error. */ -]ifelse(AC_LANG, CPLUSPLUS, [#ifdef __cplusplus -extern "C" -#endif -])dnl -[/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $1(); -], [ -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$1) || defined (__stub___$1) -choke me -#else -$1(); -#endif -], eval "ac_cv_func_$1_$2=yes", eval "ac_cv_func_$1_$2=no")]) -if eval "test \"`echo '$ac_cv_func_'$1'_'$2`\" = yes"; then - AC_MSG_RESULT(yes) - ifelse([$3], , :, [$3]) -else - AC_MSG_RESULT(no) -ifelse([$4], , , [$4 -])dnl -fi -]) - - - -dnl Check checks whether dlsym (if present) requires a leading underscore. -dnl Written by Dan Hagerty <hag@ai.mit.edu> for scsh-0.5.0. -AC_DEFUN(GUILE_DLSYM_USCORE, [ - AC_MSG_CHECKING(for underscore before symbols) - AC_CACHE_VAL(guile_cv_uscore,[ - echo "main(){int i=1;} - fnord(){int i=23; int ltuae=42;}" > conftest.c - ${CC} conftest.c > /dev/null - if (nm a.out | grep _fnord) > /dev/null; then - guile_cv_uscore=yes - else - guile_cv_uscore=no - fi]) - AC_MSG_RESULT($guile_cv_uscore) - rm -f conftest.c a.out - - if test $guile_cv_uscore = yes; then - AC_DEFINE(USCORE) - - if test $ac_cv_func_dlopen = yes -o $ac_cv_lib_dl_dlopen = yes ; then - AC_MSG_CHECKING(whether dlsym always adds an underscore for us) - AC_CACHE_VAL(guile_cv_dlsym_adds_uscore,AC_TRY_RUN( [ -#include <dlfcn.h> -#include <stdio.h> -fnord() { int i=42;} -main() { void *self, *ptr1, *ptr2; self=dlopen(NULL,RTLD_LAZY); - if(self) { ptr1=dlsym(self,"fnord"); ptr2=dlsym(self,"_fnord"); - if(ptr1 && !ptr2) exit(0); } exit(1); } -], [guile_cv_dlsym_adds_uscore=yes - AC_DEFINE(DLSYM_ADDS_USCORE) ], guile_cv_dlsym_adds_uscore=no, - guile_cv_dlsym_adds_uscore=no)) - - AC_MSG_RESULT($guile_cv_dlsym_adds_uscore) - fi - fi -]) diff --git a/aclocal.m4 b/aclocal.m4 deleted file mode 100644 index e96cd4e63..000000000 --- a/aclocal.m4 +++ /dev/null @@ -1,667 +0,0 @@ -dnl aclocal.m4 generated automatically by aclocal 1.3 - -dnl Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc. -dnl This Makefile.in 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 This program is distributed in the hope that it will be useful, -dnl but WITHOUT ANY WARRANTY, to the extent permitted by law; without -dnl even the implied warranty of MERCHANTABILITY or FITNESS FOR A -dnl PARTICULAR PURPOSE. - -dnl On the NeXT, #including <utime.h> doesn't give you a definition for -dnl struct utime, unless you #define _POSIX_SOURCE. - -AC_DEFUN(GUILE_STRUCT_UTIMBUF, [ - AC_CACHE_CHECK([whether we need POSIX to get struct utimbuf], - guile_cv_struct_utimbuf_needs_posix, - [AC_TRY_CPP([ -#ifdef __EMX__ -#include <sys/utime.h> -#else -#include <utime.h> -#endif -struct utime blah; -], - guile_cv_struct_utimbuf_needs_posix=no, - guile_cv_struct_utimbuf_needs_posix=yes)]) - if test "$guile_cv_struct_utimbuf_needs_posix" = yes; then - AC_DEFINE(UTIMBUF_NEEDS_POSIX) - fi]) - - - - -dnl -dnl Apparently, at CMU they have a weird version of libc.h that is -dnl installed in /usr/local/include and conflicts with unistd.h. -dnl In these situations, we should not #include libc.h. -dnl This test arranges to #define LIBC_H_WITH_UNISTD_H iff libc.h is -dnl present on the system, and is safe to #include. -dnl -AC_DEFUN([GUILE_HEADER_LIBC_WITH_UNISTD], - [ - AC_CHECK_HEADERS(libc.h unistd.h) - AC_CACHE_CHECK( - "whether libc.h and unistd.h can be included together", - guile_cv_header_libc_with_unistd, - [ - if test "$ac_cv_header_libc_h" = "no"; then - guile_cv_header_libc_with_unistd="no" - elif test "$ac_cv_header_unistd.h" = "no"; then - guile_cv_header_libc_with_unistd="yes" - else - AC_TRY_COMPILE( - [ -# include <libc.h> -# include <unistd.h> - ], - [], - [guile_cv_header_libc_with_unistd=yes], - [guile_cv_header_libc_with_unistd=no] - ) - fi - ] - ) - if test "$guile_cv_header_libc_with_unistd" = yes; then - AC_DEFINE(LIBC_H_WITH_UNISTD_H) - fi - ] -) - - - -dnl This is needed when we want to check for the same function repeatedly -dnl with other parameters, such as libraries, varying. -dnl -dnl GUILE_NAMED_CHECK_FUNC(FUNCTION, TESTNAME, -dnl [ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]]) -AC_DEFUN(GUILE_NAMED_CHECK_FUNC, -[AC_MSG_CHECKING([for $1]) -AC_CACHE_VAL(ac_cv_func_$1_$2, -[AC_TRY_LINK( -dnl Don't include <ctype.h> because on OSF/1 3.0 it includes <sys/types.h> -dnl which includes <sys/select.h> which contains a prototype for -dnl select. Similarly for bzero. -[/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $1(); below. */ -#include <assert.h> -/* Override any gcc2 internal prototype to avoid an error. */ -]ifelse(AC_LANG, CPLUSPLUS, [#ifdef __cplusplus -extern "C" -#endif -])dnl -[/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $1(); -], [ -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$1) || defined (__stub___$1) -choke me -#else -$1(); -#endif -], eval "ac_cv_func_$1_$2=yes", eval "ac_cv_func_$1_$2=no")]) -if eval "test \"`echo '$ac_cv_func_'$1'_'$2`\" = yes"; then - AC_MSG_RESULT(yes) - ifelse([$3], , :, [$3]) -else - AC_MSG_RESULT(no) -ifelse([$4], , , [$4 -])dnl -fi -]) - - - -dnl Check checks whether dlsym (if present) requires a leading underscore. -dnl Written by Dan Hagerty <hag@ai.mit.edu> for scsh-0.5.0. -AC_DEFUN(GUILE_DLSYM_USCORE, [ - AC_MSG_CHECKING(for underscore before symbols) - AC_CACHE_VAL(guile_cv_uscore,[ - echo "main(){int i=1;} - fnord(){int i=23; int ltuae=42;}" > conftest.c - ${CC} conftest.c > /dev/null - if (nm a.out | grep _fnord) > /dev/null; then - guile_cv_uscore=yes - else - guile_cv_uscore=no - fi]) - AC_MSG_RESULT($guile_cv_uscore) - rm -f conftest.c a.out - - if test $guile_cv_uscore = yes; then - AC_DEFINE(USCORE) - - if test $ac_cv_func_dlopen = yes -o $ac_cv_lib_dl_dlopen = yes ; then - AC_MSG_CHECKING(whether dlsym always adds an underscore for us) - AC_CACHE_VAL(guile_cv_dlsym_adds_uscore,AC_TRY_RUN( [ -#include <dlfcn.h> -#include <stdio.h> -fnord() { int i=42;} -main() { void *self, *ptr1, *ptr2; self=dlopen(NULL,RTLD_LAZY); - if(self) { ptr1=dlsym(self,"fnord"); ptr2=dlsym(self,"_fnord"); - if(ptr1 && !ptr2) exit(0); } exit(1); } -], [guile_cv_dlsym_adds_uscore=yes - AC_DEFINE(DLSYM_ADDS_USCORE) ], guile_cv_dlsym_adds_uscore=no, - guile_cv_dlsym_adds_uscore=no)) - - AC_MSG_RESULT($guile_cv_dlsym_adds_uscore) - fi - fi -]) - -# Do all the work for Automake. This macro actually does too much -- -# some checks are only needed if your package does certain things. -# But this isn't really a big deal. - -# serial 1 - -dnl Usage: -dnl AM_INIT_AUTOMAKE(package,version, [no-define]) - -AC_DEFUN(AM_INIT_AUTOMAKE, -[AC_REQUIRE([AM_PROG_INSTALL]) -PACKAGE=[$1] -AC_SUBST(PACKAGE) -VERSION=[$2] -AC_SUBST(VERSION) -dnl test to see if srcdir already configured -if test "`cd $srcdir && pwd`" != "`pwd`" && test -f $srcdir/config.status; then - AC_MSG_ERROR([source directory already configured; run "make distclean" there first]) -fi -ifelse([$3],, -AC_DEFINE_UNQUOTED(PACKAGE, "$PACKAGE") -AC_DEFINE_UNQUOTED(VERSION, "$VERSION")) -AC_REQUIRE([AM_SANITY_CHECK]) -AC_REQUIRE([AC_ARG_PROGRAM]) -dnl FIXME This is truly gross. -missing_dir=`cd $ac_aux_dir && pwd` -AM_MISSING_PROG(ACLOCAL, aclocal, $missing_dir) -AM_MISSING_PROG(AUTOCONF, autoconf, $missing_dir) -AM_MISSING_PROG(AUTOMAKE, automake, $missing_dir) -AM_MISSING_PROG(AUTOHEADER, autoheader, $missing_dir) -AM_MISSING_PROG(MAKEINFO, makeinfo, $missing_dir) -AC_REQUIRE([AC_PROG_MAKE_SET])]) - - -# serial 1 - -AC_DEFUN(AM_PROG_INSTALL, -[AC_REQUIRE([AC_PROG_INSTALL]) -test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}' -AC_SUBST(INSTALL_SCRIPT)dnl -]) - -# -# Check to make sure that the build environment is sane. -# - -AC_DEFUN(AM_SANITY_CHECK, -[AC_MSG_CHECKING([whether build environment is sane]) -# Just in case -sleep 1 -echo timestamp > conftestfile -# Do `set' in a subshell so we don't clobber the current shell's -# arguments. Must try -L first in case configure is actually a -# symlink; some systems play weird games with the mod time of symlinks -# (eg FreeBSD returns the mod time of the symlink's containing -# directory). -if ( - set X `ls -Lt $srcdir/configure conftestfile 2> /dev/null` - if test "[$]*" = "X"; then - # -L didn't work. - set X `ls -t $srcdir/configure conftestfile` - fi - if test "[$]*" != "X $srcdir/configure conftestfile" \ - && test "[$]*" != "X conftestfile $srcdir/configure"; then - - # If neither matched, then we have a broken ls. This can happen - # if, for instance, CONFIG_SHELL is bash and it inherits a - # broken ls alias from the environment. This has actually - # happened. Such a system could not be considered "sane". - AC_MSG_ERROR([ls -t appears to fail. Make sure there is not a broken -alias in your environment]) - fi - - test "[$]2" = conftestfile - ) -then - # Ok. - : -else - AC_MSG_ERROR([newly created file is older than distributed files! -Check your system clock]) -fi -rm -f conftest* -AC_MSG_RESULT(yes)]) - -dnl AM_MISSING_PROG(NAME, PROGRAM, DIRECTORY) -dnl The program must properly implement --version. -AC_DEFUN(AM_MISSING_PROG, -[AC_MSG_CHECKING(for working $2) -# Run test in a subshell; some versions of sh will print an error if -# an executable is not found, even if stderr is redirected. -# Redirect stdin to placate older versions of autoconf. Sigh. -if ($2 --version) < /dev/null > /dev/null 2>&1; then - $1=$2 - AC_MSG_RESULT(found) -else - $1="$3/missing $2" - AC_MSG_RESULT(missing) -fi -AC_SUBST($1)]) - -# Add --enable-maintainer-mode option to configure. -# From Jim Meyering - -# serial 1 - -AC_DEFUN(AM_MAINTAINER_MODE, -[AC_MSG_CHECKING([whether to enable maintainer-specific portions of Makefiles]) - dnl maintainer-mode is disabled by default - AC_ARG_ENABLE(maintainer-mode, -[ --enable-maintainer-mode enable make rules and dependencies not useful - (and sometimes confusing) to the casual installer], - USE_MAINTAINER_MODE=$enableval, - USE_MAINTAINER_MODE=no) - AC_MSG_RESULT($USE_MAINTAINER_MODE) - if test $USE_MAINTAINER_MODE = yes; then - MAINT= - else - MAINT='#M#' - fi - AC_SUBST(MAINT)dnl -] -) - -# Like AC_CONFIG_HEADER, but automatically create stamp file. - -AC_DEFUN(AM_CONFIG_HEADER, -[AC_PREREQ([2.12]) -AC_CONFIG_HEADER([$1]) -dnl When config.status generates a header, we must update the stamp-h file. -dnl This file resides in the same directory as the config header -dnl that is generated. We must strip everything past the first ":", -dnl and everything past the last "/". -AC_OUTPUT_COMMANDS(changequote(<<,>>)dnl -ifelse(patsubst(<<$1>>, <<[^ ]>>, <<>>), <<>>, -<<test -z "<<$>>CONFIG_HEADERS" || echo timestamp > patsubst(<<$1>>, <<^\([^:]*/\)?.*>>, <<\1>>)stamp-h<<>>dnl>>, -<<am_indx=1 -for am_file in <<$1>>; do - case " <<$>>CONFIG_HEADERS " in - *" <<$>>am_file "*<<)>> - echo timestamp > `echo <<$>>am_file | sed -e 's%:.*%%' -e 's%[^/]*$%%'`stamp-h$am_indx - ;; - esac - am_indx=`expr "<<$>>am_indx" + 1` -done<<>>dnl>>) -changequote([,]))]) - - -# serial 24 AM_PROG_LIBTOOL -AC_DEFUN(AM_PROG_LIBTOOL, -[AC_REQUIRE([AM_ENABLE_SHARED])dnl -AC_REQUIRE([AM_ENABLE_STATIC])dnl -AC_REQUIRE([AC_CANONICAL_HOST])dnl -AC_REQUIRE([AC_PROG_RANLIB])dnl -AC_REQUIRE([AC_PROG_CC])dnl -AC_REQUIRE([AM_PROG_LD])dnl -AC_REQUIRE([AM_PROG_NM])dnl -AC_REQUIRE([AC_PROG_LN_S])dnl -dnl -# Always use our own libtool. -LIBTOOL='$(SHELL) $(top_builddir)/libtool' -AC_SUBST(LIBTOOL)dnl - -# Check for any special flags to pass to ltconfig. -libtool_flags= -test "$enable_shared" = no && libtool_flags="$libtool_flags --disable-shared" -test "$enable_static" = no && libtool_flags="$libtool_flags --disable-static" -test "$silent" = yes && libtool_flags="$libtool_flags --silent" -test "$ac_cv_prog_gcc" = yes && libtool_flags="$libtool_flags --with-gcc" -test "$ac_cv_prog_gnu_ld" = yes && libtool_flags="$libtool_flags --with-gnu-ld" - -# Some flags need to be propagated to the compiler or linker for good -# libtool support. -case "$host" in -*-*-irix6*) - # Find out which ABI we are using. - echo '[#]line __oline__ "configure"' > conftest.$ac_ext - if AC_TRY_EVAL(ac_compile); then - case "`/usr/bin/file conftest.o`" in - *32-bit*) - LD="${LD-ld} -32" - ;; - *N32*) - LD="${LD-ld} -n32" - ;; - *64-bit*) - LD="${LD-ld} -64" - ;; - esac - fi - rm -rf conftest* - ;; - -*-*-sco3.2v5*) - # On SCO OpenServer 5, we need -belf to get full-featured binaries. - CFLAGS="$CFLAGS -belf" - ;; -esac - -# Actually configure libtool. ac_aux_dir is where install-sh is found. -CC="$CC" CFLAGS="$CFLAGS" CPPFLAGS="$CPPFLAGS" \ -LD="$LD" NM="$NM" RANLIB="$RANLIB" LN_S="$LN_S" \ -${CONFIG_SHELL-/bin/sh} $ac_aux_dir/ltconfig \ -$libtool_flags --no-verify $ac_aux_dir/ltmain.sh $host \ -|| AC_MSG_ERROR([libtool configure failed]) -]) - -# AM_ENABLE_SHARED - implement the --enable-shared flag -# Usage: AM_ENABLE_SHARED[(DEFAULT)] -# Where DEFAULT is either `yes' or `no'. If omitted, it defaults to -# `yes'. -AC_DEFUN(AM_ENABLE_SHARED, -[define([AM_ENABLE_SHARED_DEFAULT], ifelse($1, no, no, yes))dnl -AC_ARG_ENABLE(shared, -changequote(<<, >>)dnl -<< --enable-shared build shared libraries [default=>>AM_ENABLE_SHARED_DEFAULT] -changequote([, ])dnl -[ --enable-shared=PKGS only build shared libraries if the current package - appears as an element in the PKGS list], -[p=${PACKAGE-default} -case "$enableval" in -yes) enable_shared=yes ;; -no) enable_shared=no ;; -*) - enable_shared=no - # Look at the argument we got. We use all the common list separators. - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:," - for pkg in $enableval; do - if test "X$pkg" = "X$p"; then - enable_shared=yes - fi - done - IFS="$ac_save_ifs" - ;; -esac], -enable_shared=AM_ENABLE_SHARED_DEFAULT)dnl -]) - -# AM_DISABLE_SHARED - set the default shared flag to --disable-shared -AC_DEFUN(AM_DISABLE_SHARED, -[AM_ENABLE_SHARED(no)]) - -# AM_DISABLE_STATIC - set the default static flag to --disable-static -AC_DEFUN(AM_DISABLE_STATIC, -[AM_ENABLE_STATIC(no)]) - -# AM_ENABLE_STATIC - implement the --enable-static flag -# Usage: AM_ENABLE_STATIC[(DEFAULT)] -# Where DEFAULT is either `yes' or `no'. If omitted, it defaults to -# `yes'. -AC_DEFUN(AM_ENABLE_STATIC, -[define([AM_ENABLE_STATIC_DEFAULT], ifelse($1, no, no, yes))dnl -AC_ARG_ENABLE(static, -changequote(<<, >>)dnl -<< --enable-static build static libraries [default=>>AM_ENABLE_STATIC_DEFAULT] -changequote([, ])dnl -[ --enable-static=PKGS only build shared libraries if the current package - appears as an element in the PKGS list], -[p=${PACKAGE-default} -case "$enableval" in -yes) enable_static=yes ;; -no) enable_static=no ;; -*) - enable_static=no - # Look at the argument we got. We use all the common list separators. - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:," - for pkg in $enableval; do - if test "X$pkg" = "X$p"; then - enable_static=yes - fi - done - IFS="$ac_save_ifs" - ;; -esac], -enable_static=AM_ENABLE_STATIC_DEFAULT)dnl -]) - - -# AM_PROG_LD - find the path to the GNU or non-GNU linker -AC_DEFUN(AM_PROG_LD, -[AC_ARG_WITH(gnu-ld, -[ --with-gnu-ld assume the C compiler uses GNU ld [default=no]], -test "$withval" = no || with_gnu_ld=yes, with_gnu_ld=no) -AC_REQUIRE([AC_PROG_CC]) -ac_prog=ld -if test "$ac_cv_prog_gcc" = yes; then - # Check if gcc -print-prog-name=ld gives a path. - AC_MSG_CHECKING([for ld used by GCC]) - ac_prog=`($CC -print-prog-name=ld) 2>&5` - case "$ac_prog" in - # Accept absolute paths. - /* | [A-Za-z]:\\*) - test -z "$LD" && LD="$ac_prog" - ;; - "") - # If it fails, then pretend we aren't using GCC. - ac_prog=ld - ;; - *) - # If it is relative, then search for the first ld in PATH. - with_gnu_ld=unknown - ;; - esac -elif test "$with_gnu_ld" = yes; then - AC_MSG_CHECKING([for GNU ld]) -else - AC_MSG_CHECKING([for non-GNU ld]) -fi -AC_CACHE_VAL(ac_cv_path_LD, -[if test -z "$LD"; then - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" - for ac_dir in $PATH; do - test -z "$ac_dir" && ac_dir=. - if test -f "$ac_dir/$ac_prog"; then - ac_cv_path_LD="$ac_dir/$ac_prog" - # Check to see if the program is GNU ld. I'd rather use --version, - # but apparently some GNU ld's only accept -v. - # Break only if it was the GNU/non-GNU ld that we prefer. - if "$ac_cv_path_LD" -v 2>&1 < /dev/null | egrep '(GNU|with BFD)' > /dev/null; then - test "$with_gnu_ld" != no && break - else - test "$with_gnu_ld" != yes && break - fi - fi - done - IFS="$ac_save_ifs" -else - ac_cv_path_LD="$LD" # Let the user override the test with a path. -fi]) -LD="$ac_cv_path_LD" -if test -n "$LD"; then - AC_MSG_RESULT($LD) -else - AC_MSG_RESULT(no) -fi -test -z "$LD" && AC_MSG_ERROR([no acceptable ld found in \$PATH]) -AC_SUBST(LD) -AM_PROG_LD_GNU -]) - -AC_DEFUN(AM_PROG_LD_GNU, -[AC_CACHE_CHECK([if the linker ($LD) is GNU ld], ac_cv_prog_gnu_ld, -[# I'd rather use --version here, but apparently some GNU ld's only accept -v. -if $LD -v 2>&1 </dev/null | egrep '(GNU|with BFD)' 1>&5; then - ac_cv_prog_gnu_ld=yes -else - ac_cv_prog_gnu_ld=no -fi]) -]) - -# AM_PROG_NM - find the path to a BSD-compatible name lister -AC_DEFUN(AM_PROG_NM, -[AC_MSG_CHECKING([for BSD-compatible nm]) -AC_CACHE_VAL(ac_cv_path_NM, -[case "$NM" in -/* | [A-Za-z]:\\*) - ac_cv_path_NM="$NM" # Let the user override the test with a path. - ;; -*) - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" - for ac_dir in /usr/ucb /usr/ccs/bin $PATH /bin; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/nm; then - # Check to see if the nm accepts a BSD-compat flag. - # Adding the `sed 1q' prevents false positives on HP-UX, which says: - # nm: unknown option "B" ignored - if ($ac_dir/nm -B /dev/null 2>&1 | sed '1q'; exit 0) | egrep /dev/null >/dev/null; then - ac_cv_path_NM="$ac_dir/nm -B" - elif ($ac_dir/nm -p /dev/null 2>&1 | sed '1q'; exit 0) | egrep /dev/null >/dev/null; then - ac_cv_path_NM="$ac_dir/nm -p" - else - ac_cv_path_NM="$ac_dir/nm" - fi - break - fi - done - IFS="$ac_save_ifs" - test -z "$ac_cv_path_NM" && ac_cv_path_NM=nm - ;; -esac]) -NM="$ac_cv_path_NM" -AC_MSG_RESULT([$NM]) -AC_SUBST(NM) -]) - -dnl Autoconf macros for configuring the QuickThreads package - -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 --- the name of the machine-dependent header file. -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_CPPFLAGS --- set to `-I' flags for thread header files -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, qtmdc_lo 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) - # How can we refer to the qt source directory from within the qt build - # directory? For headers, we can rely on the fact that the qt src - # directory appears in the #include path. - qtsrcdir="`(cd $srcdir; pwd)`/qt" - - changequote(,)dnl We use [ and ] in a regexp in the case - - THREAD_PACKAGE=QT - 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= - ;; - 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 - ;; - *) - 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_CPPFLAGS="-I$qtsrcdir -I../qt" - 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(THREAD_PACKAGE) - AC_SUBST(THREAD_CPPFLAGS) - AC_SUBST(THREAD_LIBS_LOCAL) - AC_SUBST(THREAD_LIBS_INSTALLED) -]) - diff --git a/config.guess b/config.guess deleted file mode 100755 index 413ed41c0..000000000 --- a/config.guess +++ /dev/null @@ -1,883 +0,0 @@ -#! /bin/sh -# Attempt to guess a canonical system name. -# Copyright (C) 1992, 93, 94, 95, 96, 1997 Free Software Foundation, Inc. -# -# 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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. - -# Written by Per Bothner <bothner@cygnus.com>. -# The master version of this file is at the FSF in /home/gd/gnu/lib. -# -# 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 system type (host/target name). -# -# Only a few systems have been added to this list; please add others -# (but try to keep the structure clean). -# - -# This is needed to find uname on a Pyramid OSx when run in the BSD universe. -# (ghazi@noc.rutgers.edu 8/24/94.) -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 - -trap 'rm -f dummy.c dummy.o dummy; exit 1' 1 2 15 - -# Note: order is significant - the case branches are not exclusive. - -case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in - alpha:OSF1:*:*) - if test $UNAME_RELEASE = "V4.0"; then - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` - fi - # 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. - cat <<EOF >dummy.s - .globl main - .ent main -main: - .frame \$30,0,\$26,0 - .prologue 0 - .long 0x47e03d80 # implver $0 - lda \$2,259 - .long 0x47e20c21 # amask $2,$1 - srl \$1,8,\$2 - sll \$2,2,\$2 - sll \$0,3,\$0 - addl \$1,\$0,\$0 - addl \$2,\$0,\$0 - ret \$31,(\$26),1 - .end main -EOF - ${CC-cc} dummy.s -o dummy 2>/dev/null - if test "$?" = 0 ; then - ./dummy - case "$?" in - 7) - UNAME_MACHINE="alpha" - ;; - 15) - UNAME_MACHINE="alphaev5" - ;; - 14) - UNAME_MACHINE="alphaev56" - ;; - 10) - UNAME_MACHINE="alphapca56" - ;; - 16) - UNAME_MACHINE="alphaev6" - ;; - esac - fi - rm -f dummy.s dummy - echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//' | tr [[A-Z]] [[a-z]]` - exit 0 ;; - 21064:Windows_NT:50:3) - echo alpha-dec-winnt3.5 - exit 0 ;; - Amiga*:UNIX_System_V:4.0:*) - echo m68k-cbm-sysv4 - exit 0;; - amiga:NetBSD:*:*) - echo m68k-cbm-netbsd${UNAME_RELEASE} - exit 0 ;; - amiga:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - arc64:OpenBSD:*:*) - echo mips64el-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - arc:OpenBSD:*:*) - echo mipsel-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - hkmips:OpenBSD:*:*) - echo mips-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - pmax:OpenBSD:*:*) - echo mipsel-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - sgi:OpenBSD:*:*) - echo mips-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - wgrisc:OpenBSD:*:*) - echo mipsel-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) - echo arm-acorn-riscix${UNAME_RELEASE} - exit 0;; - arm32:NetBSD:*:*) - echo arm-unknown-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` - exit 0 ;; - SR2?01:HI-UX/MPP:*:*) - echo hppa1.1-hitachi-hiuxmpp - exit 0;; - Pyramid*:OSx*:*:*|MIS*: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 0 ;; - NILE:*:*:dcosx) - echo pyramid-pyramid-svr4 - exit 0 ;; - sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) - echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit 0 ;; - i86pc:SunOS:5.*:*) - echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit 0 ;; - 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 0 ;; - 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 0 ;; - sun3*:SunOS:*:*) - echo m68k-sun-sunos${UNAME_RELEASE} - exit 0 ;; - sun*:*:4.2BSD:*) - UNAME_RELEASE=`(head -1 /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 0 ;; - aushp:SunOS:*:*) - echo sparc-auspex-sunos${UNAME_RELEASE} - exit 0 ;; - atari*:NetBSD:*:*) - echo m68k-atari-netbsd${UNAME_RELEASE} - exit 0 ;; - atari*:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - sun3*:NetBSD:*:*) - echo m68k-sun-netbsd${UNAME_RELEASE} - exit 0 ;; - sun3*:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - mac68k:NetBSD:*:*) - echo m68k-apple-netbsd${UNAME_RELEASE} - exit 0 ;; - mac68k:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - mvme68k:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - mvme88k:OpenBSD:*:*) - echo m88k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - powerpc:machten:*:*) - echo powerpc-apple-machten${UNAME_RELEASE} - exit 0 ;; - RISC*:Mach:*:*) - echo mips-dec-mach_bsd4.3 - exit 0 ;; - RISC*:ULTRIX:*:*) - echo mips-dec-ultrix${UNAME_RELEASE} - exit 0 ;; - VAX*:ULTRIX*:*:*) - echo vax-dec-ultrix${UNAME_RELEASE} - exit 0 ;; - 2020:CLIX:*:*) - echo clipper-intergraph-clix${UNAME_RELEASE} - exit 0 ;; - mips:*:*:UMIPS | mips:*:*:RISCos) - sed 's/^ //' << EOF >dummy.c - int main (argc, argv) int argc; char **argv; { - #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-cc} dummy.c -o dummy \ - && ./dummy `echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` \ - && rm dummy.c dummy && exit 0 - rm -f dummy.c dummy - echo mips-mips-riscos${UNAME_RELEASE} - exit 0 ;; - Night_Hawk:Power_UNIX:*:*) - echo powerpc-harris-powerunix - exit 0 ;; - m88k:CX/UX:7*:*) - echo m88k-harris-cxux7 - exit 0 ;; - m88k:*:4*:R4*) - echo m88k-motorola-sysv4 - exit 0 ;; - m88k:*:3*:R3*) - echo m88k-motorola-sysv3 - exit 0 ;; - AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` - if [ $UNAME_PROCESSOR = mc88100 -o $UNAME_PROCESSOR = mc88110 ] ; then - if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx \ - -o ${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 0 ;; - M88*:DolphinOS:*:*) # DolphinOS (SVR3) - echo m88k-dolphin-sysv3 - exit 0 ;; - M88*:*:R3*:*) - # Delta 88k system running SVR3 - echo m88k-motorola-sysv3 - exit 0 ;; - XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) - echo m88k-tektronix-sysv3 - exit 0 ;; - Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) - echo m68k-tektronix-bsd - exit 0 ;; - *:IRIX*:*:*) - echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` - exit 0 ;; - ????????: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 0 ;; # Note that: echo "'`uname -s`'" gives 'AIX ' - i?86:AIX:*:*) - echo i386-ibm-aix - exit 0 ;; - *:AIX:2:3) - if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then - sed 's/^ //' << EOF >dummy.c - #include <sys/systemcfg.h> - - main() - { - if (!__power_pc()) - exit(1); - puts("powerpc-ibm-aix3.2.5"); - exit(0); - } -EOF - ${CC-cc} dummy.c -o dummy && ./dummy && rm dummy.c dummy && exit 0 - rm -f dummy.c dummy - echo rs6000-ibm-aix3.2.5 - 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 0 ;; - *:AIX:*:4) - if /usr/sbin/lsattr -EHl proc0 | 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=4.${UNAME_RELEASE} - fi - echo ${IBM_ARCH}-ibm-aix${IBM_REV} - exit 0 ;; - *:AIX:*:*) - echo rs6000-ibm-aix - exit 0 ;; - ibmrt:4.4BSD:*|romp-ibm:BSD:*) - echo romp-ibm-bsd4.4 - exit 0 ;; - ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC NetBSD and - echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to - exit 0 ;; # report: romp-ibm BSD 4.3 - *:BOSX:*:*) - echo rs6000-bull-bosx - exit 0 ;; - DPX/2?00:B.O.S.:*:*) - echo m68k-bull-sysv3 - exit 0 ;; - 9000/[34]??:4.3bsd:1.*:*) - echo m68k-hp-bsd - exit 0 ;; - hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) - echo m68k-hp-bsd4.4 - exit 0 ;; - 9000/[3478]??:HP-UX:*:*) - case "${UNAME_MACHINE}" in - 9000/31? ) HP_ARCH=m68000 ;; - 9000/[34]?? ) HP_ARCH=m68k ;; - 9000/7?? | 9000/8?[1679] ) HP_ARCH=hppa1.1 ;; - 9000/8?? ) HP_ARCH=hppa1.0 ;; - esac - HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` - echo ${HP_ARCH}-hp-hpux${HPUX_REV} - exit 0 ;; - 3050*:HI-UX:*:*) - 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-cc} dummy.c -o dummy && ./dummy && rm dummy.c dummy && exit 0 - rm -f dummy.c dummy - echo unknown-hitachi-hiuxwe2 - exit 0 ;; - 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) - echo hppa1.1-hp-bsd - exit 0 ;; - 9000/8??:4.3bsd:*:*) - echo hppa1.0-hp-bsd - exit 0 ;; - hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) - echo hppa1.1-hp-osf - exit 0 ;; - hp8??:OSF1:*:*) - echo hppa1.0-hp-osf - exit 0 ;; - i?86:OSF1:*:*) - if [ -x /usr/sbin/sysversion ] ; then - echo ${UNAME_MACHINE}-unknown-osf1mk - else - echo ${UNAME_MACHINE}-unknown-osf1 - fi - exit 0 ;; - parisc*:Lites*:*:*) - echo hppa1.1-hp-lites - exit 0 ;; - C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) - echo c1-convex-bsd - exit 0 ;; - C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) - if getsysinfo -f scalar_acc - then echo c32-convex-bsd - else echo c2-convex-bsd - fi - exit 0 ;; - C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) - echo c34-convex-bsd - exit 0 ;; - C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) - echo c38-convex-bsd - exit 0 ;; - C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) - echo c4-convex-bsd - exit 0 ;; - CRAY*X-MP:*:*:*) - echo xmp-cray-unicos - exit 0 ;; - CRAY*Y-MP:*:*:*) - echo ymp-cray-unicos${UNAME_RELEASE} - exit 0 ;; - CRAY*[A-Z]90:*:*:*) - echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ - | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ - -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ - exit 0 ;; - CRAY*TS:*:*:*) - echo t90-cray-unicos${UNAME_RELEASE} - exit 0 ;; - CRAY-2:*:*:*) - echo cray2-cray-unicos - exit 0 ;; - F300:UNIX_System_V:*:*) - FUJITSU_SYS=`uname -p | tr [A-Z] [a-z] | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "f300-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit 0 ;; - F301:UNIX_System_V:*:*) - echo f301-fujitsu-uxpv`echo $UNAME_RELEASE | sed 's/ .*//'` - exit 0 ;; - hp3[0-9][05]:NetBSD:*:*) - echo m68k-hp-netbsd${UNAME_RELEASE} - exit 0 ;; - hp300:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - i?86:BSD/386:*:* | *:BSD/OS:*:*) - echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} - exit 0 ;; - *:FreeBSD:*:*) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` - exit 0 ;; - *:NetBSD:*:*) - echo ${UNAME_MACHINE}-unknown-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` - exit 0 ;; - *:OpenBSD:*:*) - echo ${UNAME_MACHINE}-unknown-openbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` - exit 0 ;; - i*:CYGWIN*:*) - echo i386-pc-cygwin32 - exit 0 ;; - i*:MINGW*:*) - echo i386-pc-mingw32 - exit 0 ;; - p*:CYGWIN*:*) - echo powerpcle-unknown-cygwin32 - exit 0 ;; - prep*:SunOS:5.*:*) - echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit 0 ;; - *:GNU:*:*) - echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` - exit 0 ;; - *:Linux:*:*) - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. - ld_help_string=`ld --help 2>&1` - ld_supported_emulations=`echo $ld_help_string \ - | sed -ne '/supported emulations:/!d - s/[ ][ ]*/ /g - s/.*supported emulations: *// - s/ .*// - p'` - case "$ld_supported_emulations" in - i?86linux) echo "${UNAME_MACHINE}-pc-linux-gnuaout" ; exit 0 ;; - i?86coff) echo "${UNAME_MACHINE}-pc-linux-gnucoff" ; exit 0 ;; - sparclinux) echo "${UNAME_MACHINE}-unknown-linux-gnuaout" ; exit 0 ;; - m68klinux) echo "${UNAME_MACHINE}-unknown-linux-gnuaout" ; exit 0 ;; - elf32ppc) echo "powerpc-unknown-linux-gnu" ; exit 0 ;; - esac - - if test "${UNAME_MACHINE}" = "alpha" ; then - sed 's/^ //' <<EOF >dummy.s - .globl main - .ent main - main: - .frame \$30,0,\$26,0 - .prologue 0 - .long 0x47e03d80 # implver $0 - lda \$2,259 - .long 0x47e20c21 # amask $2,$1 - srl \$1,8,\$2 - sll \$2,2,\$2 - sll \$0,3,\$0 - addl \$1,\$0,\$0 - addl \$2,\$0,\$0 - ret \$31,(\$26),1 - .end main -EOF - LIBC="" - ${CC-cc} dummy.s -o dummy 2>/dev/null - if test "$?" = 0 ; then - ./dummy - case "$?" in - 7) - UNAME_MACHINE="alpha" - ;; - 15) - UNAME_MACHINE="alphaev5" - ;; - 14) - UNAME_MACHINE="alphaev56" - ;; - 10) - UNAME_MACHINE="alphapca56" - ;; - 16) - UNAME_MACHINE="alphaev6" - ;; - esac - - objdump --private-headers dummy | \ - grep ld.so.1 > /dev/null - if test "$?" = 0 ; then - LIBC="libc1" - fi - fi - rm -f dummy.s dummy - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} ; exit 0 - elif test "${UNAME_MACHINE}" = "mips" ; then - cat >dummy.c <<EOF -main(argc, argv) - int argc; - char *argv[]; -{ -#ifdef __MIPSEB__ - printf ("%s-unknown-linux-gnu\n", argv[1]); -#endif -#ifdef __MIPSEL__ - printf ("%sel-unknown-linux-gnu\n", argv[1]); -#endif - return 0; -} -EOF - ${CC-cc} dummy.c -o dummy 2>/dev/null && ./dummy "${UNAME_MACHINE}" && rm dummy.c dummy && exit 0 - rm -f dummy.c dummy - else - # Either a pre-BFD a.out linker (linux-gnuoldld) - # or one that does not give us useful --help. - # GCC wants to distinguish between linux-gnuoldld and linux-gnuaout. - # If ld does not provide *any* "supported emulations:" - # that means it is gnuoldld. - echo "$ld_help_string" | grep >/dev/null 2>&1 "supported emulations:" - test $? != 0 && echo "${UNAME_MACHINE}-pc-linux-gnuoldld" && exit 0 - - case "${UNAME_MACHINE}" in - i?86) - VENDOR=pc; - ;; - *) - VENDOR=unknown; - ;; - esac - # Determine whether the default compiler is a.out or elf - cat >dummy.c <<EOF -#include <features.h> -main(argc, argv) - int argc; - char *argv[]; -{ -#ifdef __ELF__ -# ifdef __GLIBC__ -# if __GLIBC__ >= 2 - printf ("%s-${VENDOR}-linux-gnu\n", argv[1]); -# else - printf ("%s-${VENDOR}-linux-gnulibc1\n", argv[1]); -# endif -# else - printf ("%s-${VENDOR}-linux-gnulibc1\n", argv[1]); -# endif -#else - printf ("%s-${VENDOR}-linux-gnuaout\n", argv[1]); -#endif - return 0; -} -EOF - ${CC-cc} dummy.c -o dummy 2>/dev/null && ./dummy "${UNAME_MACHINE}" && rm dummy.c dummy && exit 0 - rm -f dummy.c dummy - fi ;; -# 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. - i?86:DYNIX/ptx:4*:*) - echo i386-sequent-sysv4 - exit 0 ;; - 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 0 ;; - i?86:*:4.*:* | i?86:SYSTEM_V:4.*:*) - if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then - echo ${UNAME_MACHINE}-univel-sysv${UNAME_RELEASE} - else - echo ${UNAME_MACHINE}-pc-sysv${UNAME_RELEASE} - fi - exit 0 ;; - 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|egrep Release|sed -e 's/.*= //')` - (/bin/uname -X|egrep i80486 >/dev/null) && UNAME_MACHINE=i486 - (/bin/uname -X|egrep '^Machine.*Pentium' >/dev/null) \ - && UNAME_MACHINE=i586 - echo ${UNAME_MACHINE}-pc-sco$UNAME_REL - else - echo ${UNAME_MACHINE}-pc-sysv32 - fi - exit 0 ;; - pc:*:*:*) - # 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 0 ;; - Intel:Mach:3*:*) - echo i386-pc-mach3 - exit 0 ;; - paragon:*:*:*) - echo i860-intel-osf1 - exit 0 ;; - 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 0 ;; - mini*:CTIX:SYS*5:*) - # "miniframe" - echo m68010-convergent-sysv - exit 0 ;; - M68*:*:R3V[567]*:*) - test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;; - 3[34]??:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 4850:*: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 0 - /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ - && echo i586-ncr-sysv4.3${OS_REL} && exit 0 ;; - 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && echo i486-ncr-sysv4 && exit 0 ;; - m68*:LynxOS:2.*:*) - echo m68k-unknown-lynxos${UNAME_RELEASE} - exit 0 ;; - mc68030:UNIX_System_V:4.*:*) - echo m68k-atari-sysv4 - exit 0 ;; - i?86:LynxOS:2.*:*) - echo i386-unknown-lynxos${UNAME_RELEASE} - exit 0 ;; - TSUNAMI:LynxOS:2.*:*) - echo sparc-unknown-lynxos${UNAME_RELEASE} - exit 0 ;; - rs6000:LynxOS:2.*:* | PowerPC:LynxOS:2.*:*) - echo rs6000-unknown-lynxos${UNAME_RELEASE} - exit 0 ;; - SM[BE]S:UNIX_SV:*:*) - echo mips-dde-sysv${UNAME_RELEASE} - exit 0 ;; - RM*:SINIX-*:*:*) - echo mips-sni-sysv4 - exit 0 ;; - *: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 0 ;; - PENTIUM:CPunix:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says <Richard.M.Bartel@ccMail.Census.GOV> - echo i586-unisys-sysv4 - exit 0 ;; - *:UNIX_System_V:4*:FTX*) - # From Gerald Hewes <hewes@openmarket.com>. - # How about differentiating between stratus architectures? -djm - echo hppa1.1-stratus-sysv4 - exit 0 ;; - *:*:*:FTX*) - # From seanf@swdc.stratus.com. - echo i860-stratus-sysv4 - exit 0 ;; - mc68*:A/UX:*:*) - echo m68k-apple-aux${UNAME_RELEASE} - exit 0 ;; - news*:NEWS-OS:*:6*) - echo mips-sony-newsos6 - exit 0 ;; - R3000:*System_V*:*:* | R4000:UNIX_SYSV:*:*) - if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} - else - echo mips-unknown-sysv${UNAME_RELEASE} - fi - exit 0 ;; -esac - -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - -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"); 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`; - printf ("%s-next-nextstep%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) - printf ("vax-dec-bsd\n"); exit (0); -#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-cc} dummy.c -o dummy 2>/dev/null && ./dummy && rm dummy.c dummy && exit 0 -rm -f dummy.c dummy - -# Apollos put the system type in the environment. - -test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit 0; } - -# 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 0 ;; - c2*) - if getsysinfo -f scalar_acc - then echo c32-convex-bsd - else echo c2-convex-bsd - fi - exit 0 ;; - c34*) - echo c34-convex-bsd - exit 0 ;; - c38*) - echo c38-convex-bsd - exit 0 ;; - c4*) - echo c4-convex-bsd - exit 0 ;; - esac -fi - -#echo '(Unable to guess system type)' 1>&2 - -exit 1 diff --git a/config.sub b/config.sub deleted file mode 100755 index 213a6d47d..000000000 --- a/config.sub +++ /dev/null @@ -1,954 +0,0 @@ -#! /bin/sh -# Configuration validation subroutine script, version 1.1. -# Copyright (C) 1991, 92, 93, 94, 95, 96, 1997 Free Software Foundation, Inc. -# 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., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, 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. - -# 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. - -if [ x$1 = x ] -then - echo Configuration name missing. 1>&2 - echo "Usage: $0 CPU-MFR-OPSYS" 1>&2 - echo "or $0 ALIAS" 1>&2 - echo where ALIAS is a recognized configuration type. 1>&2 - exit 1 -fi - -# First pass through any local machine types. -case $1 in - *local*) - echo $1 - exit 0 - ;; - *) - ;; -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 - linux-gnu*) - 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) - os= - basic_machine=$1 - ;; - -hiux*) - os=-hiuxwe2 - ;; - -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/'` - ;; - -sco*) - os=-sco3.2v2 - 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 - ;; -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. - tahoe | i860 | m32r | m68k | m68000 | m88k | ns32k | arc | arm \ - | arme[lb] | pyramid | mn10200 | mn10300 \ - | tron | a29k | 580 | i960 | h8300 | hppa | hppa1.0 | hppa1.1 \ - | alpha | alphaev5 | alphaev56 | we32k | ns16k | clipper \ - | i370 | sh | powerpc | powerpcle | 1750a | dsp16xx | pdp11 \ - | mips64 | mipsel | mips64el | mips64orion | mips64orionel \ - | mipstx39 | mipstx39el \ - | sparc | sparclet | sparclite | sparc64 | v850) - basic_machine=$basic_machine-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[3456]86) - 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. - vax-* | tahoe-* | i[3456]86-* | i860-* | m32r-* | m68k-* | m68000-* \ - | m88k-* | sparc-* | ns32k-* | fx80-* | arc-* | arm-* | c[123]* \ - | mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* \ - | power-* | none-* | 580-* | cray2-* | h8300-* | i960-* \ - | xmp-* | ymp-* | hppa-* | hppa1.0-* | hppa1.1-* \ - | alpha-* | alphaev5-* | alphaev56-* | we32k-* | cydra-* \ - | ns16k-* | pn-* | np1-* | xps100-* | clipper-* | orion-* \ - | sparclite-* | pdp11-* | sh-* | powerpc-* | powerpcle-* \ - | sparc64-* | mips64-* | mipsel-* \ - | mips64el-* | mips64orion-* | mips64orionel-* \ - | mipstx39-* | mipstx39el-* \ - | f301-*) - ;; - # Recognize the various machine names and aliases which stand - # for a CPU type and a company and sometimes even an OS. - 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) - basic_machine=m68000-att - ;; - 3b*) - basic_machine=we32k-att - ;; - alliant | fx80) - basic_machine=fx80-alliant - ;; - altos | altos3068) - basic_machine=m68k-altos - ;; - am29k) - basic_machine=a29k-none - os=-bsd - ;; - amdahl) - basic_machine=580-amdahl - os=-sysv - ;; - amiga | amiga-*) - basic_machine=m68k-cbm - ;; - amigaos | amigados) - basic_machine=m68k-cbm - os=-amigaos - ;; - amigaunix | amix) - basic_machine=m68k-cbm - os=-sysv4 - ;; - apollo68) - basic_machine=m68k-apollo - os=-sysv - ;; - aux) - basic_machine=m68k-apple - os=-aux - ;; - balance) - basic_machine=ns32k-sequent - os=-dynix - ;; - 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 | ymp) - basic_machine=ymp-cray - os=-unicos - ;; - cray2) - basic_machine=cray2-cray - os=-unicos - ;; - [ctj]90-cray) - basic_machine=c90-cray - os=-unicos - ;; - crds | unos) - basic_machine=m68k-crds - ;; - da30 | da30-*) - basic_machine=m68k-da30 - ;; - decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) - basic_machine=mips-dec - ;; - delta | 3300 | motorola-3300 | motorola-delta \ - | 3300-motorola | delta-motorola) - basic_machine=m68k-motorola - ;; - delta88) - basic_machine=m88k-motorola - os=-sysv3 - ;; - 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 - ;; - fx2800) - basic_machine=i860-alliant - ;; - genix) - basic_machine=ns32k-ns - ;; - gmicro) - basic_machine=tron-gmicro - os=-sysv - ;; - h3050r* | hiux*) - basic_machine=hppa1.1-hitachi - os=-hiuxwe2 - ;; - h8300hms) - basic_machine=h8300-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 - ;; - hp9k2[0-9][0-9] | hp9k31[0-9]) - basic_machine=m68000-hp - ;; - hp9k3[2-9][0-9]) - basic_machine=m68k-hp - ;; - hp9k7[0-9][0-9] | hp7[0-9][0-9] | hp9k8[0-9]7 | hp8[0-9]7) - basic_machine=hppa1.1-hp - ;; - hp9k8[0-9][0-9] | hp8[0-9][0-9]) - basic_machine=hppa1.0-hp - ;; - hppa-next) - os=-nextstep3 - ;; - i370-ibm* | ibm*) - basic_machine=i370-ibm - os=-mvs - ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? - i[3456]86v32) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv32 - ;; - i[3456]86v4*) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv4 - ;; - i[3456]86v) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv - ;; - i[3456]86sol2) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-solaris2 - ;; - iris | iris4d) - basic_machine=mips-sgi - case $os in - -irix*) - ;; - *) - os=-irix4 - ;; - esac - ;; - isi68 | isi) - basic_machine=m68k-isi - os=-sysv - ;; - m88k-omron*) - basic_machine=m88k-omron - ;; - magnum | m3230) - basic_machine=mips-mips - os=-sysv - ;; - merlin) - basic_machine=ns32k-utek - os=-sysv - ;; - miniframe) - basic_machine=m68000-convergent - ;; - mipsel*-linux*) - basic_machine=mipsel-unknown - os=-linux-gnu - ;; - mips*-linux*) - basic_machine=mips-unknown - os=-linux-gnu - ;; - mips3*-*) - basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` - ;; - mips3*) - basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown - ;; - ncr3000) - basic_machine=i486-ncr - os=-sysv4 - ;; - 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 - ;; - 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 - ;; - np1) - basic_machine=np1-gould - ;; - pa-hitachi) - basic_machine=hppa1.1-hitachi - os=-hiuxwe2 - ;; - paragon) - basic_machine=i860-intel - os=-osf - ;; - pbd) - basic_machine=sparc-tti - ;; - pbb) - basic_machine=m68k-tti - ;; - pc532 | pc532-*) - basic_machine=ns32k-pc532 - ;; - pentium | p5) - basic_machine=i586-intel - ;; - pentiumpro | p6) - basic_machine=i686-intel - ;; - pentium-* | p5-*) - basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentiumpro-* | p6-*) - basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - k5) - # We don't have specific support for AMD's K5 yet, so just call it a Pentium - basic_machine=i586-amd - ;; - nexen) - # We don't have specific support for Nexgen yet, so just call it a Pentium - basic_machine=i586-nexgen - ;; - pn) - basic_machine=pn-gould - ;; - power) basic_machine=rs6000-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/^[^-]*-//'` - ;; - ps2) - basic_machine=i386-ibm - ;; - rm[46]00) - basic_machine=mips-siemens - ;; - rtpc | rtpc-*) - basic_machine=romp-ibm - ;; - sequent) - basic_machine=i386-sequent - ;; - sh) - basic_machine=sh-hitachi - os=-hms - ;; - sps7) - basic_machine=m68k-bull - os=-sysv2 - ;; - spur) - basic_machine=spur-unknown - ;; - 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 - ;; - symmetry) - basic_machine=i386-sequent - os=-dynix - ;; - tx39) - basic_machine=mipstx39-unknown - ;; - tx39el) - basic_machine=mipstx39el-unknown - ;; - tower | tower-32) - basic_machine=m68k-ncr - ;; - udi29k) - basic_machine=a29k-amd - os=-udi - ;; - ultra3) - basic_machine=a29k-nyu - os=-sym1 - ;; - 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 - ;; - xmp) - basic_machine=xmp-cray - os=-unicos - ;; - xps | xps100) - basic_machine=xps100-honeywell - ;; - 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. - mips) - if [ x$os = x-linux-gnu ]; then - basic_machine=mips-unknown - else - basic_machine=mips-mips - fi - ;; - romp) - basic_machine=romp-ibm - ;; - rs6000) - basic_machine=rs6000-ibm - ;; - vax) - basic_machine=vax-dec - ;; - pdp11) - basic_machine=pdp11-dec - ;; - we32k) - basic_machine=we32k-att - ;; - sparc) - basic_machine=sparc-sun - ;; - cydra) - basic_machine=cydra-cydrome - ;; - orion) - basic_machine=orion-highlevel - ;; - orion105) - basic_machine=clipper-highlevel - ;; - *) - 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* | -netbsd* | -openbsd* | -freebsd* | -riscix* \ - | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* \ - | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ - | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -cygwin32* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -uxpv*) - # Remember, each alternative MUST END IN *, to match a version number. - ;; - -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|'` - ;; - -osfrose*) - os=-osfrose - ;; - -osf*) - os=-osf - ;; - -utek*) - os=-bsd - ;; - -dynix*) - os=-bsd - ;; - -acis*) - os=-aos - ;; - -ctix* | -uts*) - os=-sysv - ;; - -ns2 ) - os=-nextstep2 - ;; - # Preserve the version number of sinix5. - -sinix5.*) - os=`echo $os | sed -e 's|sinix|sysv|'` - ;; - -sinix*) - os=-sysv4 - ;; - -triton*) - os=-sysv3 - ;; - -oss*) - os=-sysv3 - ;; - -svr4) - os=-sysv4 - ;; - -svr3) - os=-sysv3 - ;; - -sysvr4) - os=-sysv4 - ;; - # This must come after -sysvr4. - -sysv*) - ;; - -xenix) - os=-xenix - ;; - -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 - *-acorn) - os=-riscix1.2 - ;; - arm*-semi) - os=-aout - ;; - 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 - ;; - *-tti) # must be before sparc entry or we get the wrong os. - os=-sysv3 - ;; - sparc-* | *-sun) - os=-sunos4.1.1 - ;; - *-ibm) - os=-aix - ;; - *-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 - ;; - f301-fujitsu) - os=-uxpv - ;; - *) - 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 - ;; - -hpux*) - vendor=hp - ;; - -hiux*) - vendor=hitachi - ;; - -unos*) - vendor=crds - ;; - -dgux*) - vendor=dg - ;; - -luna*) - vendor=omron - ;; - -genix*) - vendor=ns - ;; - -mvs*) - vendor=ibm - ;; - -ptx*) - vendor=sequent - ;; - -vxsim* | -vxworks*) - vendor=wrs - ;; - -aux*) - vendor=apple - ;; - esac - basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` - ;; -esac - -echo $basic_machine$os diff --git a/configure b/configure deleted file mode 100755 index 26a2e7ee9..000000000 --- a/configure +++ /dev/null @@ -1,5071 +0,0 @@ -#! /bin/sh - -# Guess values for system-dependent variables and create Makefiles. -# Generated automatically using autoconf version 2.12 -# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. -# -# This configure script is free software; the Free Software Foundation -# gives unlimited permission to copy, distribute and modify it. - -# Defaults: -ac_help= -ac_default_prefix=/usr/local -# Any additions from configure.in: -ac_help="$ac_help - --enable-maintainer-mode enable make rules and dependencies not useful - (and sometimes confusing) to the casual installer" -ac_help="$ac_help - --enable-dynamic-linking Include support for dynamic linking" -ac_help="$ac_help - --enable-guile-debug Include internal debugging functions" -ac_help="$ac_help - --enable-shared build shared libraries [default=yes] - --enable-shared=PKGS only build shared libraries if the current package - appears as an element in the PKGS list" -ac_help="$ac_help - --enable-static build static libraries [default=yes] - --enable-static=PKGS only build shared libraries if the current package - appears as an element in the PKGS list" -ac_help="$ac_help - --with-gnu-ld assume the C compiler uses GNU ld [default=no]" -ac_help="$ac_help - --with-threads thread interface" - -# Initialize some variables set by options. -# The variables have the same names as the options, with -# dashes changed to underlines. -build=NONE -cache_file=./config.cache -exec_prefix=NONE -host=NONE -no_create= -nonopt=NONE -no_recursion= -prefix=NONE -program_prefix=NONE -program_suffix=NONE -program_transform_name=s,x,x, -silent= -site= -srcdir= -target=NONE -verbose= -x_includes=NONE -x_libraries=NONE -bindir='${exec_prefix}/bin' -sbindir='${exec_prefix}/sbin' -libexecdir='${exec_prefix}/libexec' -datadir='${prefix}/share' -sysconfdir='${prefix}/etc' -sharedstatedir='${prefix}/com' -localstatedir='${prefix}/var' -libdir='${exec_prefix}/lib' -includedir='${prefix}/include' -oldincludedir='/usr/include' -infodir='${prefix}/info' -mandir='${prefix}/man' - -# Initialize some other variables. -subdirs= -MFLAGS= MAKEFLAGS= -# Maximum number of lines to put in a shell here document. -ac_max_here_lines=12 - -ac_prev= -for ac_option -do - - # If the previous option needs an argument, assign it. - if test -n "$ac_prev"; then - eval "$ac_prev=\$ac_option" - ac_prev= - continue - fi - - case "$ac_option" in - -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;; - *) ac_optarg= ;; - esac - - # Accept the important Cygnus configure options, so we can diagnose typos. - - case "$ac_option" in - - -bindir | --bindir | --bindi | --bind | --bin | --bi) - ac_prev=bindir ;; - -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) - bindir="$ac_optarg" ;; - - -build | --build | --buil | --bui | --bu) - ac_prev=build ;; - -build=* | --build=* | --buil=* | --bui=* | --bu=*) - build="$ac_optarg" ;; - - -cache-file | --cache-file | --cache-fil | --cache-fi \ - | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) - ac_prev=cache_file ;; - -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ - | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) - cache_file="$ac_optarg" ;; - - -datadir | --datadir | --datadi | --datad | --data | --dat | --da) - ac_prev=datadir ;; - -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ - | --da=*) - datadir="$ac_optarg" ;; - - -disable-* | --disable-*) - ac_feature=`echo $ac_option|sed -e 's/-*disable-//'` - # Reject names that are not valid shell variable names. - if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then - { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } - fi - ac_feature=`echo $ac_feature| sed 's/-/_/g'` - eval "enable_${ac_feature}=no" ;; - - -enable-* | --enable-*) - ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'` - # Reject names that are not valid shell variable names. - if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then - { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } - fi - ac_feature=`echo $ac_feature| sed 's/-/_/g'` - case "$ac_option" in - *=*) ;; - *) ac_optarg=yes ;; - esac - eval "enable_${ac_feature}='$ac_optarg'" ;; - - -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ - | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ - | --exec | --exe | --ex) - ac_prev=exec_prefix ;; - -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ - | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ - | --exec=* | --exe=* | --ex=*) - exec_prefix="$ac_optarg" ;; - - -gas | --gas | --ga | --g) - # Obsolete; use --with-gas. - with_gas=yes ;; - - -help | --help | --hel | --he) - # Omit some internal or obsolete options to make the list less imposing. - # This message is too long to be a string in the A/UX 3.1 sh. - cat << EOF -Usage: configure [options] [host] -Options: [defaults in brackets after descriptions] -Configuration: - --cache-file=FILE cache test results in FILE - --help print this message - --no-create do not create output files - --quiet, --silent do not print \`checking...' messages - --version print the version of autoconf that created configure -Directory and file names: - --prefix=PREFIX install architecture-independent files in PREFIX - [$ac_default_prefix] - --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX - [same as prefix] - --bindir=DIR user executables in DIR [EPREFIX/bin] - --sbindir=DIR system admin executables in DIR [EPREFIX/sbin] - --libexecdir=DIR program executables in DIR [EPREFIX/libexec] - --datadir=DIR read-only architecture-independent data in DIR - [PREFIX/share] - --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc] - --sharedstatedir=DIR modifiable architecture-independent data in DIR - [PREFIX/com] - --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var] - --libdir=DIR object code libraries in DIR [EPREFIX/lib] - --includedir=DIR C header files in DIR [PREFIX/include] - --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include] - --infodir=DIR info documentation in DIR [PREFIX/info] - --mandir=DIR man documentation in DIR [PREFIX/man] - --srcdir=DIR find the sources in DIR [configure dir or ..] - --program-prefix=PREFIX prepend PREFIX to installed program names - --program-suffix=SUFFIX append SUFFIX to installed program names - --program-transform-name=PROGRAM - run sed PROGRAM on installed program names -EOF - cat << EOF -Host type: - --build=BUILD configure for building on BUILD [BUILD=HOST] - --host=HOST configure for HOST [guessed] - --target=TARGET configure for TARGET [TARGET=HOST] -Features and packages: - --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) - --enable-FEATURE[=ARG] include FEATURE [ARG=yes] - --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] - --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) - --x-includes=DIR X include files are in DIR - --x-libraries=DIR X library files are in DIR -EOF - if test -n "$ac_help"; then - echo "--enable and --with options recognized:$ac_help" - fi - exit 0 ;; - - -host | --host | --hos | --ho) - ac_prev=host ;; - -host=* | --host=* | --hos=* | --ho=*) - host="$ac_optarg" ;; - - -includedir | --includedir | --includedi | --included | --include \ - | --includ | --inclu | --incl | --inc) - ac_prev=includedir ;; - -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ - | --includ=* | --inclu=* | --incl=* | --inc=*) - includedir="$ac_optarg" ;; - - -infodir | --infodir | --infodi | --infod | --info | --inf) - ac_prev=infodir ;; - -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) - infodir="$ac_optarg" ;; - - -libdir | --libdir | --libdi | --libd) - ac_prev=libdir ;; - -libdir=* | --libdir=* | --libdi=* | --libd=*) - libdir="$ac_optarg" ;; - - -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ - | --libexe | --libex | --libe) - ac_prev=libexecdir ;; - -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ - | --libexe=* | --libex=* | --libe=*) - libexecdir="$ac_optarg" ;; - - -localstatedir | --localstatedir | --localstatedi | --localstated \ - | --localstate | --localstat | --localsta | --localst \ - | --locals | --local | --loca | --loc | --lo) - ac_prev=localstatedir ;; - -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ - | --localstate=* | --localstat=* | --localsta=* | --localst=* \ - | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) - localstatedir="$ac_optarg" ;; - - -mandir | --mandir | --mandi | --mand | --man | --ma | --m) - ac_prev=mandir ;; - -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) - mandir="$ac_optarg" ;; - - -nfp | --nfp | --nf) - # Obsolete; use --without-fp. - with_fp=no ;; - - -no-create | --no-create | --no-creat | --no-crea | --no-cre \ - | --no-cr | --no-c) - no_create=yes ;; - - -no-recursion | --no-recursion | --no-recursio | --no-recursi \ - | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) - no_recursion=yes ;; - - -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ - | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ - | --oldin | --oldi | --old | --ol | --o) - ac_prev=oldincludedir ;; - -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ - | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ - | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) - oldincludedir="$ac_optarg" ;; - - -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) - ac_prev=prefix ;; - -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) - prefix="$ac_optarg" ;; - - -program-prefix | --program-prefix | --program-prefi | --program-pref \ - | --program-pre | --program-pr | --program-p) - ac_prev=program_prefix ;; - -program-prefix=* | --program-prefix=* | --program-prefi=* \ - | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) - program_prefix="$ac_optarg" ;; - - -program-suffix | --program-suffix | --program-suffi | --program-suff \ - | --program-suf | --program-su | --program-s) - ac_prev=program_suffix ;; - -program-suffix=* | --program-suffix=* | --program-suffi=* \ - | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) - program_suffix="$ac_optarg" ;; - - -program-transform-name | --program-transform-name \ - | --program-transform-nam | --program-transform-na \ - | --program-transform-n | --program-transform- \ - | --program-transform | --program-transfor \ - | --program-transfo | --program-transf \ - | --program-trans | --program-tran \ - | --progr-tra | --program-tr | --program-t) - ac_prev=program_transform_name ;; - -program-transform-name=* | --program-transform-name=* \ - | --program-transform-nam=* | --program-transform-na=* \ - | --program-transform-n=* | --program-transform-=* \ - | --program-transform=* | --program-transfor=* \ - | --program-transfo=* | --program-transf=* \ - | --program-trans=* | --program-tran=* \ - | --progr-tra=* | --program-tr=* | --program-t=*) - program_transform_name="$ac_optarg" ;; - - -q | -quiet | --quiet | --quie | --qui | --qu | --q \ - | -silent | --silent | --silen | --sile | --sil) - silent=yes ;; - - -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) - ac_prev=sbindir ;; - -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ - | --sbi=* | --sb=*) - sbindir="$ac_optarg" ;; - - -sharedstatedir | --sharedstatedir | --sharedstatedi \ - | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ - | --sharedst | --shareds | --shared | --share | --shar \ - | --sha | --sh) - ac_prev=sharedstatedir ;; - -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ - | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ - | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ - | --sha=* | --sh=*) - sharedstatedir="$ac_optarg" ;; - - -site | --site | --sit) - ac_prev=site ;; - -site=* | --site=* | --sit=*) - site="$ac_optarg" ;; - - -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) - ac_prev=srcdir ;; - -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) - srcdir="$ac_optarg" ;; - - -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ - | --syscon | --sysco | --sysc | --sys | --sy) - ac_prev=sysconfdir ;; - -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ - | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) - sysconfdir="$ac_optarg" ;; - - -target | --target | --targe | --targ | --tar | --ta | --t) - ac_prev=target ;; - -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) - target="$ac_optarg" ;; - - -v | -verbose | --verbose | --verbos | --verbo | --verb) - verbose=yes ;; - - -version | --version | --versio | --versi | --vers) - echo "configure generated by autoconf version 2.12" - exit 0 ;; - - -with-* | --with-*) - ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'` - # Reject names that are not valid shell variable names. - if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then - { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } - fi - ac_package=`echo $ac_package| sed 's/-/_/g'` - case "$ac_option" in - *=*) ;; - *) ac_optarg=yes ;; - esac - eval "with_${ac_package}='$ac_optarg'" ;; - - -without-* | --without-*) - ac_package=`echo $ac_option|sed -e 's/-*without-//'` - # Reject names that are not valid shell variable names. - if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then - { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } - fi - ac_package=`echo $ac_package| sed 's/-/_/g'` - eval "with_${ac_package}=no" ;; - - --x) - # Obsolete; use --with-x. - with_x=yes ;; - - -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ - | --x-incl | --x-inc | --x-in | --x-i) - ac_prev=x_includes ;; - -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ - | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) - x_includes="$ac_optarg" ;; - - -x-libraries | --x-libraries | --x-librarie | --x-librari \ - | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) - ac_prev=x_libraries ;; - -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ - | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) - x_libraries="$ac_optarg" ;; - - -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; } - ;; - - *) - if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then - echo "configure: warning: $ac_option: invalid host type" 1>&2 - fi - if test "x$nonopt" != xNONE; then - { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } - fi - nonopt="$ac_option" - ;; - - esac -done - -if test -n "$ac_prev"; then - { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; } -fi - -trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 - -# File descriptor usage: -# 0 standard input -# 1 file creation -# 2 errors and warnings -# 3 some systems may open it to /dev/tty -# 4 used on the Kubota Titan -# 6 checking for... messages and results -# 5 compiler messages saved in config.log -if test "$silent" = yes; then - exec 6>/dev/null -else - exec 6>&1 -fi -exec 5>./config.log - -echo "\ -This file contains any messages produced by compilers while -running configure, to aid debugging if configure makes a mistake. -" 1>&5 - -# Strip out --no-create and --no-recursion so they do not pile up. -# Also quote any args containing shell metacharacters. -ac_configure_args= -for ac_arg -do - case "$ac_arg" in - -no-create | --no-create | --no-creat | --no-crea | --no-cre \ - | --no-cr | --no-c) ;; - -no-recursion | --no-recursion | --no-recursio | --no-recursi \ - | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;; - *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*) - ac_configure_args="$ac_configure_args '$ac_arg'" ;; - *) ac_configure_args="$ac_configure_args $ac_arg" ;; - esac -done - -# NLS nuisances. -# Only set these to C if already set. These must not be set unconditionally -# because not all systems understand e.g. LANG=C (notably SCO). -# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'! -# Non-C LC_CTYPE values break the ctype check. -if test "${LANG+set}" = set; then LANG=C; export LANG; fi -if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi -if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi -if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi - -# confdefs.h avoids OS command line length limits that DEFS can exceed. -rm -rf conftest* confdefs.h -# AIX cpp loses on an empty file, so make sure it contains at least a newline. -echo > confdefs.h - -# A filename unique to this package, relative to the directory that -# configure is in, which we can look for to find out if srcdir is correct. -ac_unique_file=Makefile.in - -# Find the source files, if location was not specified. -if test -z "$srcdir"; then - ac_srcdir_defaulted=yes - # Try the directory containing this script, then its parent. - ac_prog=$0 - ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'` - test "x$ac_confdir" = "x$ac_prog" && ac_confdir=. - srcdir=$ac_confdir - if test ! -r $srcdir/$ac_unique_file; then - srcdir=.. - fi -else - ac_srcdir_defaulted=no -fi -if test ! -r $srcdir/$ac_unique_file; then - if test "$ac_srcdir_defaulted" = yes; then - { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; } - else - { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; } - fi -fi -srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'` - -# Prefer explicitly selected file to automatically selected ones. -if test -z "$CONFIG_SITE"; then - if test "x$prefix" != xNONE; then - CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" - else - CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" - fi -fi -for ac_site_file in $CONFIG_SITE; do - if test -r "$ac_site_file"; then - echo "loading site script $ac_site_file" - . "$ac_site_file" - fi -done - -if test -r "$cache_file"; then - echo "loading cache $cache_file" - . $cache_file -else - echo "creating cache $cache_file" - > $cache_file -fi - -ac_ext=c -# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. -ac_cpp='$CPP $CPPFLAGS' -ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' -ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' -cross_compiling=$ac_cv_prog_cc_cross - -if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then - # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. - if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then - ac_n= ac_c=' -' ac_t=' ' - else - ac_n=-n ac_c= ac_t= - fi -else - ac_n= ac_c='\c' ac_t= -fi - - -. $srcdir/GUILE-VERSION -ac_aux_dir= -for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do - if test -f $ac_dir/install-sh; then - ac_aux_dir=$ac_dir - ac_install_sh="$ac_aux_dir/install-sh -c" - break - elif test -f $ac_dir/install.sh; then - ac_aux_dir=$ac_dir - ac_install_sh="$ac_aux_dir/install.sh -c" - break - fi -done -if test -z "$ac_aux_dir"; then - { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; } -fi -ac_config_guess=$ac_aux_dir/config.guess -ac_config_sub=$ac_aux_dir/config.sub -ac_configure=$ac_aux_dir/configure # This should be Cygnus configure. - -# Find a good install program. We prefer a C program (faster), -# so one script is as good as another. But avoid the broken or -# incompatible versions: -# SysV /etc/install, /usr/sbin/install -# SunOS /usr/etc/install -# IRIX /sbin/install -# AIX /bin/install -# AFS /usr/afsws/bin/install, which mishandles nonexistent args -# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" -# ./install, which can be erroneously created by make from ./install.sh. -echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6 -echo "configure:572: checking for a BSD compatible install" >&5 -if test -z "$INSTALL"; then -if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS="${IFS}:" - for ac_dir in $PATH; do - # Account for people who put trailing slashes in PATH elements. - case "$ac_dir/" in - /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;; - *) - # OSF1 and SCO ODT 3.0 have their own names for install. - for ac_prog in ginstall installbsd scoinst install; do - if test -f $ac_dir/$ac_prog; then - if test $ac_prog = install && - grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then - # AIX install. It has an incompatible calling convention. - # OSF/1 installbsd also uses dspmsg, but is usable. - : - else - ac_cv_path_install="$ac_dir/$ac_prog -c" - break 2 - fi - fi - done - ;; - esac - done - IFS="$ac_save_IFS" - -fi - if test "${ac_cv_path_install+set}" = set; then - INSTALL="$ac_cv_path_install" - else - # As a last resort, use the slow shell script. We don't cache a - # path for INSTALL within a source directory, because that will - # break other packages using the cache if that directory is - # removed, or if the path is relative. - INSTALL="$ac_install_sh" - fi -fi -echo "$ac_t""$INSTALL" 1>&6 - -# Use test -z because SunOS4 sh mishandles braces in ${var-val}. -# It thinks the first close brace ends the variable substitution. -test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' - -test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' - - -test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}' - -echo $ac_n "checking whether build environment is sane""... $ac_c" 1>&6 -echo "configure:625: checking whether build environment is sane" >&5 -# Just in case -sleep 1 -echo timestamp > conftestfile -# Do `set' in a subshell so we don't clobber the current shell's -# arguments. Must try -L first in case configure is actually a -# symlink; some systems play weird games with the mod time of symlinks -# (eg FreeBSD returns the mod time of the symlink's containing -# directory). -if ( - set X `ls -Lt $srcdir/configure conftestfile 2> /dev/null` - if test "$*" = "X"; then - # -L didn't work. - set X `ls -t $srcdir/configure conftestfile` - fi - if test "$*" != "X $srcdir/configure conftestfile" \ - && test "$*" != "X conftestfile $srcdir/configure"; then - - # If neither matched, then we have a broken ls. This can happen - # if, for instance, CONFIG_SHELL is bash and it inherits a - # broken ls alias from the environment. This has actually - # happened. Such a system could not be considered "sane". - { echo "configure: error: ls -t appears to fail. Make sure there is not a broken -alias in your environment" 1>&2; exit 1; } - fi - - test "$2" = conftestfile - ) -then - # Ok. - : -else - { echo "configure: error: newly created file is older than distributed files! -Check your system clock" 1>&2; exit 1; } -fi -rm -f conftest* -echo "$ac_t""yes" 1>&6 -if test "$program_transform_name" = s,x,x,; then - program_transform_name= -else - # Double any \ or $. echo might interpret backslashes. - cat <<\EOF_SED > conftestsed -s,\\,\\\\,g; s,\$,$$,g -EOF_SED - program_transform_name="`echo $program_transform_name|sed -f conftestsed`" - rm -f conftestsed -fi -test "$program_prefix" != NONE && - program_transform_name="s,^,${program_prefix},; $program_transform_name" -# Use a double $ so make ignores it. -test "$program_suffix" != NONE && - program_transform_name="s,\$\$,${program_suffix},; $program_transform_name" - -# sed with no file args requires a program. -test "$program_transform_name" = "" && program_transform_name="s,x,x," - -echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 -echo "configure:682: checking whether ${MAKE-make} sets \${MAKE}" >&5 -set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` -if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftestmake <<\EOF -all: - @echo 'ac_maketemp="${MAKE}"' -EOF -# GNU make sometimes prints "make[1]: Entering...", which would confuse us. -eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=` -if test -n "$ac_maketemp"; then - eval ac_cv_prog_make_${ac_make}_set=yes -else - eval ac_cv_prog_make_${ac_make}_set=no -fi -rm -f conftestmake -fi -if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then - echo "$ac_t""yes" 1>&6 - SET_MAKE= -else - echo "$ac_t""no" 1>&6 - SET_MAKE="MAKE=${MAKE-make}" -fi - - -PACKAGE=$PACKAGE - -VERSION=$VERSION - -if test "`cd $srcdir && pwd`" != "`pwd`" && test -f $srcdir/config.status; then - { echo "configure: error: source directory already configured; run "make distclean" there first" 1>&2; exit 1; } -fi - - - -missing_dir=`cd $ac_aux_dir && pwd` -echo $ac_n "checking for working aclocal""... $ac_c" 1>&6 -echo "configure:721: checking for working aclocal" >&5 -# Run test in a subshell; some versions of sh will print an error if -# an executable is not found, even if stderr is redirected. -# Redirect stdin to placate older versions of autoconf. Sigh. -if (aclocal --version) < /dev/null > /dev/null 2>&1; then - ACLOCAL=aclocal - echo "$ac_t""found" 1>&6 -else - ACLOCAL="$missing_dir/missing aclocal" - echo "$ac_t""missing" 1>&6 -fi - -echo $ac_n "checking for working autoconf""... $ac_c" 1>&6 -echo "configure:734: checking for working autoconf" >&5 -# Run test in a subshell; some versions of sh will print an error if -# an executable is not found, even if stderr is redirected. -# Redirect stdin to placate older versions of autoconf. Sigh. -if (autoconf --version) < /dev/null > /dev/null 2>&1; then - AUTOCONF=autoconf - echo "$ac_t""found" 1>&6 -else - AUTOCONF="$missing_dir/missing autoconf" - echo "$ac_t""missing" 1>&6 -fi - -echo $ac_n "checking for working automake""... $ac_c" 1>&6 -echo "configure:747: checking for working automake" >&5 -# Run test in a subshell; some versions of sh will print an error if -# an executable is not found, even if stderr is redirected. -# Redirect stdin to placate older versions of autoconf. Sigh. -if (automake --version) < /dev/null > /dev/null 2>&1; then - AUTOMAKE=automake - echo "$ac_t""found" 1>&6 -else - AUTOMAKE="$missing_dir/missing automake" - echo "$ac_t""missing" 1>&6 -fi - -echo $ac_n "checking for working autoheader""... $ac_c" 1>&6 -echo "configure:760: checking for working autoheader" >&5 -# Run test in a subshell; some versions of sh will print an error if -# an executable is not found, even if stderr is redirected. -# Redirect stdin to placate older versions of autoconf. Sigh. -if (autoheader --version) < /dev/null > /dev/null 2>&1; then - AUTOHEADER=autoheader - echo "$ac_t""found" 1>&6 -else - AUTOHEADER="$missing_dir/missing autoheader" - echo "$ac_t""missing" 1>&6 -fi - -echo $ac_n "checking for working makeinfo""... $ac_c" 1>&6 -echo "configure:773: checking for working makeinfo" >&5 -# Run test in a subshell; some versions of sh will print an error if -# an executable is not found, even if stderr is redirected. -# Redirect stdin to placate older versions of autoconf. Sigh. -if (makeinfo --version) < /dev/null > /dev/null 2>&1; then - MAKEINFO=makeinfo - echo "$ac_t""found" 1>&6 -else - MAKEINFO="$missing_dir/missing makeinfo" - echo "$ac_t""missing" 1>&6 -fi - - -echo $ac_n "checking whether to enable maintainer-specific portions of Makefiles""... $ac_c" 1>&6 -echo "configure:787: checking whether to enable maintainer-specific portions of Makefiles" >&5 - # Check whether --enable-maintainer-mode or --disable-maintainer-mode was given. -if test "${enable_maintainer_mode+set}" = set; then - enableval="$enable_maintainer_mode" - USE_MAINTAINER_MODE=$enableval -else - USE_MAINTAINER_MODE=no -fi - - echo "$ac_t""$USE_MAINTAINER_MODE" 1>&6 - if test $USE_MAINTAINER_MODE = yes; then - MAINT= - else - MAINT='#M#' - fi - - - - - - -#-------------------------------------------------------------------- -# -# User options -# -#-------------------------------------------------------------------- - -# Check whether --enable-dynamic-linking or --disable-dynamic-linking was given. -if test "${enable_dynamic_linking+set}" = set; then - enableval="$enable_dynamic_linking" - : -else - enable_dynamic_linking=yes -fi - - -# Check whether --enable-guile-debug or --disable-guile-debug was given. -if test "${enable_guile_debug+set}" = set; then - enableval="$enable_guile_debug" - : -fi - -if test "$enableval" = y || test "$enableval" = yes; then - cat >> confdefs.h <<\EOF -#define GUILE_DEBUG 1 -EOF - -fi - -cat >> confdefs.h <<\EOF -#define DEBUG_EXTENSIONS 1 -EOF - -cat >> confdefs.h <<\EOF -#define READER_EXTENSIONS 1 -EOF - - -#-------------------------------------------------------------------- - -# Extract the first word of "gcc", so it can be a program name with args. -set dummy gcc; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:850: checking for $ac_word" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" - for ac_dir in $PATH; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - ac_cv_prog_CC="gcc" - break - fi - done - IFS="$ac_save_ifs" -fi -fi -CC="$ac_cv_prog_CC" -if test -n "$CC"; then - echo "$ac_t""$CC" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi - -if test -z "$CC"; then - # Extract the first word of "cc", so it can be a program name with args. -set dummy cc; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:879: checking for $ac_word" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" - ac_prog_rejected=no - for ac_dir in $PATH; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then - ac_prog_rejected=yes - continue - fi - ac_cv_prog_CC="cc" - break - fi - done - IFS="$ac_save_ifs" -if test $ac_prog_rejected = yes; then - # We found a bogon in the path, so make sure we never use it. - set dummy $ac_cv_prog_CC - shift - if test $# -gt 0; then - # We chose a different compiler from the bogus one. - # However, it has the same basename, so the bogon will be chosen - # first if we set CC to just the basename; use the full file name. - shift - set dummy "$ac_dir/$ac_word" "$@" - shift - ac_cv_prog_CC="$@" - fi -fi -fi -fi -CC="$ac_cv_prog_CC" -if test -n "$CC"; then - echo "$ac_t""$CC" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi - - test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } -fi - -echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 -echo "configure:927: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 - -ac_ext=c -# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. -ac_cpp='$CPP $CPPFLAGS' -ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' -ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' -cross_compiling=$ac_cv_prog_cc_cross - -cat > conftest.$ac_ext <<EOF -#line 937 "configure" -#include "confdefs.h" -main(){return(0);} -EOF -if { (eval echo configure:941: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - ac_cv_prog_cc_works=yes - # If we can't run a trivial program, we are probably using a cross compiler. - if (./conftest; exit) 2>/dev/null; then - ac_cv_prog_cc_cross=no - else - ac_cv_prog_cc_cross=yes - fi -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - ac_cv_prog_cc_works=no -fi -rm -fr conftest* - -echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 -if test $ac_cv_prog_cc_works = no; then - { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } -fi -echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 -echo "configure:961: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 -echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 -cross_compiling=$ac_cv_prog_cc_cross - -echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:966: checking whether we are using GNU C" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.c <<EOF -#ifdef __GNUC__ - yes; -#endif -EOF -if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:975: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then - ac_cv_prog_gcc=yes -else - ac_cv_prog_gcc=no -fi -fi - -echo "$ac_t""$ac_cv_prog_gcc" 1>&6 - -if test $ac_cv_prog_gcc = yes; then - GCC=yes - ac_test_CFLAGS="${CFLAGS+set}" - ac_save_CFLAGS="$CFLAGS" - CFLAGS= - echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:990: checking whether ${CC-cc} accepts -g" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - echo 'void f(){}' > conftest.c -if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then - ac_cv_prog_cc_g=yes -else - ac_cv_prog_cc_g=no -fi -rm -f conftest* - -fi - -echo "$ac_t""$ac_cv_prog_cc_g" 1>&6 - if test "$ac_test_CFLAGS" = set; then - CFLAGS="$ac_save_CFLAGS" - elif test $ac_cv_prog_cc_g = yes; then - CFLAGS="-g -O2" - else - CFLAGS="-O2" - fi -else - GCC= - test "${CFLAGS+set}" = set || CFLAGS="-g" -fi - -echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 -echo "configure:1018: checking how to run the C preprocessor" >&5 -# On Suns, sometimes $CPP names a directory. -if test -n "$CPP" && test -d "$CPP"; then - CPP= -fi -if test -z "$CPP"; then -if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - # This must be in double quotes, not single quotes, because CPP may get - # substituted into the Makefile and "${CC-cc}" will confuse make. - CPP="${CC-cc} -E" - # On the NeXT, cc -E runs the code through the compiler's parser, - # not just through cpp. - cat > conftest.$ac_ext <<EOF -#line 1033 "configure" -#include "confdefs.h" -#include <assert.h> -Syntax Error -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1039: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` -if test -z "$ac_err"; then - : -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - CPP="${CC-cc} -E -traditional-cpp" - cat > conftest.$ac_ext <<EOF -#line 1050 "configure" -#include "confdefs.h" -#include <assert.h> -Syntax Error -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1056: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` -if test -z "$ac_err"; then - : -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - CPP=/lib/cpp -fi -rm -f conftest* -fi -rm -f conftest* - ac_cv_prog_CPP="$CPP" -fi - CPP="$ac_cv_prog_CPP" -else - ac_cv_prog_CPP="$CPP" -fi -echo "$ac_t""$CPP" 1>&6 - -# Check whether --enable-shared or --disable-shared was given. -if test "${enable_shared+set}" = set; then - enableval="$enable_shared" - p=${PACKAGE-default} -case "$enableval" in -yes) enable_shared=yes ;; -no) enable_shared=no ;; -*) - enable_shared=no - # Look at the argument we got. We use all the common list separators. - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:," - for pkg in $enableval; do - if test "X$pkg" = "X$p"; then - enable_shared=yes - fi - done - IFS="$ac_save_ifs" - ;; -esac -else - enable_shared=yes -fi - -# Check whether --enable-static or --disable-static was given. -if test "${enable_static+set}" = set; then - enableval="$enable_static" - p=${PACKAGE-default} -case "$enableval" in -yes) enable_static=yes ;; -no) enable_static=no ;; -*) - enable_static=no - # Look at the argument we got. We use all the common list separators. - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:," - for pkg in $enableval; do - if test "X$pkg" = "X$p"; then - enable_static=yes - fi - done - IFS="$ac_save_ifs" - ;; -esac -else - enable_static=yes -fi - - -# Make sure we can run config.sub. -if $ac_config_sub sun4 >/dev/null 2>&1; then : -else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; } -fi - -echo $ac_n "checking host system type""... $ac_c" 1>&6 -echo "configure:1131: checking host system type" >&5 - -host_alias=$host -case "$host_alias" in -NONE) - case $nonopt in - NONE) - if host_alias=`$ac_config_guess`; then : - else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; } - fi ;; - *) host_alias=$nonopt ;; - esac ;; -esac - -host=`$ac_config_sub $host_alias` -host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'` -host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'` -host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` -echo "$ac_t""$host" 1>&6 - -# Extract the first word of "ranlib", so it can be a program name with args. -set dummy ranlib; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1154: checking for $ac_word" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - if test -n "$RANLIB"; then - ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. -else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" - for ac_dir in $PATH; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - ac_cv_prog_RANLIB="ranlib" - break - fi - done - IFS="$ac_save_ifs" - test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":" -fi -fi -RANLIB="$ac_cv_prog_RANLIB" -if test -n "$RANLIB"; then - echo "$ac_t""$RANLIB" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi - -# Check whether --with-gnu-ld or --without-gnu-ld was given. -if test "${with_gnu_ld+set}" = set; then - withval="$with_gnu_ld" - test "$withval" = no || with_gnu_ld=yes -else - with_gnu_ld=no -fi - - -ac_prog=ld -if test "$ac_cv_prog_gcc" = yes; then - # Check if gcc -print-prog-name=ld gives a path. - echo $ac_n "checking for ld used by GCC""... $ac_c" 1>&6 -echo "configure:1193: checking for ld used by GCC" >&5 - ac_prog=`($CC -print-prog-name=ld) 2>&5` - case "$ac_prog" in - # Accept absolute paths. - /* | A-Za-z:\\*) - test -z "$LD" && LD="$ac_prog" - ;; - "") - # If it fails, then pretend we aren't using GCC. - ac_prog=ld - ;; - *) - # If it is relative, then search for the first ld in PATH. - with_gnu_ld=unknown - ;; - esac -elif test "$with_gnu_ld" = yes; then - echo $ac_n "checking for GNU ld""... $ac_c" 1>&6 -echo "configure:1211: checking for GNU ld" >&5 -else - echo $ac_n "checking for non-GNU ld""... $ac_c" 1>&6 -echo "configure:1214: checking for non-GNU ld" >&5 -fi -if eval "test \"`echo '$''{'ac_cv_path_LD'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - if test -z "$LD"; then - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" - for ac_dir in $PATH; do - test -z "$ac_dir" && ac_dir=. - if test -f "$ac_dir/$ac_prog"; then - ac_cv_path_LD="$ac_dir/$ac_prog" - # Check to see if the program is GNU ld. I'd rather use --version, - # but apparently some GNU ld's only accept -v. - # Break only if it was the GNU/non-GNU ld that we prefer. - if "$ac_cv_path_LD" -v 2>&1 < /dev/null | egrep '(GNU|with BFD)' > /dev/null; then - test "$with_gnu_ld" != no && break - else - test "$with_gnu_ld" != yes && break - fi - fi - done - IFS="$ac_save_ifs" -else - ac_cv_path_LD="$LD" # Let the user override the test with a path. -fi -fi - -LD="$ac_cv_path_LD" -if test -n "$LD"; then - echo "$ac_t""$LD" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi -test -z "$LD" && { echo "configure: error: no acceptable ld found in \$PATH" 1>&2; exit 1; } - -echo $ac_n "checking if the linker ($LD) is GNU ld""... $ac_c" 1>&6 -echo "configure:1250: checking if the linker ($LD) is GNU ld" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_gnu_ld'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - # I'd rather use --version here, but apparently some GNU ld's only accept -v. -if $LD -v 2>&1 </dev/null | egrep '(GNU|with BFD)' 1>&5; then - ac_cv_prog_gnu_ld=yes -else - ac_cv_prog_gnu_ld=no -fi -fi - -echo "$ac_t""$ac_cv_prog_gnu_ld" 1>&6 - - -echo $ac_n "checking for BSD-compatible nm""... $ac_c" 1>&6 -echo "configure:1266: checking for BSD-compatible nm" >&5 -if eval "test \"`echo '$''{'ac_cv_path_NM'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - case "$NM" in -/* | A-Za-z:\\*) - ac_cv_path_NM="$NM" # Let the user override the test with a path. - ;; -*) - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" - for ac_dir in /usr/ucb /usr/ccs/bin $PATH /bin; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/nm; then - # Check to see if the nm accepts a BSD-compat flag. - # Adding the `sed 1q' prevents false positives on HP-UX, which says: - # nm: unknown option "B" ignored - if ($ac_dir/nm -B /dev/null 2>&1 | sed '1q'; exit 0) | egrep /dev/null >/dev/null; then - ac_cv_path_NM="$ac_dir/nm -B" - elif ($ac_dir/nm -p /dev/null 2>&1 | sed '1q'; exit 0) | egrep /dev/null >/dev/null; then - ac_cv_path_NM="$ac_dir/nm -p" - else - ac_cv_path_NM="$ac_dir/nm" - fi - break - fi - done - IFS="$ac_save_ifs" - test -z "$ac_cv_path_NM" && ac_cv_path_NM=nm - ;; -esac -fi - -NM="$ac_cv_path_NM" -echo "$ac_t""$NM" 1>&6 - - -echo $ac_n "checking whether ln -s works""... $ac_c" 1>&6 -echo "configure:1303: checking whether ln -s works" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_LN_S'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - rm -f conftestdata -if ln -s X conftestdata 2>/dev/null -then - rm -f conftestdata - ac_cv_prog_LN_S="ln -s" -else - ac_cv_prog_LN_S=ln -fi -fi -LN_S="$ac_cv_prog_LN_S" -if test "$ac_cv_prog_LN_S" = "ln -s"; then - echo "$ac_t""yes" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi - -# Always use our own libtool. -LIBTOOL='$(SHELL) $(top_builddir)/libtool' - -# Check for any special flags to pass to ltconfig. -libtool_flags= -test "$enable_shared" = no && libtool_flags="$libtool_flags --disable-shared" -test "$enable_static" = no && libtool_flags="$libtool_flags --disable-static" -test "$silent" = yes && libtool_flags="$libtool_flags --silent" -test "$ac_cv_prog_gcc" = yes && libtool_flags="$libtool_flags --with-gcc" -test "$ac_cv_prog_gnu_ld" = yes && libtool_flags="$libtool_flags --with-gnu-ld" - -# Some flags need to be propagated to the compiler or linker for good -# libtool support. -case "$host" in -*-*-irix6*) - # Find out which ABI we are using. - echo '#line 1339 "configure"' > conftest.$ac_ext - if { (eval echo configure:1340: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - case "`/usr/bin/file conftest.o`" in - *32-bit*) - LD="${LD-ld} -32" - ;; - *N32*) - LD="${LD-ld} -n32" - ;; - *64-bit*) - LD="${LD-ld} -64" - ;; - esac - fi - rm -rf conftest* - ;; - -*-*-sco3.2v5*) - # On SCO OpenServer 5, we need -belf to get full-featured binaries. - CFLAGS="$CFLAGS -belf" - ;; -esac - -# Actually configure libtool. ac_aux_dir is where install-sh is found. -CC="$CC" CFLAGS="$CFLAGS" CPPFLAGS="$CPPFLAGS" \ -LD="$LD" NM="$NM" RANLIB="$RANLIB" LN_S="$LN_S" \ -${CONFIG_SHELL-/bin/sh} $ac_aux_dir/ltconfig \ -$libtool_flags --no-verify $ac_aux_dir/ltmain.sh $host \ -|| { echo "configure: error: libtool configure failed" 1>&2; exit 1; } - - -echo $ac_n "checking for AIX""... $ac_c" 1>&6 -echo "configure:1371: checking for AIX" >&5 -cat > conftest.$ac_ext <<EOF -#line 1373 "configure" -#include "confdefs.h" -#ifdef _AIX - yes -#endif - -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "yes" >/dev/null 2>&1; then - rm -rf conftest* - echo "$ac_t""yes" 1>&6; cat >> confdefs.h <<\EOF -#define _ALL_SOURCE 1 -EOF - -else - rm -rf conftest* - echo "$ac_t""no" 1>&6 -fi -rm -f conftest* - - -echo $ac_n "checking for POSIXized ISC""... $ac_c" 1>&6 -echo "configure:1395: checking for POSIXized ISC" >&5 -if test -d /etc/conf/kconfig.d && - grep _POSIX_VERSION /usr/include/sys/unistd.h >/dev/null 2>&1 -then - echo "$ac_t""yes" 1>&6 - ISC=yes # If later tests want to check for ISC. - cat >> confdefs.h <<\EOF -#define _POSIX_SOURCE 1 -EOF - - if test "$GCC" = yes; then - CC="$CC -posix" - else - CC="$CC -Xp" - fi -else - echo "$ac_t""no" 1>&6 - ISC= -fi - -ac_safe=`echo "minix/config.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for minix/config.h""... $ac_c" 1>&6 -echo "configure:1417: checking for minix/config.h" >&5 -if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 1422 "configure" -#include "confdefs.h" -#include <minix/config.h> -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1427: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -fi -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - MINIX=yes -else - echo "$ac_t""no" 1>&6 -MINIX= -fi - -if test "$MINIX" = yes; then - cat >> confdefs.h <<\EOF -#define _POSIX_SOURCE 1 -EOF - - cat >> confdefs.h <<\EOF -#define _POSIX_1_SOURCE 2 -EOF - - cat >> confdefs.h <<\EOF -#define _MINIX 1 -EOF - -fi - - -echo $ac_n "checking for working const""... $ac_c" 1>&6 -echo "configure:1466: checking for working const" >&5 -if eval "test \"`echo '$''{'ac_cv_c_const'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 1471 "configure" -#include "confdefs.h" - -int main() { - -/* Ultrix mips cc rejects this. */ -typedef int charset[2]; const charset x; -/* SunOS 4.1.1 cc rejects this. */ -char const *const *ccp; -char **p; -/* NEC SVR4.0.2 mips cc rejects this. */ -struct point {int x, y;}; -static struct point const zero = {0,0}; -/* AIX XL C 1.02.0.0 rejects this. - It does not let you subtract one const X* pointer from another in an arm - of an if-expression whose if-part is not a constant expression */ -const char *g = "string"; -ccp = &g + (g ? g-g : 0); -/* HPUX 7.0 cc rejects these. */ -++ccp; -p = (char**) ccp; -ccp = (char const *const *) p; -{ /* SCO 3.2v4 cc rejects this. */ - char *t; - char const *s = 0 ? (char *) 0 : (char const *) 0; - - *t++ = 0; -} -{ /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */ - int x[] = {25, 17}; - const int *foo = &x[0]; - ++foo; -} -{ /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */ - typedef const int *iptr; - iptr p = 0; - ++p; -} -{ /* AIX XL C 1.02.0.0 rejects this saying - "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */ - struct s { int j; const int *ap[3]; }; - struct s *b; b->j = 5; -} -{ /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */ - const int foo = 10; -} - -; return 0; } -EOF -if { (eval echo configure:1520: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_c_const=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_c_const=no -fi -rm -f conftest* -fi - -echo "$ac_t""$ac_cv_c_const" 1>&6 -if test $ac_cv_c_const = no; then - cat >> confdefs.h <<\EOF -#define const -EOF - -fi - -echo $ac_n "checking for inline""... $ac_c" 1>&6 -echo "configure:1541: checking for inline" >&5 -if eval "test \"`echo '$''{'ac_cv_c_inline'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - ac_cv_c_inline=no -for ac_kw in inline __inline__ __inline; do - cat > conftest.$ac_ext <<EOF -#line 1548 "configure" -#include "confdefs.h" - -int main() { -} $ac_kw foo() { -; return 0; } -EOF -if { (eval echo configure:1555: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_c_inline=$ac_kw; break -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 -fi -rm -f conftest* -done - -fi - -echo "$ac_t""$ac_cv_c_inline" 1>&6 -case "$ac_cv_c_inline" in - inline | yes) ;; - no) cat >> confdefs.h <<\EOF -#define inline -EOF - ;; - *) cat >> confdefs.h <<EOF -#define inline $ac_cv_c_inline -EOF - ;; -esac - - -echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 -echo "configure:1582: checking for ANSI C header files" >&5 -if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 1587 "configure" -#include "confdefs.h" -#include <stdlib.h> -#include <stdarg.h> -#include <string.h> -#include <float.h> -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1595: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` -if test -z "$ac_err"; then - rm -rf conftest* - ac_cv_header_stdc=yes -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_header_stdc=no -fi -rm -f conftest* - -if test $ac_cv_header_stdc = yes; then - # SunOS 4.x string.h does not declare mem*, contrary to ANSI. -cat > conftest.$ac_ext <<EOF -#line 1612 "configure" -#include "confdefs.h" -#include <string.h> -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "memchr" >/dev/null 2>&1; then - : -else - rm -rf conftest* - ac_cv_header_stdc=no -fi -rm -f conftest* - -fi - -if test $ac_cv_header_stdc = yes; then - # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. -cat > conftest.$ac_ext <<EOF -#line 1630 "configure" -#include "confdefs.h" -#include <stdlib.h> -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "free" >/dev/null 2>&1; then - : -else - rm -rf conftest* - ac_cv_header_stdc=no -fi -rm -f conftest* - -fi - -if test $ac_cv_header_stdc = yes; then - # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. -if test "$cross_compiling" = yes; then - : -else - cat > conftest.$ac_ext <<EOF -#line 1651 "configure" -#include "confdefs.h" -#include <ctype.h> -#define ISLOWER(c) ('a' <= (c) && (c) <= 'z') -#define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) -#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) -int main () { int i; for (i = 0; i < 256; i++) -if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); -exit (0); } - -EOF -if { (eval echo configure:1662: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null -then - : -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - ac_cv_header_stdc=no -fi -rm -fr conftest* -fi - -fi -fi - -echo "$ac_t""$ac_cv_header_stdc" 1>&6 -if test $ac_cv_header_stdc = yes; then - cat >> confdefs.h <<\EOF -#define STDC_HEADERS 1 -EOF - -fi - -ac_header_dirent=no -for ac_hdr in dirent.h sys/ndir.h sys/dir.h ndir.h -do -ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for $ac_hdr that defines DIR""... $ac_c" 1>&6 -echo "configure:1690: checking for $ac_hdr that defines DIR" >&5 -if eval "test \"`echo '$''{'ac_cv_header_dirent_$ac_safe'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 1695 "configure" -#include "confdefs.h" -#include <sys/types.h> -#include <$ac_hdr> -int main() { -DIR *dirp = 0; -; return 0; } -EOF -if { (eval echo configure:1703: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - eval "ac_cv_header_dirent_$ac_safe=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_dirent_$ac_safe=no" -fi -rm -f conftest* -fi -if eval "test \"`echo '$ac_cv_header_dirent_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` - cat >> confdefs.h <<EOF -#define $ac_tr_hdr 1 -EOF - ac_header_dirent=$ac_hdr; break -else - echo "$ac_t""no" 1>&6 -fi -done -# Two versions of opendir et al. are in -ldir and -lx on SCO Xenix. -if test $ac_header_dirent = dirent.h; then -echo $ac_n "checking for opendir in -ldir""... $ac_c" 1>&6 -echo "configure:1728: checking for opendir in -ldir" >&5 -ac_lib_var=`echo dir'_'opendir | sed 'y%./+-%__p_%'` -if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - ac_save_LIBS="$LIBS" -LIBS="-ldir $LIBS" -cat > conftest.$ac_ext <<EOF -#line 1736 "configure" -#include "confdefs.h" -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char opendir(); - -int main() { -opendir() -; return 0; } -EOF -if { (eval echo configure:1747: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -LIBS="$ac_save_LIBS" - -fi -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then - echo "$ac_t""yes" 1>&6 - LIBS="$LIBS -ldir" -else - echo "$ac_t""no" 1>&6 -fi - -else -echo $ac_n "checking for opendir in -lx""... $ac_c" 1>&6 -echo "configure:1769: checking for opendir in -lx" >&5 -ac_lib_var=`echo x'_'opendir | sed 'y%./+-%__p_%'` -if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - ac_save_LIBS="$LIBS" -LIBS="-lx $LIBS" -cat > conftest.$ac_ext <<EOF -#line 1777 "configure" -#include "confdefs.h" -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char opendir(); - -int main() { -opendir() -; return 0; } -EOF -if { (eval echo configure:1788: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -LIBS="$ac_save_LIBS" - -fi -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then - echo "$ac_t""yes" 1>&6 - LIBS="$LIBS -lx" -else - echo "$ac_t""no" 1>&6 -fi - -fi - -echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6 -echo "configure:1811: checking whether time.h and sys/time.h may both be included" >&5 -if eval "test \"`echo '$''{'ac_cv_header_time'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 1816 "configure" -#include "confdefs.h" -#include <sys/types.h> -#include <sys/time.h> -#include <time.h> -int main() { -struct tm *tp; -; return 0; } -EOF -if { (eval echo configure:1825: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_header_time=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_header_time=no -fi -rm -f conftest* -fi - -echo "$ac_t""$ac_cv_header_time" 1>&6 -if test $ac_cv_header_time = yes; then - cat >> confdefs.h <<\EOF -#define TIME_WITH_SYS_TIME 1 -EOF - -fi - -echo $ac_n "checking for sys/wait.h that is POSIX.1 compatible""... $ac_c" 1>&6 -echo "configure:1846: checking for sys/wait.h that is POSIX.1 compatible" >&5 -if eval "test \"`echo '$''{'ac_cv_header_sys_wait_h'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 1851 "configure" -#include "confdefs.h" -#include <sys/types.h> -#include <sys/wait.h> -#ifndef WEXITSTATUS -#define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8) -#endif -#ifndef WIFEXITED -#define WIFEXITED(stat_val) (((stat_val) & 255) == 0) -#endif -int main() { -int s; -wait (&s); -s = WIFEXITED (s) ? WEXITSTATUS (s) : 1; -; return 0; } -EOF -if { (eval echo configure:1867: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_header_sys_wait_h=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_header_sys_wait_h=no -fi -rm -f conftest* -fi - -echo "$ac_t""$ac_cv_header_sys_wait_h" 1>&6 -if test $ac_cv_header_sys_wait_h = yes; then - cat >> confdefs.h <<\EOF -#define HAVE_SYS_WAIT_H 1 -EOF - -fi - -for ac_hdr in libc.h limits.h malloc.h memory.h string.h regex.h rxposix.h rx/rxposix.h sys/ioctl.h sys/select.h sys/time.h sys/timeb.h sys/times.h sys/types.h sys/utime.h time.h unistd.h utime.h -do -ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:1891: checking for $ac_hdr" >&5 -if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 1896 "configure" -#include "confdefs.h" -#include <$ac_hdr> -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1901: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -fi -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` - cat >> confdefs.h <<EOF -#define $ac_tr_hdr 1 -EOF - -else - echo "$ac_t""no" 1>&6 -fi -done - - - for ac_hdr in libc.h unistd.h -do -ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:1932: checking for $ac_hdr" >&5 -if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 1937 "configure" -#include "confdefs.h" -#include <$ac_hdr> -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1942: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -fi -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` - cat >> confdefs.h <<EOF -#define $ac_tr_hdr 1 -EOF - -else - echo "$ac_t""no" 1>&6 -fi -done - - echo $ac_n "checking "whether libc.h and unistd.h can be included together"""... $ac_c" 1>&6 -echo "configure:1969: checking "whether libc.h and unistd.h can be included together"" >&5 -if eval "test \"`echo '$''{'guile_cv_header_libc_with_unistd'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - - if test "$ac_cv_header_libc_h" = "no"; then - guile_cv_header_libc_with_unistd="no" - elif test "$ac_cv_header_unistd.h" = "no"; then - guile_cv_header_libc_with_unistd="yes" - else - cat > conftest.$ac_ext <<EOF -#line 1980 "configure" -#include "confdefs.h" - -# include <libc.h> -# include <unistd.h> - -int main() { - -; return 0; } -EOF -if { (eval echo configure:1990: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - guile_cv_header_libc_with_unistd=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - guile_cv_header_libc_with_unistd=no - -fi -rm -f conftest* - fi - - -fi - -echo "$ac_t""$guile_cv_header_libc_with_unistd" 1>&6 - if test "$guile_cv_header_libc_with_unistd" = yes; then - cat >> confdefs.h <<\EOF -#define LIBC_H_WITH_UNISTD_H 1 -EOF - - fi - - - -echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6 -echo "configure:2017: checking for uid_t in sys/types.h" >&5 -if eval "test \"`echo '$''{'ac_cv_type_uid_t'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 2022 "configure" -#include "confdefs.h" -#include <sys/types.h> -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "uid_t" >/dev/null 2>&1; then - rm -rf conftest* - ac_cv_type_uid_t=yes -else - rm -rf conftest* - ac_cv_type_uid_t=no -fi -rm -f conftest* - -fi - -echo "$ac_t""$ac_cv_type_uid_t" 1>&6 -if test $ac_cv_type_uid_t = no; then - cat >> confdefs.h <<\EOF -#define uid_t int -EOF - - cat >> confdefs.h <<\EOF -#define gid_t int -EOF - -fi - -echo $ac_n "checking type of array argument to getgroups""... $ac_c" 1>&6 -echo "configure:2051: checking type of array argument to getgroups" >&5 -if eval "test \"`echo '$''{'ac_cv_type_getgroups'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - if test "$cross_compiling" = yes; then - ac_cv_type_getgroups=cross -else - cat > conftest.$ac_ext <<EOF -#line 2059 "configure" -#include "confdefs.h" - -/* Thanks to Mike Rendell for this test. */ -#include <sys/types.h> -#define NGID 256 -#undef MAX -#define MAX(x, y) ((x) > (y) ? (x) : (y)) -main() -{ - gid_t gidset[NGID]; - int i, n; - union { gid_t gval; long lval; } val; - - val.lval = -1; - for (i = 0; i < NGID; i++) - gidset[i] = val.gval; - n = getgroups (sizeof (gidset) / MAX (sizeof (int), sizeof (gid_t)) - 1, - gidset); - /* Exit non-zero if getgroups seems to require an array of ints. This - happens when gid_t is short but getgroups modifies an array of ints. */ - exit ((n > 0 && gidset[n] != val.gval) ? 1 : 0); -} - -EOF -if { (eval echo configure:2084: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null -then - ac_cv_type_getgroups=gid_t -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - ac_cv_type_getgroups=int -fi -rm -fr conftest* -fi - -if test $ac_cv_type_getgroups = cross; then - cat > conftest.$ac_ext <<EOF -#line 2098 "configure" -#include "confdefs.h" -#include <unistd.h> -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "getgroups.*int.*gid_t" >/dev/null 2>&1; then - rm -rf conftest* - ac_cv_type_getgroups=gid_t -else - rm -rf conftest* - ac_cv_type_getgroups=int -fi -rm -f conftest* - -fi -fi - -echo "$ac_t""$ac_cv_type_getgroups" 1>&6 -cat >> confdefs.h <<EOF -#define GETGROUPS_T $ac_cv_type_getgroups -EOF - - -echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6 -echo "configure:2122: checking return type of signal handlers" >&5 -if eval "test \"`echo '$''{'ac_cv_type_signal'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 2127 "configure" -#include "confdefs.h" -#include <sys/types.h> -#include <signal.h> -#ifdef signal -#undef signal -#endif -#ifdef __cplusplus -extern "C" void (*signal (int, void (*)(int)))(int); -#else -void (*signal ()) (); -#endif - -int main() { -int i; -; return 0; } -EOF -if { (eval echo configure:2144: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_type_signal=void -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_type_signal=int -fi -rm -f conftest* -fi - -echo "$ac_t""$ac_cv_type_signal" 1>&6 -cat >> confdefs.h <<EOF -#define RETSIGTYPE $ac_cv_type_signal -EOF - - -echo $ac_n "checking for mode_t""... $ac_c" 1>&6 -echo "configure:2163: checking for mode_t" >&5 -if eval "test \"`echo '$''{'ac_cv_type_mode_t'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 2168 "configure" -#include "confdefs.h" -#include <sys/types.h> -#if STDC_HEADERS -#include <stdlib.h> -#include <stddef.h> -#endif -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "mode_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then - rm -rf conftest* - ac_cv_type_mode_t=yes -else - rm -rf conftest* - ac_cv_type_mode_t=no -fi -rm -f conftest* - -fi -echo "$ac_t""$ac_cv_type_mode_t" 1>&6 -if test $ac_cv_type_mode_t = no; then - cat >> confdefs.h <<\EOF -#define mode_t int -EOF - -fi - - -echo $ac_n "checking for main in -lm""... $ac_c" 1>&6 -echo "configure:2197: checking for main in -lm" >&5 -ac_lib_var=`echo m'_'main | sed 'y%./+-%__p_%'` -if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - ac_save_LIBS="$LIBS" -LIBS="-lm $LIBS" -cat > conftest.$ac_ext <<EOF -#line 2205 "configure" -#include "confdefs.h" - -int main() { -main() -; return 0; } -EOF -if { (eval echo configure:2212: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -LIBS="$ac_save_LIBS" - -fi -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_lib=HAVE_LIB`echo m | sed -e 's/[^a-zA-Z0-9_]/_/g' \ - -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` - cat >> confdefs.h <<EOF -#define $ac_tr_lib 1 -EOF - - LIBS="-lm $LIBS" - -else - echo "$ac_t""no" 1>&6 -fi - -for ac_func in gethostbyname -do -echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:2242: checking for $ac_func" >&5 -if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 2247 "configure" -#include "confdefs.h" -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func(); below. */ -#include <assert.h> -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:2270: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* -fi - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` - cat >> confdefs.h <<EOF -#define $ac_tr_func 1 -EOF - -else - echo "$ac_t""no" 1>&6 -fi -done - -if test $ac_cv_func_gethostbyname = no; then - echo $ac_n "checking for gethostbyname in -lnsl""... $ac_c" 1>&6 -echo "configure:2296: checking for gethostbyname in -lnsl" >&5 -ac_lib_var=`echo nsl'_'gethostbyname | sed 'y%./+-%__p_%'` -if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - ac_save_LIBS="$LIBS" -LIBS="-lnsl $LIBS" -cat > conftest.$ac_ext <<EOF -#line 2304 "configure" -#include "confdefs.h" -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char gethostbyname(); - -int main() { -gethostbyname() -; return 0; } -EOF -if { (eval echo configure:2315: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -LIBS="$ac_save_LIBS" - -fi -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_lib=HAVE_LIB`echo nsl | sed -e 's/[^a-zA-Z0-9_]/_/g' \ - -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` - cat >> confdefs.h <<EOF -#define $ac_tr_lib 1 -EOF - - LIBS="-lnsl $LIBS" - -else - echo "$ac_t""no" 1>&6 -fi - -fi -for ac_func in connect -do -echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:2346: checking for $ac_func" >&5 -if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 2351 "configure" -#include "confdefs.h" -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func(); below. */ -#include <assert.h> -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:2374: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* -fi - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` - cat >> confdefs.h <<EOF -#define $ac_tr_func 1 -EOF - -else - echo "$ac_t""no" 1>&6 -fi -done - -if test $ac_cv_func_connect = no; then - echo $ac_n "checking for connect in -lsocket""... $ac_c" 1>&6 -echo "configure:2400: checking for connect in -lsocket" >&5 -ac_lib_var=`echo socket'_'connect | sed 'y%./+-%__p_%'` -if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - ac_save_LIBS="$LIBS" -LIBS="-lsocket $LIBS" -cat > conftest.$ac_ext <<EOF -#line 2408 "configure" -#include "confdefs.h" -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char connect(); - -int main() { -connect() -; return 0; } -EOF -if { (eval echo configure:2419: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -LIBS="$ac_save_LIBS" - -fi -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_lib=HAVE_LIB`echo socket | sed -e 's/[^a-zA-Z0-9_]/_/g' \ - -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` - cat >> confdefs.h <<EOF -#define $ac_tr_lib 1 -EOF - - LIBS="-lsocket $LIBS" - -else - echo "$ac_t""no" 1>&6 -fi - -fi -echo $ac_n "checking for tgoto in -ltermcap""... $ac_c" 1>&6 -echo "configure:2448: checking for tgoto in -ltermcap" >&5 -ac_lib_var=`echo termcap'_'tgoto | sed 'y%./+-%__p_%'` -if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - ac_save_LIBS="$LIBS" -LIBS="-ltermcap $LIBS" -cat > conftest.$ac_ext <<EOF -#line 2456 "configure" -#include "confdefs.h" -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char tgoto(); - -int main() { -tgoto() -; return 0; } -EOF -if { (eval echo configure:2467: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -LIBS="$ac_save_LIBS" - -fi -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_lib=HAVE_LIB`echo termcap | sed -e 's/[^a-zA-Z0-9_]/_/g' \ - -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` - cat >> confdefs.h <<EOF -#define $ac_tr_lib 1 -EOF - - LIBS="-ltermcap $LIBS" - -else - echo "$ac_t""no" 1>&6 -fi - -echo $ac_n "checking for readline in -lreadline""... $ac_c" 1>&6 -echo "configure:2495: checking for readline in -lreadline" >&5 -ac_lib_var=`echo readline'_'readline | sed 'y%./+-%__p_%'` -if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - ac_save_LIBS="$LIBS" -LIBS="-lreadline $LIBS" -cat > conftest.$ac_ext <<EOF -#line 2503 "configure" -#include "confdefs.h" -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char readline(); - -int main() { -readline() -; return 0; } -EOF -if { (eval echo configure:2514: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -LIBS="$ac_save_LIBS" - -fi -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_lib=HAVE_LIB`echo readline | sed -e 's/[^a-zA-Z0-9_]/_/g' \ - -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` - cat >> confdefs.h <<EOF -#define $ac_tr_lib 1 -EOF - - LIBS="-lreadline $LIBS" - -else - echo "$ac_t""no" 1>&6 -fi - -for ac_func in rl_clear_signals rl_cleanup_after_signal -do -echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:2544: checking for $ac_func" >&5 -if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 2549 "configure" -#include "confdefs.h" -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func(); below. */ -#include <assert.h> -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:2572: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* -fi - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` - cat >> confdefs.h <<EOF -#define $ac_tr_func 1 -EOF - -else - echo "$ac_t""no" 1>&6 -fi -done - - -echo $ac_n "checking for rl_getc_function pointer in readline""... $ac_c" 1>&6 -echo "configure:2598: checking for rl_getc_function pointer in readline" >&5 -if eval "test \"`echo '$''{'ac_cv_var_rl_getc_function'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 2603 "configure" -#include "confdefs.h" - -#include <stdio.h> -#include <readline/readline.h> -int main() { -rl_getc_function; -; return 0; } -EOF -if { (eval echo configure:2612: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - ac_cv_var_rl_getc_function=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_var_rl_getc_function=no -fi -rm -f conftest* -fi - -echo "$ac_t""$ac_cv_var_rl_getc_function" 1>&6 -if test "$ac_cv_var_rl_getc_function" = "yes"; then - cat >> confdefs.h <<\EOF -#define HAVE_RL_GETC_FUNCTION 1 -EOF - -fi - -if test $ac_cv_lib_readline_readline = yes -a $ac_cv_var_rl_getc_function = no; then - echo 'Warning: libreadline is too old on your system. Need >= 2.1.' -fi - -# Checks for dynamic linking - -if test "$enable_dynamic_linking" = "yes"; then - -echo $ac_n "checking for dlopen in -ldl""... $ac_c" 1>&6 -echo "configure:2641: checking for dlopen in -ldl" >&5 -ac_lib_var=`echo dl'_'dlopen | sed 'y%./+-%__p_%'` -if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - ac_save_LIBS="$LIBS" -LIBS="-ldl $LIBS" -cat > conftest.$ac_ext <<EOF -#line 2649 "configure" -#include "confdefs.h" -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char dlopen(); - -int main() { -dlopen() -; return 0; } -EOF -if { (eval echo configure:2660: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -LIBS="$ac_save_LIBS" - -fi -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_lib=HAVE_LIB`echo dl | sed -e 's/[^a-zA-Z0-9_]/_/g' \ - -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` - cat >> confdefs.h <<EOF -#define $ac_tr_lib 1 -EOF - - LIBS="-ldl $LIBS" - -else - echo "$ac_t""no" 1>&6 -fi - -if test "$ac_cv_lib_dl_dlopen" = "yes"; then - for ac_func in dlopen -do -echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:2691: checking for $ac_func" >&5 -if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 2696 "configure" -#include "confdefs.h" -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func(); below. */ -#include <assert.h> -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:2719: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* -fi - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` - cat >> confdefs.h <<EOF -#define $ac_tr_func 1 -EOF - -else - echo "$ac_t""no" 1>&6 -fi -done - - cat >> confdefs.h <<\EOF -#define DYNAMIC_LINKING 1 -EOF - -else -echo $ac_n "checking for dld_link in -ldld""... $ac_c" 1>&6 -echo "configure:2749: checking for dld_link in -ldld" >&5 -ac_lib_var=`echo dld'_'dld_link | sed 'y%./+-%__p_%'` -if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - ac_save_LIBS="$LIBS" -LIBS="-ldld $LIBS" -cat > conftest.$ac_ext <<EOF -#line 2757 "configure" -#include "confdefs.h" -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char dld_link(); - -int main() { -dld_link() -; return 0; } -EOF -if { (eval echo configure:2768: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -LIBS="$ac_save_LIBS" - -fi -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_lib=HAVE_LIB`echo dld | sed -e 's/[^a-zA-Z0-9_]/_/g' \ - -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` - cat >> confdefs.h <<EOF -#define $ac_tr_lib 1 -EOF - - LIBS="-ldld $LIBS" - -else - echo "$ac_t""no" 1>&6 -fi - -if test "$ac_cv_lib_dld_dld_link" = "yes"; then - cat >> confdefs.h <<\EOF -#define DYNAMIC_LINKING 1 -EOF - -else -for ac_func in shl_load -do -echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:2804: checking for $ac_func" >&5 -if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 2809 "configure" -#include "confdefs.h" -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func(); below. */ -#include <assert.h> -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:2832: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* -fi - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` - cat >> confdefs.h <<EOF -#define $ac_tr_func 1 -EOF - -else - echo "$ac_t""no" 1>&6 -fi -done - -if test "$ac_cv_func_shl_load" = "yes"; then - cat >> confdefs.h <<\EOF -#define DYNAMIC_LINKING 1 -EOF - -else -for ac_func in dlopen -do -echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:2865: checking for $ac_func" >&5 -if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 2870 "configure" -#include "confdefs.h" -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func(); below. */ -#include <assert.h> -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:2893: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* -fi - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` - cat >> confdefs.h <<EOF -#define $ac_tr_func 1 -EOF - -else - echo "$ac_t""no" 1>&6 -fi -done - -if test "$ac_cv_func_dlopen" = "yes"; then - cat >> confdefs.h <<\EOF -#define DYNAMIC_LINKING 1 -EOF - -fi -fi -fi -fi - -fi - - - echo $ac_n "checking for underscore before symbols""... $ac_c" 1>&6 -echo "configure:2931: checking for underscore before symbols" >&5 - if eval "test \"`echo '$''{'guile_cv_uscore'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - - echo "main(){int i=1;} - fnord(){int i=23; int ltuae=42;}" > conftest.c - ${CC} conftest.c > /dev/null - if (nm a.out | grep _fnord) > /dev/null; then - guile_cv_uscore=yes - else - guile_cv_uscore=no - fi -fi - - echo "$ac_t""$guile_cv_uscore" 1>&6 - rm -f conftest.c a.out - - if test $guile_cv_uscore = yes; then - cat >> confdefs.h <<\EOF -#define USCORE 1 -EOF - - - if test $ac_cv_func_dlopen = yes -o $ac_cv_lib_dl_dlopen = yes ; then - echo $ac_n "checking whether dlsym always adds an underscore for us""... $ac_c" 1>&6 -echo "configure:2957: checking whether dlsym always adds an underscore for us" >&5 - if eval "test \"`echo '$''{'guile_cv_dlsym_adds_uscore'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - if test "$cross_compiling" = yes; then - guile_cv_dlsym_adds_uscore=no -else - cat > conftest.$ac_ext <<EOF -#line 2965 "configure" -#include "confdefs.h" - -#include <dlfcn.h> -#include <stdio.h> -fnord() { int i=42;} -main() { void *self, *ptr1, *ptr2; self=dlopen(NULL,RTLD_LAZY); - if(self) { ptr1=dlsym(self,"fnord"); ptr2=dlsym(self,"_fnord"); - if(ptr1 && !ptr2) exit(0); } exit(1); } - -EOF -if { (eval echo configure:2976: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null -then - guile_cv_dlsym_adds_uscore=yes - cat >> confdefs.h <<\EOF -#define DLSYM_ADDS_USCORE 1 -EOF - -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - guile_cv_dlsym_adds_uscore=no -fi -rm -fr conftest* -fi - -fi - - - echo "$ac_t""$guile_cv_dlsym_adds_uscore" 1>&6 - fi - fi - - -for ac_func in ctermid ftime getcwd geteuid gethostent gettimeofday lstat mkdir mknod nice readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction strftime strptime symlink sync tcgetpgrp tcsetpgrp times uname waitpid bzero strdup system usleep -do -echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:3003: checking for $ac_func" >&5 -if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3008 "configure" -#include "confdefs.h" -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func(); below. */ -#include <assert.h> -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:3031: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* -fi - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` - cat >> confdefs.h <<EOF -#define $ac_tr_func 1 -EOF - -else - echo "$ac_t""no" 1>&6 -fi -done - - -### Some systems don't declare some functions. On such systems, we -### need to at least provide our own K&R-style declarations. - -### GUILE_FUNC_DECLARED(function, headerfile) - -### Check for a declaration of FUNCTION in HEADERFILE; if it is -### not there, #define MISSING_FUNCTION_DECL. - - - - echo $ac_n "checking for strptime declaration""... $ac_c" 1>&6 -echo "configure:3067: checking for strptime declaration" >&5 -if eval "test \"`echo '$''{'guile_cv_func_strptime_declared'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3072 "configure" -#include "confdefs.h" -#include <time.h> -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "strptime" >/dev/null 2>&1; then - rm -rf conftest* - guile_cv_func_strptime_declared=yes -else - rm -rf conftest* - guile_cv_func_strptime_declared=no -fi -rm -f conftest* - -fi - -echo "$ac_t""$guile_cv_func_strptime_declared" 1>&6 - if test x$guile_cv_func_strptime_declared = xno; then - cat >> confdefs.h <<\EOF -#define MISSING_STRPTIME_DECL 1 -EOF - - fi - - - echo $ac_n "checking for bzero declaration""... $ac_c" 1>&6 -echo "configure:3098: checking for bzero declaration" >&5 -if eval "test \"`echo '$''{'guile_cv_func_bzero_declared'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3103 "configure" -#include "confdefs.h" -#include <string.h> -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "bzero" >/dev/null 2>&1; then - rm -rf conftest* - guile_cv_func_bzero_declared=yes -else - rm -rf conftest* - guile_cv_func_bzero_declared=no -fi -rm -f conftest* - -fi - -echo "$ac_t""$guile_cv_func_bzero_declared" 1>&6 - if test x$guile_cv_func_bzero_declared = xno; then - cat >> confdefs.h <<\EOF -#define MISSING_BZERO_DECL 1 -EOF - - fi - - - echo $ac_n "checking for sleep declaration""... $ac_c" 1>&6 -echo "configure:3129: checking for sleep declaration" >&5 -if eval "test \"`echo '$''{'guile_cv_func_sleep_declared'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3134 "configure" -#include "confdefs.h" -#include <unistd.h> -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "sleep" >/dev/null 2>&1; then - rm -rf conftest* - guile_cv_func_sleep_declared=yes -else - rm -rf conftest* - guile_cv_func_sleep_declared=no -fi -rm -f conftest* - -fi - -echo "$ac_t""$guile_cv_func_sleep_declared" 1>&6 - if test x$guile_cv_func_sleep_declared = xno; then - cat >> confdefs.h <<\EOF -#define MISSING_SLEEP_DECL 1 -EOF - - fi - - - echo $ac_n "checking for usleep declaration""... $ac_c" 1>&6 -echo "configure:3160: checking for usleep declaration" >&5 -if eval "test \"`echo '$''{'guile_cv_func_usleep_declared'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3165 "configure" -#include "confdefs.h" -#include <unistd.h> -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "usleep" >/dev/null 2>&1; then - rm -rf conftest* - guile_cv_func_usleep_declared=yes -else - rm -rf conftest* - guile_cv_func_usleep_declared=no -fi -rm -f conftest* - -fi - -echo "$ac_t""$guile_cv_func_usleep_declared" 1>&6 - if test x$guile_cv_func_usleep_declared = xno; then - cat >> confdefs.h <<\EOF -#define MISSING_USLEEP_DECL 1 -EOF - - fi - - -### On some systems usleep has no return value. If it does have one, -### we'd like to return it; otherwise, we'll fake it. -echo $ac_n "checking return type of usleep""... $ac_c" 1>&6 -echo "configure:3193: checking return type of usleep" >&5 -if eval "test \"`echo '$''{'guile_cv_func_usleep_return_type'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3198 "configure" -#include "confdefs.h" -#include </usr/include/unistd.h> -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "void[ ]+usleep" >/dev/null 2>&1; then - rm -rf conftest* - guile_cv_func_usleep_return_type=void -else - rm -rf conftest* - guile_cv_func_usleep_return_type=int -fi -rm -f conftest* - -fi - -echo "$ac_t""$guile_cv_func_usleep_return_type" 1>&6 -case "$guile_cv_func_usleep_return_type" in - "void" ) - cat >> confdefs.h <<\EOF -#define USLEEP_RETURNS_VOID 1 -EOF - - ;; -esac - - -ac_safe=`echo "sys/un.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for sys/un.h""... $ac_c" 1>&6 -echo "configure:3227: checking for sys/un.h" >&5 -if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3232 "configure" -#include "confdefs.h" -#include <sys/un.h> -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3237: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -fi -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - have_sys_un_h=1 -else - echo "$ac_t""no" 1>&6 -fi - -if test -n "$have_sys_un_h" ; then -cat >> confdefs.h <<\EOF -#define HAVE_UNIX_DOMAIN_SOCKETS 1 -EOF - -fi - -for ac_func in socketpair getgroups setpwent pause tzset -do -echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:3268: checking for $ac_func" >&5 -if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3273 "configure" -#include "confdefs.h" -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func(); below. */ -#include <assert.h> -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:3296: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* -fi - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` - cat >> confdefs.h <<EOF -#define $ac_tr_func 1 -EOF - -else - echo "$ac_t""no" 1>&6 -fi -done - - - - - -for ac_func in sethostent endhostent getnetent setnetent endnetent getprotoent endprotoent getservent endservent getnetbyaddr getnetbyname inet_lnaof inet_makeaddr inet_netof -do -echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:3327: checking for $ac_func" >&5 -if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3332 "configure" -#include "confdefs.h" -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func(); below. */ -#include <assert.h> -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:3355: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* -fi - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` - cat >> confdefs.h <<EOF -#define $ac_tr_func 1 -EOF - -else - echo "$ac_t""no" 1>&6 -fi -done - - - -echo $ac_n "checking for restartable system calls""... $ac_c" 1>&6 -echo "configure:3382: checking for restartable system calls" >&5 -if eval "test \"`echo '$''{'scm_cv_restarts'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - if test $ac_cv_func_sigaction = yes; then - cat > conftest.$ac_ext <<EOF -#line 3388 "configure" -#include "confdefs.h" -#include <signal.h> -int main() { -int a = SA_RESTART -; return 0; } -EOF -if { (eval echo configure:3395: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - scm_cv_restarts=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - scm_cv_restarts=no -fi -rm -f conftest* - else - scm_cv_restarts=no - fi -fi - -echo "$ac_t""$scm_cv_restarts" 1>&6 -if test $scm_cv_restarts = yes; then - cat >> confdefs.h <<\EOF -#define HAVE_RESTARTS 1 -EOF - -fi - -if test "$ac_cv_header_regex_h" = yes || - test "$ac_cv_header_rxposix_h" = yes || - test "$ac_cv_header_rx_rxposix_h" = yes; then - echo $ac_n "checking for regcomp""... $ac_c" 1>&6 -echo "configure:3422: checking for regcomp" >&5 -if eval "test \"`echo '$''{'ac_cv_func_regcomp_norx'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3427 "configure" -#include "confdefs.h" -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char regcomp(); below. */ -#include <assert.h> -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char regcomp(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_regcomp) || defined (__stub___regcomp) -choke me -#else -regcomp(); -#endif - -; return 0; } -EOF -if { (eval echo configure:3450: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_func_regcomp_norx=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_regcomp_norx=no" -fi -rm -f conftest* -fi - -if eval "test \"`echo '$ac_cv_func_'regcomp'_'norx`\" = yes"; then - echo "$ac_t""yes" 1>&6 - LIBOBJS="regex-posix.o $LIBOBJS" -else - echo "$ac_t""no" 1>&6 -echo $ac_n "checking for main in -lrx""... $ac_c" 1>&6 -echo "configure:3468: checking for main in -lrx" >&5 -ac_lib_var=`echo rx'_'main | sed 'y%./+-%__p_%'` -if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - ac_save_LIBS="$LIBS" -LIBS="-lrx $LIBS" -cat > conftest.$ac_ext <<EOF -#line 3476 "configure" -#include "confdefs.h" - -int main() { -main() -; return 0; } -EOF -if { (eval echo configure:3483: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -LIBS="$ac_save_LIBS" - -fi -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_lib=HAVE_LIB`echo rx | sed -e 's/[^a-zA-Z0-9_]/_/g' \ - -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` - cat >> confdefs.h <<EOF -#define $ac_tr_lib 1 -EOF - - LIBS="-lrx $LIBS" - -else - echo "$ac_t""no" 1>&6 -fi - - echo $ac_n "checking for regcomp""... $ac_c" 1>&6 -echo "configure:3511: checking for regcomp" >&5 -if eval "test \"`echo '$''{'ac_cv_func_regcomp_rx'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3516 "configure" -#include "confdefs.h" -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char regcomp(); below. */ -#include <assert.h> -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char regcomp(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_regcomp) || defined (__stub___regcomp) -choke me -#else -regcomp(); -#endif - -; return 0; } -EOF -if { (eval echo configure:3539: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_func_regcomp_rx=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_regcomp_rx=no" -fi -rm -f conftest* -fi - -if eval "test \"`echo '$ac_cv_func_'regcomp'_'rx`\" = yes"; then - echo "$ac_t""yes" 1>&6 - LIBOBJS="regex-posix.o $LIBOBJS" -else - echo "$ac_t""no" 1>&6 -fi - - -fi - - if test "$ac_cv_func_regcomp_norx" = yes || - test "$ac_cv_func_regcomp_rx" = yes; then - cat >> confdefs.h <<\EOF -#define HAVE_REGCOMP 1 -EOF - - fi -fi - -for ac_func in inet_aton putenv strerror -do -echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:3573: checking for $ac_func" >&5 -if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3578 "configure" -#include "confdefs.h" -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func(); below. */ -#include <assert.h> -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:3601: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* -fi - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` - cat >> confdefs.h <<EOF -#define $ac_tr_func 1 -EOF - -else - echo "$ac_t""no" 1>&6 -LIBOBJS="$LIBOBJS ${ac_func}.o" -fi -done - - - -# When testing for the presence of alloca, we need to add alloca.o -# explicitly to LIBOBJS to make sure that it is translated to -# `alloca.lo' for libtool later on. This can and should be done more cleanly. -# The Ultrix 4.2 mips builtin alloca declared by alloca.h only works -# for constant arguments. Useless! -echo $ac_n "checking for working alloca.h""... $ac_c" 1>&6 -echo "configure:3634: checking for working alloca.h" >&5 -if eval "test \"`echo '$''{'ac_cv_header_alloca_h'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3639 "configure" -#include "confdefs.h" -#include <alloca.h> -int main() { -char *p = alloca(2 * sizeof(int)); -; return 0; } -EOF -if { (eval echo configure:3646: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - ac_cv_header_alloca_h=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_header_alloca_h=no -fi -rm -f conftest* -fi - -echo "$ac_t""$ac_cv_header_alloca_h" 1>&6 -if test $ac_cv_header_alloca_h = yes; then - cat >> confdefs.h <<\EOF -#define HAVE_ALLOCA_H 1 -EOF - -fi - -echo $ac_n "checking for alloca""... $ac_c" 1>&6 -echo "configure:3667: checking for alloca" >&5 -if eval "test \"`echo '$''{'ac_cv_func_alloca_works'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3672 "configure" -#include "confdefs.h" - -#ifdef __GNUC__ -# define alloca __builtin_alloca -#else -# if HAVE_ALLOCA_H -# include <alloca.h> -# else -# ifdef _AIX - #pragma alloca -# else -# ifndef alloca /* predefined by HP cc +Olibcalls */ -char *alloca (); -# endif -# endif -# endif -#endif - -int main() { -char *p = (char *) alloca(1); -; return 0; } -EOF -if { (eval echo configure:3695: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - ac_cv_func_alloca_works=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_func_alloca_works=no -fi -rm -f conftest* -fi - -echo "$ac_t""$ac_cv_func_alloca_works" 1>&6 -if test $ac_cv_func_alloca_works = yes; then - cat >> confdefs.h <<\EOF -#define HAVE_ALLOCA 1 -EOF - -fi - -if test $ac_cv_func_alloca_works = no; then - # The SVR3 libPW and SVR4 libucb both contain incompatible functions - # that cause trouble. Some versions do not even contain alloca or - # contain a buggy version. If you still want to use their alloca, - # use ar to extract alloca.o from them instead of compiling alloca.c. - ALLOCA=alloca.o - cat >> confdefs.h <<\EOF -#define C_ALLOCA 1 -EOF - - -echo $ac_n "checking whether alloca needs Cray hooks""... $ac_c" 1>&6 -echo "configure:3727: checking whether alloca needs Cray hooks" >&5 -if eval "test \"`echo '$''{'ac_cv_os_cray'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3732 "configure" -#include "confdefs.h" -#if defined(CRAY) && ! defined(CRAY2) -webecray -#else -wenotbecray -#endif - -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "webecray" >/dev/null 2>&1; then - rm -rf conftest* - ac_cv_os_cray=yes -else - rm -rf conftest* - ac_cv_os_cray=no -fi -rm -f conftest* - -fi - -echo "$ac_t""$ac_cv_os_cray" 1>&6 -if test $ac_cv_os_cray = yes; then -for ac_func in _getb67 GETB67 getb67; do - echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:3757: checking for $ac_func" >&5 -if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3762 "configure" -#include "confdefs.h" -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $ac_func(); below. */ -#include <assert.h> -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:3785: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* -fi - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - cat >> confdefs.h <<EOF -#define CRAY_STACKSEG_END $ac_func -EOF - - break -else - echo "$ac_t""no" 1>&6 -fi - -done -fi - -echo $ac_n "checking stack direction for C alloca""... $ac_c" 1>&6 -echo "configure:3812: checking stack direction for C alloca" >&5 -if eval "test \"`echo '$''{'ac_cv_c_stack_direction'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - if test "$cross_compiling" = yes; then - ac_cv_c_stack_direction=0 -else - cat > conftest.$ac_ext <<EOF -#line 3820 "configure" -#include "confdefs.h" -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; -} -main () -{ - exit (find_stack_direction() < 0); -} -EOF -if { (eval echo configure:3839: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null -then - ac_cv_c_stack_direction=1 -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - ac_cv_c_stack_direction=-1 -fi -rm -fr conftest* -fi - -fi - -echo "$ac_t""$ac_cv_c_stack_direction" 1>&6 -cat >> confdefs.h <<EOF -#define STACK_DIRECTION $ac_cv_c_stack_direction -EOF - -fi - -if test "$ALLOCA" = "alloca.o"; then LIBOBJS="alloca.o $LIBOBJS"; fi - -echo $ac_n "checking for st_rdev in struct stat""... $ac_c" 1>&6 -echo "configure:3863: checking for st_rdev in struct stat" >&5 -if eval "test \"`echo '$''{'ac_cv_struct_st_rdev'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3868 "configure" -#include "confdefs.h" -#include <sys/types.h> -#include <sys/stat.h> -int main() { -struct stat s; s.st_rdev; -; return 0; } -EOF -if { (eval echo configure:3876: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_struct_st_rdev=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_struct_st_rdev=no -fi -rm -f conftest* -fi - -echo "$ac_t""$ac_cv_struct_st_rdev" 1>&6 -if test $ac_cv_struct_st_rdev = yes; then - cat >> confdefs.h <<\EOF -#define HAVE_ST_RDEV 1 -EOF - -fi - -echo $ac_n "checking for st_blksize in struct stat""... $ac_c" 1>&6 -echo "configure:3897: checking for st_blksize in struct stat" >&5 -if eval "test \"`echo '$''{'ac_cv_struct_st_blksize'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3902 "configure" -#include "confdefs.h" -#include <sys/types.h> -#include <sys/stat.h> -int main() { -struct stat s; s.st_blksize; -; return 0; } -EOF -if { (eval echo configure:3910: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_struct_st_blksize=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_struct_st_blksize=no -fi -rm -f conftest* -fi - -echo "$ac_t""$ac_cv_struct_st_blksize" 1>&6 -if test $ac_cv_struct_st_blksize = yes; then - cat >> confdefs.h <<\EOF -#define HAVE_ST_BLKSIZE 1 -EOF - -fi - - -# We could use AC_STRUCT_ST_BLOCKS here, but that adds fileblocks.o to -# LIBOBJS, which we don't need. This seems more direct. -echo $ac_n "checking for st_blocks in struct stat""... $ac_c" 1>&6 -echo "configure:3934: checking for st_blocks in struct stat" >&5 -if eval "test \"`echo '$''{'ac_cv_struct_st_blocks'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3939 "configure" -#include "confdefs.h" -#include <sys/types.h> -#include <sys/stat.h> -int main() { -struct stat s; s.st_blocks; -; return 0; } -EOF -if { (eval echo configure:3947: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_struct_st_blocks=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_struct_st_blocks=no -fi -rm -f conftest* -fi - -echo "$ac_t""$ac_cv_struct_st_blocks" 1>&6 -if test $ac_cv_struct_st_blocks = yes; then - cat >> confdefs.h <<\EOF -#define HAVE_ST_BLOCKS 1 -EOF - -fi - -echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6 -echo "configure:3968: checking whether struct tm is in sys/time.h or time.h" >&5 -if eval "test \"`echo '$''{'ac_cv_struct_tm'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 3973 "configure" -#include "confdefs.h" -#include <sys/types.h> -#include <time.h> -int main() { -struct tm *tp; tp->tm_sec; -; return 0; } -EOF -if { (eval echo configure:3981: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_struct_tm=time.h -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_struct_tm=sys/time.h -fi -rm -f conftest* -fi - -echo "$ac_t""$ac_cv_struct_tm" 1>&6 -if test $ac_cv_struct_tm = sys/time.h; then - cat >> confdefs.h <<\EOF -#define TM_IN_SYS_TIME 1 -EOF - -fi - -echo $ac_n "checking for tm_zone in struct tm""... $ac_c" 1>&6 -echo "configure:4002: checking for tm_zone in struct tm" >&5 -if eval "test \"`echo '$''{'ac_cv_struct_tm_zone'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 4007 "configure" -#include "confdefs.h" -#include <sys/types.h> -#include <$ac_cv_struct_tm> -int main() { -struct tm tm; tm.tm_zone; -; return 0; } -EOF -if { (eval echo configure:4015: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_struct_tm_zone=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_struct_tm_zone=no -fi -rm -f conftest* -fi - -echo "$ac_t""$ac_cv_struct_tm_zone" 1>&6 -if test "$ac_cv_struct_tm_zone" = yes; then - cat >> confdefs.h <<\EOF -#define HAVE_TM_ZONE 1 -EOF - -else - echo $ac_n "checking for tzname""... $ac_c" 1>&6 -echo "configure:4035: checking for tzname" >&5 -if eval "test \"`echo '$''{'ac_cv_var_tzname'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 4040 "configure" -#include "confdefs.h" -#include <time.h> -#ifndef tzname /* For SGI. */ -extern char *tzname[]; /* RS6000 and others reject char **tzname. */ -#endif -int main() { -atoi(*tzname); -; return 0; } -EOF -if { (eval echo configure:4050: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - ac_cv_var_tzname=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_var_tzname=no -fi -rm -f conftest* -fi - -echo "$ac_t""$ac_cv_var_tzname" 1>&6 - if test $ac_cv_var_tzname = yes; then - cat >> confdefs.h <<\EOF -#define HAVE_TZNAME 1 -EOF - - fi -fi - - - echo $ac_n "checking whether we need POSIX to get struct utimbuf""... $ac_c" 1>&6 -echo "configure:4073: checking whether we need POSIX to get struct utimbuf" >&5 -if eval "test \"`echo '$''{'guile_cv_struct_utimbuf_needs_posix'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 4078 "configure" -#include "confdefs.h" - -#ifdef __EMX__ -#include <sys/utime.h> -#else -#include <utime.h> -#endif -struct utime blah; - -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:4090: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out` -if test -z "$ac_err"; then - rm -rf conftest* - guile_cv_struct_utimbuf_needs_posix=no -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - guile_cv_struct_utimbuf_needs_posix=yes -fi -rm -f conftest* -fi - -echo "$ac_t""$guile_cv_struct_utimbuf_needs_posix" 1>&6 - if test "$guile_cv_struct_utimbuf_needs_posix" = yes; then - cat >> confdefs.h <<\EOF -#define UTIMBUF_NEEDS_POSIX 1 -EOF - - fi - -#-------------------------------------------------------------------- -# -# Which way does the stack grow? -# -#-------------------------------------------------------------------- - -if test "$cross_compiling" = yes; then - echo "configure: warning: Guessing that stack grows down -- see scmconfig.h.in" 1>&2 -else - cat > conftest.$ac_ext <<EOF -#line 4123 "configure" -#include "confdefs.h" -aux (l) unsigned long l; - { int x; exit (l >= ((unsigned long)&x)); } - main () { int q; aux((unsigned long)&q); } -EOF -if { (eval echo configure:4129: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null -then - cat >> confdefs.h <<\EOF -#define SCM_STACK_GROWS_UP 1 -EOF - -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 -fi -rm -fr conftest* -fi - - -echo $ac_n "checking whether floats fit in longs""... $ac_c" 1>&6 -echo "configure:4144: checking whether floats fit in longs" >&5 -if eval "test \"`echo '$''{'guile_cv_type_float_fits_long'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - if test "$cross_compiling" = yes; then - guile_cv_type_float_fits_long=guess-yes -else - cat > conftest.$ac_ext <<EOF -#line 4152 "configure" -#include "confdefs.h" -main () { exit (sizeof(float) > sizeof(long)); } -EOF -if { (eval echo configure:4156: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null -then - guile_cv_type_float_fits_long=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - guile_cv_type_float_fits_long=no -fi -rm -fr conftest* -fi - -fi - -echo "$ac_t""$guile_cv_type_float_fits_long" 1>&6 -case $guile_cv_type_float_fits_long in - "yes" ) - cat >> confdefs.h <<\EOF -#define SCM_SINGLES 1 -EOF - - ;; - "guess-yes" ) - cat >> confdefs.h <<\EOF -#define SCM_SINGLES 1 -EOF - - echo "configure: warning: guessing that sizeof(long) == sizeof(float)" 1>&2 - echo "configure: warning: see SCM_SINGLES in scmconfig.h.in" 1>&2 - ;; -esac - - -echo $ac_n "checking for struct linger""... $ac_c" 1>&6 -echo "configure:4190: checking for struct linger" >&5 -if eval "test \"`echo '$''{'scm_cv_struct_linger'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 4195 "configure" -#include "confdefs.h" - -#include <sys/types.h> -#include <sys/socket.h> -int main() { -struct linger lgr; lgr.l_linger = 100 -; return 0; } -EOF -if { (eval echo configure:4204: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - scm_cv_struct_linger="yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - scm_cv_struct_linger="no" -fi -rm -f conftest* -fi - -echo "$ac_t""$scm_cv_struct_linger" 1>&6 -if test $scm_cv_struct_linger = yes; then - cat >> confdefs.h <<\EOF -#define HAVE_STRUCT_LINGER 1 -EOF - -fi - -#-------------------------------------------------------------------- -# -# How can you violate a stdio abstraction by setting a stream's fd? -# -#-------------------------------------------------------------------- - -echo $ac_n "checking how to set a stream file descriptor""... $ac_c" 1>&6 -echo "configure:4231: checking how to set a stream file descriptor" >&5 -if eval "test \"`echo '$''{'scm_cv_fd_setter'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 4236 "configure" -#include "confdefs.h" -#include <stdio.h> -int main() { -stdout->_file = 1 -; return 0; } -EOF -if { (eval echo configure:4243: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - scm_cv_fd_setter="_file" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - cat > conftest.$ac_ext <<EOF -#line 4251 "configure" -#include "confdefs.h" -#include <stdio.h> -int main() { -stdout->__file = 1 -; return 0; } -EOF -if { (eval echo configure:4258: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - scm_cv_fd_setter="__file" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - cat > conftest.$ac_ext <<EOF -#line 4266 "configure" -#include "confdefs.h" -#include <stdio.h> -int main() { -stdout->_fileno = 1 -; return 0; } -EOF -if { (eval echo configure:4273: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - scm_cv_fd_setter="_fileno" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - scm_cv_fd_setter="" -fi -rm -f conftest* -fi -rm -f conftest* -fi -rm -f conftest* -fi - - -if test "$scm_cv_fd_setter"; then - echo "$ac_t""$scm_cv_fd_setter" 1>&6 - cat >> confdefs.h <<EOF -#define FD_SETTER $scm_cv_fd_setter -EOF - -else - echo "$ac_t""we couldn't do it!" 1>&6 -fi - -#-------------------------------------------------------------------- -# How to find out whether a FILE structure contains buffered data. -# From Tk we have the following list: -# _cnt: Most UNIX systems -# __cnt: HPUX and SCO -# _r: BSD -# readCount: Sprite -# Or, in GNU libc there are two fields, _gptr and _egptr, which -# have to be compared. -# These can also be known as _IO_read_ptr and _IO_read_end. -#-------------------------------------------------------------------- - -echo $ac_n "checking how to get buffer char count from FILE structure""... $ac_c" 1>&6 -echo "configure:4313: checking how to get buffer char count from FILE structure" >&5 -if eval "test \"`echo '$''{'scm_cv_struct_file_count'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 4318 "configure" -#include "confdefs.h" -#include <stdio.h> -int main() { -FILE *f = stdin; f->_cnt = 0 -; return 0; } -EOF -if { (eval echo configure:4325: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - scm_cv_struct_file_count="_cnt" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - cat > conftest.$ac_ext <<EOF -#line 4333 "configure" -#include "confdefs.h" -#include <stdio.h> -int main() { -FILE *f = stdin; f->__cnt = 0 -; return 0; } -EOF -if { (eval echo configure:4340: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - scm_cv_struct_file_count="__cnt" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - cat > conftest.$ac_ext <<EOF -#line 4348 "configure" -#include "confdefs.h" -#include <stdio.h> -int main() { -FILE *f = stdin; f->_r = 0 -; return 0; } -EOF -if { (eval echo configure:4355: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - scm_cv_struct_file_count="_r" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - cat > conftest.$ac_ext <<EOF -#line 4363 "configure" -#include "confdefs.h" -#include <stdio.h> -int main() { -FILE *f = stdin; f->readCount = 0 -; return 0; } -EOF -if { (eval echo configure:4370: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - scm_cv_struct_file_count="readCount" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - scm_cv_struct_file_count="" -fi -rm -f conftest* -fi -rm -f conftest* -fi -rm -f conftest* -fi -rm -f conftest* -fi - -if test "$scm_cv_struct_file_count"; then - echo "$ac_t""$scm_cv_struct_file_count" 1>&6 - cat >> confdefs.h <<EOF -#define FILE_CNT_FIELD $scm_cv_struct_file_count -EOF - -else -if eval "test \"`echo '$''{'scm_cv_struct_file_gptr'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 4399 "configure" -#include "confdefs.h" -#include <stdio.h> -int main() { -FILE *f = stdin; f->_gptr = f->egptr; -; return 0; } -EOF -if { (eval echo configure:4406: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - scm_cv_struct_file_gptr=1 -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - scm_cv_struct_file_gptr="" -fi -rm -f conftest* -fi - -if test "$scm_cv_struct_gptr"; then - echo "$ac_t""gptr" 1>&6 - cat >> confdefs.h <<EOF -#define FILE_CNT_GPTR $scm_cv_struct_file_gptr -EOF - -else -if eval "test \"`echo '$''{'scm_cv_struct_file_readptr'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - cat > conftest.$ac_ext <<EOF -#line 4429 "configure" -#include "confdefs.h" -#include <stdio.h> -int main() { -FILE *f = stdin; f->_IO_read_ptr = f->_IO_read_end; -; return 0; } -EOF -if { (eval echo configure:4436: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - scm_cv_struct_file_readptr=1 -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 -fi -rm -f conftest* -fi - -if test "$scm_cv_struct_file_readptr"; then - echo "$ac_t""read_ptr" 1>&6 - cat >> confdefs.h <<EOF -#define FILE_CNT_READPTR $scm_cv_struct_file_readptr -EOF - -else - echo "$ac_t""we couldn't do it!" 1>&6 -fi -fi -fi - -#-------------------------------------------------------------------- -# -# Flags for thread support -# -#-------------------------------------------------------------------- - -### What thread package has the user asked for? -# Check whether --with-threads or --without-threads was given. -if test "${with_threads+set}" = set; then - withval="$with_threads" - : -else - with_threads=no -fi - - -### Turn $with_threads into either the name of a threads package, like -### `qt', or `no', meaning that threads should not be supported. -echo $ac_n "checking whether to support threads""... $ac_c" 1>&6 -echo "configure:4477: checking whether to support threads" >&5 -case "$with_threads" in - "yes" | "qt" | "coop" | "") - with_threads=qt - ;; - "no" ) - ;; - * ) - { echo "configure: error: invalid value for --with-threads: $with_threads" 1>&2; exit 1; } - ;; -esac -echo "$ac_t""$with_threads" 1>&6 - -## Make sure the threads package we've chosen is actually supported on -## the present platform. -case "${with_threads}" in - "qt" ) - ## This configures the QuickThreads package, and sets or clears - ## the THREAD_PACKAGE variable if qthreads don't configure - ## correctly. - - - - echo $ac_n "checking QuickThreads configuration""... $ac_c" 1>&6 -echo "configure:4501: checking QuickThreads configuration" >&5 - # How can we refer to the qt source directory from within the qt build - # directory? For headers, we can rely on the fact that the qt src - # directory appears in the #include path. - qtsrcdir="`(cd $srcdir; pwd)`/qt" - - - THREAD_PACKAGE=QT - 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= - ;; - 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 - ;; - *) - echo "Unknown configuration; threads package disabled" - THREAD_PACKAGE="" - ;; - esac - - - # Did configuration succeed? - if test -n "$THREAD_PACKAGE"; then - echo "$ac_t""$port_name" 1>&6 - QTHREAD_LTLIBS=libqthreads.la - THREAD_CPPFLAGS="-I$qtsrcdir -I../qt" - THREAD_LIBS_LOCAL="../qt/libqthreads.la" - THREAD_LIBS_INSTALLED="-lqthreads" - else - echo "$ac_t""none; disabled" 1>&6 - fi - - - - - - - - - - - - ;; -esac - -## If we're using threads, bring in some other parts of Guile which -## work with them. -if test "${THREAD_PACKAGE}" != "" ; then - cat >> confdefs.h <<\EOF -#define USE_THREADS 1 -EOF - - - ## Include the Guile thread interface in the library... - LIBOBJS="$LIBOBJS threads.o" - - ## ... and tell it which package to talk to. - case "${THREAD_PACKAGE}" in - "QT" ) - cat >> confdefs.h <<\EOF -#define USE_COOP_THREADS 1 -EOF - - ;; - * ) - { echo "configure: error: invalid value for THREAD_PACKAGE: ${THREAD_PACKAGE}" 1>&2; exit 1; } - ;; - esac - - ## Bring in scm_internal_select, if appropriate. - if test $ac_cv_func_gettimeofday = yes && - test $ac_cv_func_select = yes; then - LIBOBJS="$LIBOBJS iselect.o" - cat >> confdefs.h <<\EOF -#define GUILE_ISELECT 1 -EOF - - fi -fi - -## If we're using GCC, ask for aggressive warnings. -case "$GCC" in - yes ) - ## We had -Wstrict-prototypes in here for a bit, but Guile does too - ## much stuff with generic function pointers for that to really be - ## less than exasperating. - CFLAGS="$CFLAGS -Wall -Wpointer-arith -Wmissing-prototypes" ;; -esac - -for ac_prog in mawk gawk nawk awk -do -# Extract the first word of "$ac_prog", so it can be a program name with args. -set dummy $ac_prog; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:4632: checking for $ac_word" >&5 -if eval "test \"`echo '$''{'ac_cv_prog_AWK'+set}'`\" = set"; then - echo $ac_n "(cached) $ac_c" 1>&6 -else - if test -n "$AWK"; then - ac_cv_prog_AWK="$AWK" # Let the user override the test. -else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" - for ac_dir in $PATH; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - ac_cv_prog_AWK="$ac_prog" - break - fi - done - IFS="$ac_save_ifs" -fi -fi -AWK="$ac_cv_prog_AWK" -if test -n "$AWK"; then - echo "$ac_t""$AWK" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi - -test -n "$AWK" && break -done - - -## 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. -LIBLOBJS="`echo ${LIBOBJS} | sed 's/\.o/.lo/g'`" - - - - - -GUILE_LIBS="$LDFLAGS $THREAD_LIBS_INSTALLED $LIBS" - - -GUILE_STAMP="`date`" - - - - - -trap '' 1 2 15 -cat > confcache <<\EOF -# This file is a shell script that caches the results of configure -# tests run on this system so they can be shared between configure -# scripts and configure runs. It is not useful on other systems. -# If it contains results you don't want to keep, you may remove or edit it. -# -# By default, configure uses ./config.cache as the cache file, -# creating it if it does not exist already. You can give configure -# the --cache-file=FILE option to use a different cache file; that is -# what configure does when it calls configure scripts in -# subdirectories, so they share the cache. -# Giving --cache-file=/dev/null disables caching, for debugging configure. -# config.status only pays attention to the cache file if you give it the -# --recheck option to rerun configure. -# -EOF -# The following way of writing the cache mishandles newlines in values, -# but we know of no workaround that is simple, portable, and efficient. -# So, don't put newlines in cache variables' values. -# Ultrix sh set writes to stderr and can't be redirected directly, -# and sets the high bit in the cache file unless we assign to the vars. -(set) 2>&1 | - case `(ac_space=' '; set) 2>&1` in - *ac_space=\ *) - # `set' does not quote correctly, so add quotes (double-quote substitution - # turns \\\\ into \\, and sed turns \\ into \). - sed -n \ - -e "s/'/'\\\\''/g" \ - -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p" - ;; - *) - # `set' quotes correctly as required by POSIX, so do not add quotes. - sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p' - ;; - esac >> confcache -if cmp -s $cache_file confcache; then - : -else - if test -w $cache_file; then - echo "updating cache $cache_file" - cat confcache > $cache_file - else - echo "not updating unwritable cache $cache_file" - fi -fi -rm -f confcache - -trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 - -test "x$prefix" = xNONE && prefix=$ac_default_prefix -# Let make expand exec_prefix. -test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' - -# Any assignment to VPATH causes Sun make to only execute -# the first set of double-colon rules, so remove it if not needed. -# If there is a colon in the path, we need to keep it. -if test "x$srcdir" = x.; then - ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d' -fi - -trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15 - -DEFS=-DHAVE_CONFIG_H - -# Without the "./", some shells look in PATH for config.status. -: ${CONFIG_STATUS=./config.status} - -echo creating $CONFIG_STATUS -rm -f $CONFIG_STATUS -cat > $CONFIG_STATUS <<EOF -#! /bin/sh -# Generated automatically by configure. -# Run this file to recreate the current configuration. -# This directory was configured as follows, -# on host `(hostname || uname -n) 2>/dev/null | sed 1q`: -# -# $0 $ac_configure_args -# -# Compiler output produced by configure, useful for debugging -# configure, is in ./config.log if it exists. - -ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]" -for ac_option -do - case "\$ac_option" in - -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) - echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" - exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; - -version | --version | --versio | --versi | --vers | --ver | --ve | --v) - echo "$CONFIG_STATUS generated by autoconf version 2.12" - exit 0 ;; - -help | --help | --hel | --he | --h) - echo "\$ac_cs_usage"; exit 0 ;; - *) echo "\$ac_cs_usage"; exit 1 ;; - esac -done - -ac_given_srcdir=$srcdir -ac_given_INSTALL="$INSTALL" - -trap 'rm -fr `echo "Makefile libguile/Makefile libguile/guile-snarf libguile/versiondat.h ice-9/Makefile ice-9/version.scm qt/Makefile qt/qt.h qt/md/Makefile qt/time/Makefile guile-config/Makefile doc/Makefile libguile/scmconfig.h" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15 -EOF -cat >> $CONFIG_STATUS <<EOF - -# Protect against being on the right side of a sed subst in config.status. -sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g; - s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF -$ac_vpsub -$extrasub -s%@CFLAGS@%$CFLAGS%g -s%@CPPFLAGS@%$CPPFLAGS%g -s%@CXXFLAGS@%$CXXFLAGS%g -s%@DEFS@%$DEFS%g -s%@LDFLAGS@%$LDFLAGS%g -s%@LIBS@%$LIBS%g -s%@exec_prefix@%$exec_prefix%g -s%@prefix@%$prefix%g -s%@program_transform_name@%$program_transform_name%g -s%@bindir@%$bindir%g -s%@sbindir@%$sbindir%g -s%@libexecdir@%$libexecdir%g -s%@datadir@%$datadir%g -s%@sysconfdir@%$sysconfdir%g -s%@sharedstatedir@%$sharedstatedir%g -s%@localstatedir@%$localstatedir%g -s%@libdir@%$libdir%g -s%@includedir@%$includedir%g -s%@oldincludedir@%$oldincludedir%g -s%@infodir@%$infodir%g -s%@mandir@%$mandir%g -s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g -s%@INSTALL_DATA@%$INSTALL_DATA%g -s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g -s%@PACKAGE@%$PACKAGE%g -s%@VERSION@%$VERSION%g -s%@ACLOCAL@%$ACLOCAL%g -s%@AUTOCONF@%$AUTOCONF%g -s%@AUTOMAKE@%$AUTOMAKE%g -s%@AUTOHEADER@%$AUTOHEADER%g -s%@MAKEINFO@%$MAKEINFO%g -s%@SET_MAKE@%$SET_MAKE%g -s%@MAINT@%$MAINT%g -s%@CC@%$CC%g -s%@CPP@%$CPP%g -s%@host@%$host%g -s%@host_alias@%$host_alias%g -s%@host_cpu@%$host_cpu%g -s%@host_vendor@%$host_vendor%g -s%@host_os@%$host_os%g -s%@RANLIB@%$RANLIB%g -s%@LD@%$LD%g -s%@NM@%$NM%g -s%@LN_S@%$LN_S%g -s%@LIBTOOL@%$LIBTOOL%g -s%@LIBOBJS@%$LIBOBJS%g -s%@ALLOCA@%$ALLOCA%g -s%@QTHREAD_LTLIBS@%$QTHREAD_LTLIBS%g -s%@qtmd_h@%$qtmd_h%g -s%@qtmds_s@%$qtmds_s%g -s%@qtmdc_c@%$qtmdc_c%g -s%@qtdmdb_s@%$qtdmdb_s%g -s%@THREAD_PACKAGE@%$THREAD_PACKAGE%g -s%@THREAD_CPPFLAGS@%$THREAD_CPPFLAGS%g -s%@THREAD_LIBS_LOCAL@%$THREAD_LIBS_LOCAL%g -s%@THREAD_LIBS_INSTALLED@%$THREAD_LIBS_INSTALLED%g -s%@AWK@%$AWK%g -s%@GUILE_MAJOR_VERSION@%$GUILE_MAJOR_VERSION%g -s%@GUILE_MINOR_VERSION@%$GUILE_MINOR_VERSION%g -s%@GUILE_VERSION@%$GUILE_VERSION%g -s%@GUILE_LIBS@%$GUILE_LIBS%g -s%@GUILE_STAMP@%$GUILE_STAMP%g -s%@LIBLOBJS@%$LIBLOBJS%g - -CEOF -EOF - -cat >> $CONFIG_STATUS <<\EOF - -# Split the substitutions into bite-sized pieces for seds with -# small command number limits, like on Digital OSF/1 and HP-UX. -ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script. -ac_file=1 # Number of current file. -ac_beg=1 # First line for current file. -ac_end=$ac_max_sed_cmds # Line after last line for current file. -ac_more_lines=: -ac_sed_cmds="" -while $ac_more_lines; do - if test $ac_beg -gt 1; then - sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file - else - sed "${ac_end}q" conftest.subs > conftest.s$ac_file - fi - if test ! -s conftest.s$ac_file; then - ac_more_lines=false - rm -f conftest.s$ac_file - else - if test -z "$ac_sed_cmds"; then - ac_sed_cmds="sed -f conftest.s$ac_file" - else - ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file" - fi - ac_file=`expr $ac_file + 1` - ac_beg=$ac_end - ac_end=`expr $ac_end + $ac_max_sed_cmds` - fi -done -if test -z "$ac_sed_cmds"; then - ac_sed_cmds=cat -fi -EOF - -cat >> $CONFIG_STATUS <<EOF - -CONFIG_FILES=\${CONFIG_FILES-"Makefile libguile/Makefile libguile/guile-snarf libguile/versiondat.h ice-9/Makefile ice-9/version.scm qt/Makefile qt/qt.h qt/md/Makefile qt/time/Makefile guile-config/Makefile doc/Makefile"} -EOF -cat >> $CONFIG_STATUS <<\EOF -for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then - # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". - case "$ac_file" in - *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` - ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; - *) ac_file_in="${ac_file}.in" ;; - esac - - # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories. - - # Remove last slash and all that follows it. Not all systems have dirname. - ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` - if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then - # The file is in a subdirectory. - test ! -d "$ac_dir" && mkdir "$ac_dir" - ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`" - # A "../" for each directory in $ac_dir_suffix. - ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'` - else - ac_dir_suffix= ac_dots= - fi - - case "$ac_given_srcdir" in - .) srcdir=. - if test -z "$ac_dots"; then top_srcdir=. - else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;; - /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;; - *) # Relative path. - srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix" - top_srcdir="$ac_dots$ac_given_srcdir" ;; - esac - - case "$ac_given_INSTALL" in - [/$]*) INSTALL="$ac_given_INSTALL" ;; - *) INSTALL="$ac_dots$ac_given_INSTALL" ;; - esac - - echo creating "$ac_file" - rm -f "$ac_file" - configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure." - case "$ac_file" in - *Makefile*) ac_comsub="1i\\ -# $configure_input" ;; - *) ac_comsub= ;; - esac - - ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` - sed -e "$ac_comsub -s%@configure_input@%$configure_input%g -s%@srcdir@%$srcdir%g -s%@top_srcdir@%$top_srcdir%g -s%@INSTALL@%$INSTALL%g -" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file -fi; done -rm -f conftest.s* - -# These sed commands are passed to sed as "A NAME B NAME C VALUE D", where -# NAME is the cpp macro being defined and VALUE is the value it is being given. -# -# ac_d sets the value in "#define NAME VALUE" lines. -ac_dA='s%^\([ ]*\)#\([ ]*define[ ][ ]*\)' -ac_dB='\([ ][ ]*\)[^ ]*%\1#\2' -ac_dC='\3' -ac_dD='%g' -# ac_u turns "#undef NAME" with trailing blanks into "#define NAME VALUE". -ac_uA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)' -ac_uB='\([ ]\)%\1#\2define\3' -ac_uC=' ' -ac_uD='\4%g' -# ac_e turns "#undef NAME" without trailing blanks into "#define NAME VALUE". -ac_eA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)' -ac_eB='$%\1#\2define\3' -ac_eC=' ' -ac_eD='%g' - -if test "${CONFIG_HEADERS+set}" != set; then -EOF -cat >> $CONFIG_STATUS <<EOF - CONFIG_HEADERS="libguile/scmconfig.h" -EOF -cat >> $CONFIG_STATUS <<\EOF -fi -for ac_file in .. $CONFIG_HEADERS; do if test "x$ac_file" != x..; then - # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". - case "$ac_file" in - *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` - ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; - *) ac_file_in="${ac_file}.in" ;; - esac - - echo creating $ac_file - - rm -f conftest.frag conftest.in conftest.out - ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` - cat $ac_file_inputs > conftest.in - -EOF - -# Transform confdefs.h into a sed script conftest.vals that substitutes -# the proper values into config.h.in to produce config.h. And first: -# Protect against being on the right side of a sed subst in config.status. -# Protect against being in an unquoted here document in config.status. -rm -f conftest.vals -cat > conftest.hdr <<\EOF -s/[\\&%]/\\&/g -s%[\\$`]%\\&%g -s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD}%gp -s%ac_d%ac_u%gp -s%ac_u%ac_e%gp -EOF -sed -n -f conftest.hdr confdefs.h > conftest.vals -rm -f conftest.hdr - -# This sed command replaces #undef with comments. This is necessary, for -# example, in the case of _POSIX_SOURCE, which is predefined and required -# on some systems where configure will not decide to define it. -cat >> conftest.vals <<\EOF -s%^[ ]*#[ ]*undef[ ][ ]*[a-zA-Z_][a-zA-Z_0-9]*%/* & */% -EOF - -# Break up conftest.vals because some shells have a limit on -# the size of here documents, and old seds have small limits too. - -rm -f conftest.tail -while : -do - ac_lines=`grep -c . conftest.vals` - # grep -c gives empty output for an empty file on some AIX systems. - if test -z "$ac_lines" || test "$ac_lines" -eq 0; then break; fi - # Write a limited-size here document to conftest.frag. - echo ' cat > conftest.frag <<CEOF' >> $CONFIG_STATUS - sed ${ac_max_here_lines}q conftest.vals >> $CONFIG_STATUS - echo 'CEOF - sed -f conftest.frag conftest.in > conftest.out - rm -f conftest.in - mv conftest.out conftest.in -' >> $CONFIG_STATUS - sed 1,${ac_max_here_lines}d conftest.vals > conftest.tail - rm -f conftest.vals - mv conftest.tail conftest.vals -done -rm -f conftest.vals - -cat >> $CONFIG_STATUS <<\EOF - rm -f conftest.frag conftest.h - echo "/* $ac_file. Generated automatically by configure. */" > conftest.h - cat conftest.in >> conftest.h - rm -f conftest.in - if cmp -s $ac_file conftest.h 2>/dev/null; then - echo "$ac_file is unchanged" - rm -f conftest.h - else - # Remove last slash and all that follows it. Not all systems have dirname. - ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` - if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then - # The file is in a subdirectory. - test ! -d "$ac_dir" && mkdir "$ac_dir" - fi - rm -f $ac_file - mv conftest.h $ac_file - fi -fi; done - -EOF -cat >> $CONFIG_STATUS <<EOF - -EOF -cat >> $CONFIG_STATUS <<\EOF -test -z "$CONFIG_HEADERS" || echo timestamp > libguile/stamp-h -chmod +x libguile/guile-snarf -exit 0 -EOF -chmod +x $CONFIG_STATUS -rm -fr confdefs* $ac_clean_files -test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1 - - diff --git a/configure.in b/configure.in deleted file mode 100644 index a8f607c8d..000000000 --- a/configure.in +++ /dev/null @@ -1,464 +0,0 @@ -dnl configuration script for Guile -dnl Process this file with autoconf to produce configure. -AC_INIT(Makefile.in) -. $srcdir/GUILE-VERSION -AM_INIT_AUTOMAKE($PACKAGE, $VERSION, no-define) -AM_MAINTAINER_MODE -AM_CONFIG_HEADER(libguile/scmconfig.h) - -#-------------------------------------------------------------------- -# -# User options -# -#-------------------------------------------------------------------- - -AC_ARG_ENABLE(dynamic-linking, - [ --enable-dynamic-linking Include support for dynamic linking],, - enable_dynamic_linking=yes) - -AC_ARG_ENABLE(guile-debug, -[ --enable-guile-debug Include internal debugging functions]) -if test "$enableval" = y || test "$enableval" = yes; then - AC_DEFINE(GUILE_DEBUG) -fi - -dnl The --disable-debug used to control these two. But now they are -dnl a required part of the distribution. -AC_DEFINE(DEBUG_EXTENSIONS) -AC_DEFINE(READER_EXTENSIONS) - -#-------------------------------------------------------------------- - -AC_PROG_CC -AC_PROG_CPP -AM_PROG_LIBTOOL - -AC_AIX -AC_ISC_POSIX -AC_MINIX - -AC_C_CONST -AC_C_INLINE - -AC_HEADER_STDC -AC_HEADER_DIRENT -AC_HEADER_TIME -AC_HEADER_SYS_WAIT -AC_CHECK_HEADERS(libc.h limits.h malloc.h memory.h string.h regex.h rxposix.h rx/rxposix.h sys/ioctl.h sys/select.h sys/time.h sys/timeb.h sys/times.h sys/types.h sys/utime.h time.h unistd.h utime.h) -GUILE_HEADER_LIBC_WITH_UNISTD - -AC_TYPE_GETGROUPS -AC_TYPE_SIGNAL -AC_TYPE_MODE_T - -AC_CHECK_LIB(m, main) -AC_CHECK_FUNCS(gethostbyname) -if test $ac_cv_func_gethostbyname = no; then - AC_CHECK_LIB(nsl, gethostbyname) -fi -AC_CHECK_FUNCS(connect) -if test $ac_cv_func_connect = no; then - AC_CHECK_LIB(socket, connect) -fi -AC_CHECK_LIB(termcap, tgoto) -AC_CHECK_LIB(readline, readline) -AC_CHECK_FUNCS(rl_clear_signals rl_cleanup_after_signal) - -AC_CACHE_CHECK([for rl_getc_function pointer in readline], - ac_cv_var_rl_getc_function, - [AC_TRY_LINK([ -#include <stdio.h> -#include <readline/readline.h>], - [rl_getc_function;], - [ac_cv_var_rl_getc_function=yes], - [ac_cv_var_rl_getc_function=no])]) -if test "$ac_cv_var_rl_getc_function" = "yes"; then - AC_DEFINE(HAVE_RL_GETC_FUNCTION) -fi - -if test $ac_cv_lib_readline_readline = yes -a $ac_cv_var_rl_getc_function = no; then - echo 'Warning: libreadline is too old on your system. Need >= 2.1.' -fi - -# Checks for dynamic linking - -if test "$enable_dynamic_linking" = "yes"; then - -AC_CHECK_LIB(dl,dlopen) -if test "$ac_cv_lib_dl_dlopen" = "yes"; then - AC_CHECK_FUNCS(dlopen) - AC_DEFINE(DYNAMIC_LINKING) -else -AC_CHECK_LIB(dld,dld_link) -if test "$ac_cv_lib_dld_dld_link" = "yes"; then - AC_DEFINE(DYNAMIC_LINKING) -else -AC_CHECK_FUNCS(shl_load) -if test "$ac_cv_func_shl_load" = "yes"; then - AC_DEFINE(DYNAMIC_LINKING) -else -AC_CHECK_FUNCS(dlopen) -if test "$ac_cv_func_dlopen" = "yes"; then - AC_DEFINE(DYNAMIC_LINKING) -fi -fi -fi -fi - -fi - -GUILE_DLSYM_USCORE - -AC_CHECK_FUNCS(ctermid ftime getcwd geteuid gethostent gettimeofday lstat mkdir mknod nice readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction strftime strptime symlink sync tcgetpgrp tcsetpgrp times uname waitpid bzero strdup system usleep) - -### Some systems don't declare some functions. On such systems, we -### need to at least provide our own K&R-style declarations. - -### GUILE_FUNC_DECLARED(function, headerfile) - -### Check for a declaration of FUNCTION in HEADERFILE; if it is -### not there, #define MISSING_FUNCTION_DECL. -AC_DEFUN(GUILE_FUNC_DECLARED, [ - AC_CACHE_CHECK(for $1 declaration, guile_cv_func_$1_declared, - AC_EGREP_HEADER($1, $2, - guile_cv_func_$1_declared=yes, - guile_cv_func_$1_declared=no)) - if test [x$guile_cv_func_]$1[_declared] = xno; then - AC_DEFINE([MISSING_]translit($1, [a-z], [A-Z])[_DECL]) - fi -]) - -GUILE_FUNC_DECLARED(strptime, time.h) -GUILE_FUNC_DECLARED(bzero, string.h) -GUILE_FUNC_DECLARED(sleep, unistd.h) -GUILE_FUNC_DECLARED(usleep, unistd.h) - -### On some systems usleep has no return value. If it does have one, -### we'd like to return it; otherwise, we'll fake it. -AC_CACHE_CHECK([return type of usleep], guile_cv_func_usleep_return_type, - [AC_EGREP_HEADER(changequote(<, >)<void[ ]+usleep>changequote([, ]), - /usr/include/unistd.h, - [guile_cv_func_usleep_return_type=void], - [guile_cv_func_usleep_return_type=int])]) -case "$guile_cv_func_usleep_return_type" in - "void" ) - AC_DEFINE(USLEEP_RETURNS_VOID) - ;; -esac - -dnl <GNU-WIN32 hacks> - -AC_CHECK_HEADER(sys/un.h, have_sys_un_h=1) -if test -n "$have_sys_un_h" ; then -AC_DEFINE(HAVE_UNIX_DOMAIN_SOCKETS) -fi - -AC_CHECK_FUNCS(socketpair getgroups setpwent pause tzset) - -dnl I don't know what this prefixing of cygwin32_ is for. -dnl scmconfig.h wasn't updated with the test results. -dnl so use AC_CHECK_FUNCS for now. - -dnl how about: -dnl save confdefs.h -dnl if test $ac_cv_cigwin = yes; then -dnl modify confdefs.h -dnl fi -dnl AC_CHECK_FUNCS... -dnl restore confdefs.h - -dnl cp confdefs.h confdefs.h.bak -dnl for func in sethostent endhostent getnetent setnetent endnetent getprotoent endprotoent getservent endservent getnetbyaddr getnetbyname inet_lnaof inet_makeaddr inet_netof ; do -dnl cp confdefs.h.bak confdefs.h -dnl cat >> confdefs.h << EOF -dnl #ifdef __CYGWIN32__ -dnl #define $func cygwin32_$func -dnl #endif -dnl EOF -dnl AC_CHECK_FUNC($func) -dnl done -dnl cp confdefs.h.bak confdefs.h - -AC_CHECK_FUNCS(sethostent endhostent getnetent setnetent endnetent getprotoent endprotoent getservent endservent getnetbyaddr getnetbyname inet_lnaof inet_makeaddr inet_netof) - -dnl </GNU-WIN32 hacks> - -AC_CACHE_CHECK([for restartable system calls], scm_cv_restarts, - if test $ac_cv_func_sigaction = yes; then - [AC_TRY_COMPILE([#include <signal.h>], - [int a = SA_RESTART], - scm_cv_restarts=yes, - scm_cv_restarts=no)] - else - scm_cv_restarts=no - fi) -if test $scm_cv_restarts = yes; then - AC_DEFINE(HAVE_RESTARTS) -fi - -if test "$ac_cv_header_regex_h" = yes || - test "$ac_cv_header_rxposix_h" = yes || - test "$ac_cv_header_rx_rxposix_h" = yes; then - GUILE_NAMED_CHECK_FUNC(regcomp, norx, [LIBOBJS="regex-posix.o $LIBOBJS"], - [AC_CHECK_LIB(rx, main) - GUILE_NAMED_CHECK_FUNC(regcomp, rx, [LIBOBJS="regex-posix.o $LIBOBJS"])] - ) - dnl The following should not be necessary, but for some reason - dnl autoheader misses it if we don't include it! - if test "$ac_cv_func_regcomp_norx" = yes || - test "$ac_cv_func_regcomp_rx" = yes; then - AC_DEFINE(HAVE_REGCOMP) - fi -fi - -AC_REPLACE_FUNCS(inet_aton putenv strerror) - -# When testing for the presence of alloca, we need to add alloca.o -# explicitly to LIBOBJS to make sure that it is translated to -# `alloca.lo' for libtool later on. This can and should be done more cleanly. -AC_FUNC_ALLOCA -if test "$ALLOCA" = "alloca.o"; then LIBOBJS="alloca.o $LIBOBJS"; fi - -AC_STRUCT_ST_RDEV -AC_STRUCT_ST_BLKSIZE - -# We could use AC_STRUCT_ST_BLOCKS here, but that adds fileblocks.o to -# LIBOBJS, which we don't need. This seems more direct. -AC_CACHE_CHECK([for st_blocks in struct stat], ac_cv_struct_st_blocks, -[AC_TRY_COMPILE([#include <sys/types.h> -#include <sys/stat.h>], [struct stat s; s.st_blocks;], -ac_cv_struct_st_blocks=yes, ac_cv_struct_st_blocks=no)]) -if test $ac_cv_struct_st_blocks = yes; then - AC_DEFINE(HAVE_ST_BLOCKS) -fi - -AC_STRUCT_TIMEZONE -GUILE_STRUCT_UTIMBUF - -#-------------------------------------------------------------------- -# -# Which way does the stack grow? -# -#-------------------------------------------------------------------- - -AC_TRY_RUN(aux (l) unsigned long l; - { int x; exit (l >= ((unsigned long)&x)); } - main () { int q; aux((unsigned long)&q); }, - AC_DEFINE(SCM_STACK_GROWS_UP),,AC_MSG_WARN(Guessing that stack grows down -- see scmconfig.h.in)) - -AC_CACHE_CHECK([whether floats fit in longs], guile_cv_type_float_fits_long, - [AC_TRY_RUN([main () { exit (sizeof(float) > sizeof(long)); }], - [guile_cv_type_float_fits_long=yes], - [guile_cv_type_float_fits_long=no], - [guile_cv_type_float_fits_long=guess-yes])]) -case $guile_cv_type_float_fits_long in - "yes" ) - AC_DEFINE(SCM_SINGLES) - ;; - "guess-yes" ) - AC_DEFINE(SCM_SINGLES) - AC_MSG_WARN([guessing that sizeof(long) == sizeof(float)]) - AC_MSG_WARN([see SCM_SINGLES in scmconfig.h.in]) - ;; -esac - - -AC_MSG_CHECKING(for struct linger) -AC_CACHE_VAL(scm_cv_struct_linger, - AC_TRY_COMPILE([ -#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")) -AC_MSG_RESULT($scm_cv_struct_linger) -if test $scm_cv_struct_linger = yes; then - AC_DEFINE(HAVE_STRUCT_LINGER) -fi - -#-------------------------------------------------------------------- -# -# How can you violate a stdio abstraction by setting a stream's fd? -# -#-------------------------------------------------------------------- - -AC_MSG_CHECKING(how to set a stream file descriptor) -AC_CACHE_VAL(scm_cv_fd_setter, - AC_TRY_COMPILE([#include <stdio.h>], - [stdout->_file = 1], - scm_cv_fd_setter="_file", - AC_TRY_COMPILE([#include <stdio.h>], - [stdout->__file = 1], - scm_cv_fd_setter="__file", - AC_TRY_COMPILE([#include <stdio.h>], - [stdout->_fileno = 1], - scm_cv_fd_setter="_fileno", - scm_cv_fd_setter="")))) - -if test "$scm_cv_fd_setter"; then - AC_MSG_RESULT($scm_cv_fd_setter) - AC_DEFINE_UNQUOTED(FD_SETTER, $scm_cv_fd_setter) -else - AC_MSG_RESULT(we couldn't do it!) -fi - -#-------------------------------------------------------------------- -# How to find out whether a FILE structure contains buffered data. -# From Tk we have the following list: -# _cnt: Most UNIX systems -# __cnt: HPUX and SCO -# _r: BSD -# readCount: Sprite -# Or, in GNU libc there are two fields, _gptr and _egptr, which -# have to be compared. -# These can also be known as _IO_read_ptr and _IO_read_end. -#-------------------------------------------------------------------- - -AC_MSG_CHECKING(how to get buffer char count from FILE structure) -AC_CACHE_VAL(scm_cv_struct_file_count, - AC_TRY_COMPILE([#include <stdio.h>], - [FILE *f = stdin; f->_cnt = 0], - scm_cv_struct_file_count="_cnt", - AC_TRY_COMPILE([#include <stdio.h>], - [FILE *f = stdin; f->__cnt = 0], - scm_cv_struct_file_count="__cnt", - AC_TRY_COMPILE([#include <stdio.h>], - [FILE *f = stdin; f->_r = 0], - scm_cv_struct_file_count="_r", - AC_TRY_COMPILE([#include <stdio.h>], - [FILE *f = stdin; f->readCount = 0], - scm_cv_struct_file_count="readCount", - scm_cv_struct_file_count=""))))) -if test "$scm_cv_struct_file_count"; then - AC_MSG_RESULT($scm_cv_struct_file_count) - AC_DEFINE_UNQUOTED(FILE_CNT_FIELD, $scm_cv_struct_file_count) -else -AC_CACHE_VAL(scm_cv_struct_file_gptr, - AC_TRY_COMPILE([#include <stdio.h>], - [FILE *f = stdin; f->_gptr = f->egptr;], - scm_cv_struct_file_gptr=1, - scm_cv_struct_file_gptr="")) -if test "$scm_cv_struct_gptr"; then - AC_MSG_RESULT(gptr) - AC_DEFINE_UNQUOTED(FILE_CNT_GPTR, $scm_cv_struct_file_gptr) -else -AC_CACHE_VAL(scm_cv_struct_file_readptr, - AC_TRY_COMPILE([#include <stdio.h>], - [FILE *f = stdin; f->_IO_read_ptr = f->_IO_read_end;], - scm_cv_struct_file_readptr=1)) -if test "$scm_cv_struct_file_readptr"; then - AC_MSG_RESULT(read_ptr) - AC_DEFINE_UNQUOTED(FILE_CNT_READPTR, $scm_cv_struct_file_readptr) -else - AC_MSG_RESULT(we couldn't do it!) -fi -fi -fi - -#-------------------------------------------------------------------- -# -# Flags for thread support -# -#-------------------------------------------------------------------- - -### What thread package has the user asked for? -AC_ARG_WITH(threads, [ --with-threads thread interface], - , with_threads=no) - -### Turn $with_threads into either the name of a threads package, like -### `qt', or `no', meaning that threads should not be supported. -AC_MSG_CHECKING(whether to support threads) -case "$with_threads" in - "yes" | "qt" | "coop" | "") - with_threads=qt - ;; - "no" ) - ;; - * ) - AC_MSG_ERROR(invalid value for --with-threads: $with_threads) - ;; -esac -AC_MSG_RESULT($with_threads) - -## Make sure the threads package we've chosen is actually supported on -## the present platform. -case "${with_threads}" in - "qt" ) - ## This configures the QuickThreads package, and sets or clears - ## the THREAD_PACKAGE variable if qthreads don't configure - ## correctly. - QTHREADS_CONFIGURE - ;; -esac - -## If we're using threads, bring in some other parts of Guile which -## work with them. -if test "${THREAD_PACKAGE}" != "" ; then - AC_DEFINE(USE_THREADS, 1) - - ## Include the Guile thread interface in the library... - LIBOBJS="$LIBOBJS threads.o" - - ## ... and tell it which package to talk to. - case "${THREAD_PACKAGE}" in - "QT" ) - AC_DEFINE(USE_COOP_THREADS, 1) - ;; - * ) - AC_MSG_ERROR(invalid value for THREAD_PACKAGE: ${THREAD_PACKAGE}) - ;; - esac - - ## Bring in scm_internal_select, if appropriate. - if test $ac_cv_func_gettimeofday = yes && - test $ac_cv_func_select = yes; then - LIBOBJS="$LIBOBJS iselect.o" - AC_DEFINE(GUILE_ISELECT, 1) - fi -fi - -## If we're using GCC, ask for aggressive warnings. -case "$GCC" in - yes ) - ## We had -Wstrict-prototypes in here for a bit, but Guile does too - ## much stuff with generic function pointers for that to really be - ## less than exasperating. - CFLAGS="$CFLAGS -Wall -Wpointer-arith -Wmissing-prototypes" ;; -esac - -AC_PROG_AWK - -## 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. -LIBLOBJS="`echo ${LIBOBJS} | sed 's/\.o/.lo/g'`" - -AC_SUBST(GUILE_MAJOR_VERSION) -AC_SUBST(GUILE_MINOR_VERSION) -AC_SUBST(GUILE_VERSION) - -dnl Tell guile-config what flags guile users should link against. -GUILE_LIBS="$LDFLAGS $THREAD_LIBS_INSTALLED $LIBS" -AC_SUBST(GUILE_LIBS) - -dnl timestamping the interpreter and scheme libraries: -dnl -dnl Help us notice when we're running one version of the Guile -dnl interpreter against a different version of the ice-9 Scheme code. -dnl This will definitely detect version skew due to differing -dnl snapshots and releases, but may not catch skew for the developers. -dnl Hopefully it will not detect skew when there is none; if that -dnl happens, the warnings will be useless, and we should remove this. -GUILE_STAMP="`date`" -AC_SUBST(GUILE_STAMP) - -AC_SUBST(AWK) -AC_SUBST(LIBLOBJS) - -AC_OUTPUT([Makefile libguile/Makefile libguile/guile-snarf libguile/versiondat.h ice-9/Makefile ice-9/version.scm qt/Makefile qt/qt.h qt/md/Makefile qt/time/Makefile guile-config/Makefile doc/Makefile], [chmod +x libguile/guile-snarf]) - -dnl Local Variables: -dnl comment-start: "dnl " -dnl comment-end: "" -dnl comment-start-skip: "\\bdnl\\b\\s *" -dnl End: diff --git a/doc/.cvsignore b/doc/.cvsignore deleted file mode 100644 index b7d92f588..000000000 --- a/doc/.cvsignore +++ /dev/null @@ -1 +0,0 @@ -data-rep.info diff --git a/doc/ChangeLog b/doc/ChangeLog deleted file mode 100644 index eebc03825..000000000 --- a/doc/ChangeLog +++ /dev/null @@ -1,16 +0,0 @@ -1998-10-08 Jim Blandy <jimb@zwingli.cygnus.com> - - * .cvsignore: New file, containing data-rep.info. I'm not sure - whether we want to check this file into CVS, because it's - generated; if you find compelling reasons it should be, let me - know. - -1998-10-07 Jim Blandy <jimb@zwingli.cygnus.com> - - * New directory for documentation. - * README: New file. - * data-rep.texi: It's not a real manual, but it's better than - nothing. - * Makefile.am, Makefile.in, data-rep.info, data-rep.texi, - mdate-sh, stamp-vti, texinfo.tex, version.texi: The usual support - files. diff --git a/doc/Makefile.am b/doc/Makefile.am deleted file mode 100644 index 2c759c97c..000000000 --- a/doc/Makefile.am +++ /dev/null @@ -1,2 +0,0 @@ -info_TEXINFOS = data-rep.texi -data_rep_TEXINFOS = data-rep.texi version.texi diff --git a/doc/Makefile.in b/doc/Makefile.in deleted file mode 100644 index 0c133a3eb..000000000 --- a/doc/Makefile.in +++ /dev/null @@ -1,335 +0,0 @@ -# Makefile.in generated automatically by automake 1.3 from Makefile.am - -# Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc. -# This Makefile.in 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 program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - - -SHELL = /bin/sh - -srcdir = @srcdir@ -top_srcdir = @top_srcdir@ -VPATH = @srcdir@ -prefix = @prefix@ -exec_prefix = @exec_prefix@ - -bindir = @bindir@ -sbindir = @sbindir@ -libexecdir = @libexecdir@ -datadir = @datadir@ -sysconfdir = @sysconfdir@ -sharedstatedir = @sharedstatedir@ -localstatedir = @localstatedir@ -libdir = @libdir@ -infodir = @infodir@ -mandir = @mandir@ -includedir = @includedir@ -oldincludedir = /usr/include - -DISTDIR = - -pkgdatadir = $(datadir)/@PACKAGE@ -pkglibdir = $(libdir)/@PACKAGE@ -pkgincludedir = $(includedir)/@PACKAGE@ - -top_builddir = .. - -ACLOCAL = @ACLOCAL@ -AUTOCONF = @AUTOCONF@ -AUTOMAKE = @AUTOMAKE@ -AUTOHEADER = @AUTOHEADER@ - -INSTALL = @INSTALL@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_DATA = @INSTALL_DATA@ -INSTALL_SCRIPT = @INSTALL_SCRIPT@ -transform = @program_transform_name@ - -NORMAL_INSTALL = : -PRE_INSTALL = : -POST_INSTALL = : -NORMAL_UNINSTALL = : -PRE_UNINSTALL = : -POST_UNINSTALL = : -host_alias = @host_alias@ -host_triplet = @host@ -AWK = @AWK@ -CC = @CC@ -CPP = @CPP@ -GUILE_LIBS = @GUILE_LIBS@ -GUILE_MAJOR_VERSION = @GUILE_MAJOR_VERSION@ -GUILE_MINOR_VERSION = @GUILE_MINOR_VERSION@ -GUILE_STAMP = @GUILE_STAMP@ -GUILE_VERSION = @GUILE_VERSION@ -LD = @LD@ -LIBLOBJS = @LIBLOBJS@ -LIBTOOL = @LIBTOOL@ -LN_S = @LN_S@ -MAINT = @MAINT@ -MAKEINFO = @MAKEINFO@ -NM = @NM@ -PACKAGE = @PACKAGE@ -QTHREAD_LTLIBS = @QTHREAD_LTLIBS@ -RANLIB = @RANLIB@ -THREAD_CPPFLAGS = @THREAD_CPPFLAGS@ -THREAD_LIBS_INSTALLED = @THREAD_LIBS_INSTALLED@ -THREAD_LIBS_LOCAL = @THREAD_LIBS_LOCAL@ -THREAD_PACKAGE = @THREAD_PACKAGE@ -VERSION = @VERSION@ -qtdmdb_s = @qtdmdb_s@ -qtmd_h = @qtmd_h@ -qtmdc_c = @qtmdc_c@ -qtmds_s = @qtmds_s@ - -info_TEXINFOS = data-rep.texi -data_rep_TEXINFOS = data-rep.texi version.texi -mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs -CONFIG_HEADER = ../libguile/scmconfig.h -CONFIG_CLEAN_FILES = -TEXI2DVI = texi2dvi -TEXINFO_TEX = $(srcdir)/texinfo.tex -INFO_DEPS = data-rep.info -DVIS = data-rep.dvi -TEXINFOS = data-rep.texi -DIST_COMMON = README $(data_rep_TEXINFOS) ChangeLog Makefile.am \ -Makefile.in mdate-sh stamp-vti texinfo.tex version.texi - - -DISTFILES = $(DIST_COMMON) $(SOURCES) $(HEADERS) $(TEXINFOS) $(EXTRA_DIST) - -TAR = tar -GZIP = --best -all: Makefile $(INFO_DEPS) - -.SUFFIXES: -.SUFFIXES: .dvi .info .ps .texi .texinfo .txi -$(srcdir)/Makefile.in: @MAINT@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) - cd $(top_srcdir) && $(AUTOMAKE) --gnu doc/Makefile - -Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status $(BUILT_SOURCES) - cd $(top_builddir) \ - && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status - - -version.texi: @MAINT@stamp-vti - cp $(srcdir)/stamp-vti $(srcdir)/version.texi - -stamp-vti: data-rep.texi $(top_srcdir)/configure.in - @echo "@set UPDATED `cd $(srcdir) \ - && $(SHELL) ./mdate-sh data-rep.texi`" > vti.tmp - @echo "@set EDITION $(VERSION)" >> vti.tmp - @echo "@set VERSION $(VERSION)" >> vti.tmp - @cmp -s vti.tmp $(srcdir)/stamp-vti \ - || (echo "Updating $(srcdir)/stamp-vti"; \ - cp vti.tmp $(srcdir)/stamp-vti) - -@rm -f vti.tmp - -mostlyclean-vti: - -rm -f vti.tmp - -clean-vti: - -distclean-vti: - -maintainer-clean-vti: - -@MAINT@rm -f stamp-vti version.texi - -data-rep.info: data-rep.texi version.texi $(data_rep_TEXINFOS) -data-rep.dvi: data-rep.texi version.texi $(data_rep_TEXINFOS) - - -DVIPS = dvips - -.texi.info: - @cd $(srcdir) && rm -f $@ $@-[0-9] $@-[0-9][0-9] - cd $(srcdir) \ - && $(MAKEINFO) `echo $< | sed 's,.*/,,'` - -.texi.dvi: - TEXINPUTS=$(srcdir):$$TEXINPUTS \ - MAKEINFO='$(MAKEINFO) -I $(srcdir)' $(TEXI2DVI) $< - -.texi: - @cd $(srcdir) && rm -f $@ $@-[0-9] $@-[0-9][0-9] - cd $(srcdir) \ - && $(MAKEINFO) `echo $< | sed 's,.*/,,'` - -.texinfo.info: - @cd $(srcdir) && rm -f $@ $@-[0-9] $@-[0-9][0-9] - cd $(srcdir) \ - && $(MAKEINFO) `echo $< | sed 's,.*/,,'` - -.texinfo: - @cd $(srcdir) && rm -f $@ $@-[0-9] $@-[0-9][0-9] - cd $(srcdir) \ - && $(MAKEINFO) `echo $< | sed 's,.*/,,'` - -.texinfo.dvi: - TEXINPUTS=$(srcdir):$$TEXINPUTS \ - MAKEINFO='$(MAKEINFO) -I $(srcdir)' $(TEXI2DVI) $< - -.txi.info: - @cd $(srcdir) && rm -f $@ $@-[0-9] $@-[0-9][0-9] - cd $(srcdir) \ - && $(MAKEINFO) `echo $< | sed 's,.*/,,'` - -.txi.dvi: - TEXINPUTS=$(srcdir):$$TEXINPUTS \ - MAKEINFO='$(MAKEINFO) -I $(srcdir)' $(TEXI2DVI) $< - -.txi: - @cd $(srcdir) && rm -f $@ $@-[0-9] $@-[0-9][0-9] - cd $(srcdir) \ - && $(MAKEINFO) `echo $< | sed 's,.*/,,'` -.dvi.ps: - $(DVIPS) $< -o $@ - -install-info-am: $(INFO_DEPS) - @$(NORMAL_INSTALL) - $(mkinstalldirs) $(DESTDIR)$(infodir) - @for file in $(INFO_DEPS); do \ - d=$(srcdir); \ - for ifile in `cd $$d && echo $$file $$file-[0-9] $$file-[0-9][0-9]`; do \ - if test -f $$d/$$ifile; then \ - echo " $(INSTALL_DATA) $$d/$$ifile $(DESTDIR)$(infodir)/$$ifile"; \ - $(INSTALL_DATA) $$d/$$ifile $(DESTDIR)$(infodir)/$$ifile; \ - else : ; fi; \ - done; \ - done - @$(POST_INSTALL) - @if $(SHELL) -c 'install-info --version | sed 1q | fgrep -s -v -i debian' >/dev/null 2>&1; then \ - for file in $(INFO_DEPS); do \ - echo " install-info --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/$$file";\ - install-info --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/$$file || :;\ - done; \ - else : ; fi - -uninstall-info: - $(PRE_UNINSTALL) - @if $(SHELL) -c 'install-info --version | sed 1q | fgrep -s -v -i debian' >/dev/null 2>&1; then \ - ii=yes; \ - else ii=; fi; \ - for file in $(INFO_DEPS); do \ - test -z "$ii" \ - || install-info --info-dir=$(DESTDIR)$(infodir) --remove $$file; \ - done - @$(NORMAL_UNINSTALL) - for file in $(INFO_DEPS); do \ - (cd $(DESTDIR)$(infodir) && rm -f $$file $$file-[0-9] $$file-[0-9][0-9]); \ - done - -dist-info: $(INFO_DEPS) - for base in $(INFO_DEPS); do \ - d=$(srcdir); \ - for file in `cd $$d && eval echo $$base*`; do \ - test -f $(distdir)/$$file \ - || ln $$d/$$file $(distdir)/$$file 2> /dev/null \ - || cp -p $$d/$$file $(distdir)/$$file; \ - done; \ - done - -mostlyclean-aminfo: - -rm -f data-rep.aux data-rep.cp data-rep.cps data-rep.dvi data-rep.fn \ - data-rep.fns data-rep.ky data-rep.kys data-rep.ps \ - data-rep.log data-rep.pg data-rep.toc data-rep.tp \ - data-rep.tps data-rep.vr data-rep.vrs data-rep.op data-rep.tr \ - data-rep.cv data-rep.cn - -clean-aminfo: - -distclean-aminfo: - -maintainer-clean-aminfo: - for i in $(INFO_DEPS); do \ - rm -f $$i; \ - if test "`echo $$i-[0-9]*`" != "$$i-[0-9]*"; then \ - rm -f $$i-[0-9]*; \ - fi; \ - done -tags: TAGS -TAGS: - - -distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir) - -subdir = doc - -distdir: $(DISTFILES) - here=`cd $(top_builddir) && pwd`; \ - top_distdir=`cd $(top_distdir) && pwd`; \ - distdir=`cd $(distdir) && pwd`; \ - cd $(top_srcdir) \ - && $(AUTOMAKE) --include-deps --build-dir=$$here --srcdir-name=$(top_srcdir) --output-dir=$$top_distdir --gnu doc/Makefile - @for file in $(DISTFILES); do \ - d=$(srcdir); \ - test -f $(distdir)/$$file \ - || ln $$d/$$file $(distdir)/$$file 2> /dev/null \ - || cp -p $$d/$$file $(distdir)/$$file; \ - done - $(MAKE) top_distdir="$(top_distdir)" distdir="$(distdir)" dist-info -info: $(INFO_DEPS) -dvi: $(DVIS) -check: all - $(MAKE) -installcheck: -install-exec: - @$(NORMAL_INSTALL) - -install-data: install-info-am - @$(NORMAL_INSTALL) - -install: install-exec install-data all - @: - -uninstall: uninstall-info - -install-strip: - $(MAKE) INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' INSTALL_SCRIPT='$(INSTALL_PROGRAM)' install -installdirs: - $(mkinstalldirs) $(DESTDIR)$(infodir) - - -mostlyclean-generic: - -test -z "$(MOSTLYCLEANFILES)" || rm -f $(MOSTLYCLEANFILES) - -clean-generic: - -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) - -distclean-generic: - -rm -f Makefile $(DISTCLEANFILES) - -rm -f config.cache config.log stamp-h stamp-h[0-9]* - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -maintainer-clean-generic: - -test -z "$(MAINTAINERCLEANFILES)" || rm -f $(MAINTAINERCLEANFILES) - -test -z "$(BUILT_SOURCES)" || rm -f $(BUILT_SOURCES) -mostlyclean: mostlyclean-vti mostlyclean-aminfo mostlyclean-generic - -clean: clean-vti clean-aminfo clean-generic mostlyclean - -distclean: distclean-vti distclean-aminfo distclean-generic clean - -rm -f config.status - -rm -f libtool - -maintainer-clean: maintainer-clean-vti maintainer-clean-aminfo \ - maintainer-clean-generic distclean - @echo "This command is intended for maintainers to use;" - @echo "it deletes files that may require special tools to rebuild." - -.PHONY: mostlyclean-vti distclean-vti clean-vti maintainer-clean-vti \ -install-info-am uninstall-info mostlyclean-aminfo distclean-aminfo \ -clean-aminfo maintainer-clean-aminfo tags distdir info dvi installcheck \ -install-exec install-data install uninstall all installdirs \ -mostlyclean-generic distclean-generic clean-generic \ -maintainer-clean-generic clean mostlyclean distclean maintainer-clean - - -# Tell versions [3.59,3.63) of GNU make to not export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: diff --git a/doc/README b/doc/README deleted file mode 100644 index 0d46fb4bf..000000000 --- a/doc/README +++ /dev/null @@ -1,11 +0,0 @@ -This directory contains documentation on the Guile core. - -At the moment, we don't have a full manual on Guile; that's at the -head of our task list. - -The file `data-rep.texi' is an essay on how to write C code that uses -Guile values. If you're interested in writing a application which is -extensible via Guile, this is a good place to start. Make builds the -`info' manual by default, designed to be read on-line; if you want to -print it out, go to the `doc' subdirectory of the tree you're building -in, and run `make data-rep.ps'. diff --git a/doc/data-rep.texi b/doc/data-rep.texi deleted file mode 100644 index c6cd9ad5b..000000000 --- a/doc/data-rep.texi +++ /dev/null @@ -1,1611 +0,0 @@ -\input texinfo -@c -*-texinfo-*- -@c %**start of header -@setfilename data-rep.info -@settitle Data Representation in Guile -@c %**end of header - -@include version.texi - -@dircategory Scheme Programming -@direntry -* data-rep: (data-rep). Data Representation in Guile --- how to use - Guile objects in your C code. -@end direntry - -@setchapternewpage off - -@ifinfo -Data Representation in Guile - -Copyright (C) 1998 Free Software Foundation - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -@ignore -Permission is granted to process this file through TeX and print the -results, provided the printed document carries copying permission -notice identical to this one except for the removal of this paragraph -(this paragraph not being relevant to the printed manual). -@end ignore - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the entire -resulting derived work is distributed under the terms of a permission -notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation approved -by the Free Software Foundation. -@end ifinfo - -@titlepage -@sp 10 -@comment The title is printed in a large font. -@title Data Representation in Guile -@subtitle $Id: data-rep.texi,v 1.1 1998-10-07 07:37:16 jimb Exp $ -@subtitle For use with Guile @value{VERSION} -@author Jim Blandy -@author Free Software Foundation -@author @email{jimb@@red-bean.com} -@c The following two commands start the copyright page. -@page -@vskip 0pt plus 1filll -@vskip 0pt plus 1filll -Copyright @copyright{} 1998 Free Software Foundation - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the entire -resulting derived work is distributed under the terms of a permission -notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation approved -by Free Software Foundation. -@end titlepage - -@c @smallbook -@c @finalout -@headings double - - -@node Top, Data Representation in Scheme, (dir), (dir) -@top Data Representation in Guile - -@ifinfo -This essay is meant to provide the background necessary to read and -write C code that manipulates Scheme values in a way that conforms to -libguile's interface. If you would like to write or maintain a -Guile-based application, this is the first information you need. - -In order to make sense of Guile's SCM_ functions, or read libguile's -source code, it's essential to have a good grasp of how Guile actually -represents Scheme values. Otherwise, a lot of the code, and the -conventions it follows, won't make very much sense. - -We assume you know both C and Scheme, but we do not assume you are -familiar with Guile's C interface. -@end ifinfo - -@menu -* Data Representation in Scheme:: Why things aren't just totally - straightforward, in general terms. -* How Guile does it:: How to write C code that manipulates - Guile values, with an explanation - of Guile's garbage collector. -* Defining New Types (Smobs):: How to extend Guile with your own - application-specific datatypes. -@end menu - -@node Data Representation in Scheme, How Guile does it, Top, Top -@section Data Representation in Scheme - -Scheme is a latently-typed language; this means that the system cannot, -in general, determine the type of a given expression at compile time. -Types only become apparent at run time. Variables do not have fixed -types; a variable may hold a pair at one point, an integer at the next, -and a thousand-element vector later. Instead, values have fixed types. - -In order to implement standard Scheme functions like @code{pair?} and -@code{string?} and provide garbage collection, the representation of -every value must contain enough information to accurately determine its -type at run time. Often, Scheme systems also use this information to -determine whether a program has attempted to apply an operation to an -inappropriately typed value (such as taking the @code{car} of a string). - -Because variables, pairs, and vectors may hold values of any type, -Scheme implementations use a uniform representation for values --- a -single type large enough to hold either a complete value or a pointer -to a complete value, along with the necessary typing information. - -The following sections will present a simple typing system, and then -make some refinements to correct its major weaknesses. However, this is -not a description of the system Guile actually uses. It is only an -illustration of the issues Guile's system must address. We provide all -the information one needs to work with Guile's data in @ref{How Guile -does it}. - - -@menu -* A Simple Representation:: -* Faster Integers:: -* Cheaper Pairs:: -* Guile Is Hairier:: -@end menu - -@node A Simple Representation, Faster Integers, Data Representation in Scheme, Data Representation in Scheme -@subsection A Simple Representation - -The simplest way to meet the above requirements in C would be to -represent each value as a pointer to a structure containing a type -indicator, followed by a union carrying the real value. Assuming that -@code{SCM} is the name of our universal type, we can write: - -@example -enum type @{ integer, pair, string, vector, ... @}; - -typedef struct value *SCM; - -struct value @{ - enum type type; - union @{ - int integer; - struct @{ SCM car, cdr; @} pair; - struct @{ int length; char *elts; @} string; - struct @{ int length; SCM *elts; @} vector; - ... - @} value; -@}; -@end example -with the ellipses replaced with code for the remaining Scheme types. - -This representation is sufficient to implement all of Scheme's -semantics. If @var{x} is an @code{SCM} value: -@itemize @bullet -@item - To test if @var{x} is an integer, we can write @code{@var{x}->type == integer}. -@item - To find its value, we can write @code{@var{x}->value.integer}. -@item - To test if @var{x} is a vector, we can write @code{@var{x}->type == vector}. -@item - If we know @var{x} is a vector, we can write - @code{@var{x}->value.vector.elts[0]} to refer to its first element. -@item - If we know @var{x} is a pair, we can write - @code{@var{x}->value.pair.car} to extract its car. -@end itemize - - -@node Faster Integers, Cheaper Pairs, A Simple Representation, Data Representation in Scheme -@subsection Faster Integers - -Unfortunately, the above representation has a serious disadvantage. In -order to return an integer, an expression must allocate a @code{struct -value}, initialize it to represent that integer, and return a pointer to -it. Furthermore, fetching an integer's value requires a memory -reference, which is much slower than a register reference on most -processors. Since integers are extremely common, this representation is -too costly, in both time and space. Integers should be very cheap to -create and manipulate. - -One possible solution comes from the observation that, on many -architectures, structures must be aligned on a four-byte boundary. -(Whether or not the machine actually requires it, we can write our own -allocator for @code{struct value} objects that assures this is true.) -In this case, the lower two bits of the structure's address are known to -be zero. - -This gives us the room we need to provide an improved representation -for integers. We make the following rules: -@itemize @bullet -@item -If the lower two bits of an @code{SCM} value are zero, then the SCM -value is a pointer to a @code{struct value}, and everything proceeds as -before. -@item -Otherwise, the @code{SCM} value represents an integer, whose value -appears in its upper bits. -@end itemize - -Here is C code implementing this convention: -@example -enum type @{ pair, string, vector, ... @}; - -typedef struct value *SCM; - -struct value @{ - enum type type; - union @{ - struct @{ SCM car, cdr; @} pair; - struct @{ int length; char *elts; @} string; - struct @{ int length; SCM *elts; @} vector; - ... - @} value; -@}; - -#define POINTER_P(x) (((int) (x) & 3) == 0) -#define INTEGER_P(x) (! POINTER_P (x)) - -#define GET_INTEGER(x) ((int) (x) >> 2) -#define MAKE_INTEGER(x) ((SCM) (((x) << 2) | 1)) -@end example - -Notice that @code{integer} no longer appears as an element of @code{enum -type}, and the union has lost its @code{integer} member. Instead, we -use the @code{POINTER_P} and @code{INTEGER_P} macros to make a coarse -classification of values into integers and non-integers, and do further -type testing as before. - -Here's how we would answer the questions posed above (again, assume -@var{x} is an @code{SCM} value): -@itemize @bullet -@item - To test if @var{x} is an integer, we can write @code{INTEGER_P (@var{x})}. -@item - To find its value, we can write @code{GET_INTEGER (@var{x})}. -@item - To test if @var{x} is a vector, we can write: -@example - @code{POINTER_P (@var{x}) && @var{x}->type == vector} -@end example - Given the new representation, we must make sure @var{x} is truly a - pointer before we dereference it to determine its complete type. -@item - If we know @var{x} is a vector, we can write - @code{@var{x}->value.vector.elts[0]} to refer to its first element, as - before. -@item - If we know @var{x} is a pair, we can write - @code{@var{x}->value.pair.car} to extract its car, just as before. -@end itemize - -This representation allows us to operate more efficiently on integers -than the first. For example, if @var{x} and @var{y} are known to be -integers, we can compute their sum as follows: -@example -MAKE_INTEGER (GET_INTEGER (@var{x}) + GET_INTEGER (@var{y})) -@end example -Now, integer math requires no allocation or memory references. Most -real Scheme systems actually use an even more efficient representation, -but this essay isn't about bit-twiddling. (Hint: what if pointers had -@code{01} in their least significant bits, and integers had @code{00}?) - - -@node Cheaper Pairs, Guile Is Hairier, Faster Integers, Data Representation in Scheme -@subsection Cheaper Pairs - -However, there is yet another issue to confront. Most Scheme heaps -contain more pairs than any other type of object; Jonathan Rees says -that pairs occupy 45% of the heap in his Scheme implementation, Scheme -48. However, our representation above spends three @code{SCM}-sized -words per pair --- one for the type, and two for the @sc{car} and -@sc{cdr}. Is there any way to represent pairs using only two words? - -Let us refine the convention we established earlier. Let us assert -that: -@itemize @bullet -@item - If the bottom two bits of an @code{SCM} value are @code{#b00}, then - it is a pointer, as before. -@item - If the bottom two bits are @code{#b01}, then the upper bits are an - integer. This is a bit more restrictive than before. -@item - If the bottom two bits are @code{#b10}, then the value, with the bottom - two bits masked out, is the address of a pair. -@end itemize - -Here is the new C code: -@example -enum type @{ string, vector, ... @}; - -typedef struct value *SCM; - -struct value @{ - enum type type; - union @{ - struct @{ int length; char *elts; @} string; - struct @{ int length; SCM *elts; @} vector; - ... - @} value; -@}; - -struct pair @{ - SCM car, cdr; -@}; - -#define POINTER_P(x) (((int) (x) & 3) == 0) - -#define INTEGER_P(x) (((int) (x) & 3) == 1) -#define GET_INTEGER(x) ((int) (x) >> 2) -#define MAKE_INTEGER(x) ((SCM) (((x) << 2) | 1)) - -#define PAIR_P(x) (((int) (x) & 3) == 2) -#define GET_PAIR(x) ((struct pair *) ((int) (x) & ~3)) -@end example - -Notice that @code{enum type} and @code{struct value} now only contain -provisions for vectors and strings; both integers and pairs have become -special cases. The code above also assumes that an @code{int} is large -enough to hold a pointer, which isn't generally true. - - -Our list of examples is now as follows: -@itemize @bullet -@item - To test if @var{x} is an integer, we can write @code{INTEGER_P - (@var{x})}; this is as before. -@item - To find its value, we can write @code{GET_INTEGER (@var{x})}, as - before. -@item - To test if @var{x} is a vector, we can write: -@example - @code{POINTER_P (@var{x}) && @var{x}->type == vector} -@end example - We must still make sure that @var{x} is a pointer to a @code{struct - value} before dereferencing it to find its type. -@item - If we know @var{x} is a vector, we can write - @code{@var{x}->value.vector.elts[0]} to refer to its first element, as - before. -@item - We can write @code{PAIR_P (@var{x})} to determine if @var{x} is a - pair, and then write @code{GET_PAIR (@var{x})->car} to refer to its - car. -@end itemize - -This change in representation reduces our heap size by 15%. It also -makes it cheaper to decide if a value is a pair, because no memory -references are necessary; it suffices to check the bottom two bits of -the @code{SCM} value. This may be significant when traversing lists, a -common activity in a Scheme system. - -Again, most real Scheme systems use a slighty different implementation; -for example, if GET_PAIR subtracts off the low bits of @code{x}, instead -of masking them off, the optimizer will often be able to combine that -subtraction with the addition of the offset of the structure member we -are referencing, making a modified pointer as fast to use as an -unmodified pointer. - - -@node Guile Is Hairier, , Cheaper Pairs, Data Representation in Scheme -@subsection Guile Is Hairier - -We originally started with a very simple typing system --- each object -has a field that indicates its type. Then, for the sake of efficiency -in both time and space, we moved some of the typing information directly -into the @code{SCM} value, and left the rest in the @code{struct value}. -Guile itself employs a more complex hierarchy, storing finer and finer -gradations of type information in different places, depending on the -object's coarser type. - -In the author's opinion, Guile could be simplified greatly without -significant loss of efficiency, but the simplified system would still be -more complex than what we've presented above. - - -@node How Guile does it, Defining New Types (Smobs), Data Representation in Scheme, Top -@section How Guile does it - -Here we present the specifics of how Guile represents its data. We -don't go into complete detail; an exhaustive description of Guile's -system would be boring, and we do not wish to encourage people to write -code which depends on its details anyway. We do, however, present -everything one need know to use Guile's data. - - -@menu -* General Rules:: -* Garbage Collection:: -* Immediates vs. Non-immediates:: -* Immediate Datatypes:: -* Non-immediate Datatypes:: -* Signalling Type Errors:: -@end menu - -@node General Rules, Garbage Collection, How Guile does it, How Guile does it -@subsection General Rules - -Any code which operates on Guile datatypes must @code{#include} the -header file @code{<libguile.h>}. This file contains a definition for -the @code{SCM} typedef (Guile's universal type, as in the examples -above), and definitions and declarations for a host of macros and -functions that operate on @code{SCM} values. - -All identifiers declared by @code{<libguile.h>} begin with @code{scm_} -or @code{SCM_}. - -@c [[I wish this were true, but I don't think it is at the moment. -JimB]] -@c Macros do not evaluate their arguments more than once, unless documented -@c to do so. - -The functions described here generally check the types of their -@code{SCM} arguments, and signal an error if their arguments are of an -inappropriate type. Macros generally do not, unless that is their -specified purpose. You must verify their argument types beforehand, as -necessary. - -Macros and functions that return a boolean value have names ending in -@code{P} or @code{_p} (for ``predicate''). Those that return a negated -boolean value have names starting with @code{SCM_N}. For example, -@code{SCM_IMP (@var{x})} is a predicate which returns non-zero iff -@var{x} is an immediate value (an @code{IM}). @code{SCM_NCONSP -(@var{x})} is a predicate which returns non-zero iff @var{x} is -@emph{not} a pair object (a @code{CONS}). - - -@node Garbage Collection, Immediates vs. Non-immediates, General Rules, How Guile does it -@subsection Garbage Collection - -Aside from the latent typing, the major source of constraints on a -Scheme implementation's data representation is the garbage collector. -The collector must be able to traverse every live object in the heap, to -determine which objects are not live. - -There are many ways to implement this, but Guile uses an algorithm -called @dfn{mark and sweep}. The collector scans the system's global -variables and the local variables on the stack to determine which -objects are immediately accessible by the C code. It then scans those -objects to find the objects they point to, @i{et cetera}. The collector -sets a @dfn{mark bit} on each object it finds, so each object is -traversed only once. This process is called @dfn{tracing}. - -When the collector can find no unmarked objects pointed to by marked -objects, it assumes that any objects that are still unmarked will never -be used by the program (since there is no path of dereferences from any -global or local variable that reaches them) and deallocates them. - -In the above paragraphs, we did not specify how the garbage collector -finds the global and local variables; as usual, there are many different -approaches. Frequently, the programmer must maintain a list of pointers -to all global variables that refer to the heap, and another list -(adjusted upon entry to and exit from each function) of local variables, -for the collector's benefit. - -The list of global variables is usually not too difficult to maintain, -since global variables are relatively rare. However, an explicitly -maintained list of local variables (in the author's personal experience) -is a nightmare to maintain. Thus, Guile uses a technique called -@dfn{conservative garbage collection}, to make the local variable list -unnecessary. - -The trick to conservative collection is to treat the stack as an -ordinary range of memory, and assume that @emph{every} word on the stack -is a pointer into the heap. Thus, the collector marks all objects whose -addresses appear anywhere in the stack, without knowing for sure how -that word is meant to be interpreted. - -Obviously, such a system will occasionally retain objects that are -actually garbage, and should be freed. In practice, this is not a -problem. The alternative, an explicitly maintained list of local -variable addresses, is effectively much less reliable, due to programmer -error. - -To accomodate this technique, data must be represented so that the -collector can accurately determine whether a given stack word is a -pointer or not. Guile does this as follows: -@itemize @bullet - -@item -Every heap object has a two-word header, called a @dfn{cell}. Some -objects, like pairs, fit entirely in a cell's two words; others may -store pointers to additional memory in either of the words. For -example, strings and vectors store their length in the first word, and a -pointer to their elements in the second. - -@item -Guile allocates whole arrays of cells at a time, called @dfn{heap -segments}. These segments are always allocated so that the cells they -contain fall on eight-byte boundaries, or whatever is appropriate for -the machine's word size. Guile keeps all cells in a heap segment -initialized, whether or not they are currently in use. - -@item -Guile maintains a sorted table of heap segments. - -@end itemize - -Thus, given any random word @var{w} fetched from the stack, Guile's -garbage collector can consult the table to see if @var{w} falls within a -known heap segment, and check @var{w}'s alignment. If both tests pass, -the collector knows that @var{w} is a valid pointer to a cell, -intentional or not, and proceeds to trace the cell. - -Note that heap segments do not contain all the data Guile uses; cells -for objects like vectors and strings contain pointers to other memory -areas. However, since those pointers are internal, and not shared among -many pieces of code, it is enough for the collector to find the cell, -and then use the cell's type to find more pointers to trace. - - -@node Immediates vs. Non-immediates, Immediate Datatypes, Garbage Collection, How Guile does it -@subsection Immediates vs. Non-immediates - -Guile classifies Scheme objects into two kinds: those that fit entirely -within an @code{SCM}, and those that require heap storage. - -The former class are called @dfn{immediates}. The class of immediates -includes small integers, characters, boolean values, the empty list, the -mysterious end-of-file object, and some others. - -The remaining types are called, not suprisingly, @dfn{non-immediates}. -They include pairs, procedures, strings, vectors, and all other data -types in Guile. - -@deftypefn Macro int SCM_IMP (SCM @var{x}) -Return non-zero iff @var{x} is an immediate object. -@end deftypefn - -@deftypefn Macro int SCM_NIMP (SCM @var{x}) -Return non-zero iff @var{x} is a non-immediate object. This is the -exact complement of @code{SCM_IMP}, above. - -You must use this macro before calling a finer-grained predicate to -determine @var{x}'s type. For example, to see if @var{x} is a pair, you -must write: -@example -SCM_NIMP (@var{x}) && SCM_CONSP (@var{x}) -@end example -This is because Guile stores typing information for non-immediate values -in their cells, rather than in the @code{SCM} value itself; thus, you -must determine whether @var{x} refers to a cell before looking inside -it. - -This is somewhat of a pity, because it means that the programmer needs -to know which types Guile implements as immediates vs. non-immediates. -There are (possibly better) representations in which @code{SCM_CONSP} -can be self-sufficient. The immediate type predicates do not suffer -from this weakness. -@end deftypefn - - -@node Immediate Datatypes, Non-immediate Datatypes, Immediates vs. Non-immediates, How Guile does it -@subsection Immediate Datatypes - -The following datatypes are immediate values; that is, they fit entirely -within an @code{SCM} value. The @code{SCM_IMP} and @code{SCM_NIMP} -macros will distinguish these from non-immediates; see @ref{Immediates -vs. Non-immediates} for an explanation of the distinction. - -Note that the type predicates for immediate values work correctly on any -@code{SCM} value; you do not need to call @code{SCM_IMP} first, to -establish that a value is immediate. This differs from the -non-immediate type predicates, which work correctly only on -non-immediate values; you must be sure the value is @code{SCM_NIMP} -before applying them. - - -@menu -* Integers:: -* Characters:: -* Booleans:: -* Unique Values:: -@end menu - -@node Integers, Characters, Immediate Datatypes, Immediate Datatypes -@subsubsection Integers - -Here are functions for operating on small integers, that fit within an -@code{SCM}. Such integers are called @dfn{immediate numbers}, or -@dfn{INUMs}. In general, INUMs occupy all but two bits of an -@code{SCM}. - -Bignums and floating-point numbers are non-immediate objects, and have -their own, separate accessors. The functions here will not work on -them. This is not as much of a problem as you might think, however, -because the system never constructs bignums that could fit in an INUM, -and never uses floating point values for exact integers. - -@deftypefn Macro int SCM_INUMP (SCM @var{x}) -Return non-zero iff @var{x} is a small integer value. -@end deftypefn - -@deftypefn Macro int SCM_NINUMP (SCM @var{x}) -The complement of SCM_INUMP. -@end deftypefn - -@deftypefn Macro int SCM_INUM (SCM @var{x}) -Return the value of @var{x} as an ordinary, C integer. If @var{x} -is not an INUM, the result is undefined. -@end deftypefn - -@deftypefn Macro SCM SCM_MAKINUM (int @var{i}) -Given a C integer @var{i}, return its representation as an @code{SCM}. -This function does not check for overflow. -@end deftypefn - - -@node Characters, Booleans, Integers, Immediate Datatypes -@subsubsection Characters - -Here are functions for operating on characters. - -@deftypefn Macro int SCM_ICHRP (SCM @var{x}) -Return non-zero iff @var{x} is a character value. -@end deftypefn - -@deftypefn Macro {unsigned int} SCM_ICHR (SCM @var{x}) -Return the value of @code{x} as a C character. If @var{x} is not a -Scheme character, the result is undefined. -@end deftypefn - -@deftypefn Macro SCM SCM_MAKICHR (SCM @var{c}) -Given a C character @var{c}, return its representation as a Scheme -character value. -@end deftypefn - - -@node Booleans, Unique Values, Characters, Immediate Datatypes -@subsubsection Booleans - -Here are functions and macros for operating on booleans. - -@deftypefn Macro SCM SCM_BOOL_T -@deftypefnx Macro SCM SCM_BOOL_F -The Scheme true and false values. -@end deftypefn - -@deftypefn Macro int SCM_NFALSEP (@var{x}) -Convert the Scheme boolean value to a C boolean. Since every object in -Scheme except @code{#f} is true, this amounts to comparing @var{x} to -@code{#f}; hence the name. -@c Noel feels a chill here. -@end deftypefn - -@deftypefn Macro SCM SCM_BOOL_NOT (@var{x}) -Return the boolean inverse of @var{x}. If @var{x} is not a -Scheme boolean, the result is undefined. -@end deftypefn - - -@node Unique Values, , Booleans, Immediate Datatypes -@subsubsection Unique Values - -The immediate values that are neither small integers, characters, nor -booleans are all unique values --- that is, datatypes with only one -instance. - -@deftypefn Macro SCM SCM_EOL -The Scheme empty list object, or ``End Of List'' object, usually written -in Scheme as @code{'()}. -@end deftypefn - -@deftypefn Macro SCM SCM_EOF_VAL -The Scheme end-of-file value. It has no standard written -representation, for obvious reasons. -@end deftypefn - -@deftypefn Macro SCM SCM_UNSPECIFIED -The value returned by expressions which the Scheme standard says return -an ``unspecified'' value. - -This is sort of a weirdly literal way to take things, but the standard -read-eval-print loop prints nothing when the expression returns this -value, so it's not a bad idea to return this when you can't think of -anything else helpful. -@end deftypefn - -@deftypefn Macro SCM SCM_UNDEFINED -The ``undefined'' value. Its most important property is that is not -equal to any valid Scheme value. This is put to various internal uses -by C code interacting with Guile. - -For example, when you write a C function that is callable from Scheme -and which takes optional arguments, the interpreter passes -@code{SCM_UNDEFINED} for any arguments you did not receive. - -We also use this to mark unbound variables. -@end deftypefn - -@deftypefn Macro int SCM_UNBNDP (SCM @var{x}) -Return true if @var{x} is @code{SCM_UNDEFINED}. Apply this to a -symbol's value to see if it has a binding as a global variable. -@end deftypefn - - -@node Non-immediate Datatypes, Signalling Type Errors, Immediate Datatypes, How Guile does it -@subsection Non-immediate Datatypes - -A non-immediate datatype is one which lives in the heap, either because -it cannot fit entirely within a @code{SCM} word, or because it denotes a -specific storage location (in the nomenclature of the Revised^4 Report -on Scheme). - -The @code{SCM_IMP} and @code{SCM_NIMP} macros will distinguish these -from immediates; see @ref{Immediates vs. Non-immediates}. - -Given a cell, Guile distinguishes between pairs and other non-immediate -types by storing special @dfn{tag} values in a non-pair cell's car, that -cannot appear in normal pairs. A cell with a non-tag value in its car -is an ordinary pair. The type of a cell with a tag in its car depends -on the tag; the non-immediate type predicates test this value. If a tag -value appears elsewhere (in a vector, for example), the heap may become -corrupted. - - -@menu -* Non-immediate Type Predicates:: Special rules for using the type - predicates described here. -* Pairs:: -* Vectors:: -* Procedures:: -* Closures:: -* Subrs:: -* Ports:: -@end menu - -@node Non-immediate Type Predicates, Pairs, Non-immediate Datatypes, Non-immediate Datatypes -@subsubsection Non-immediate Type Predicates - -As mentioned in @ref{Garbage Collection}, all non-immediate objects -start with a @dfn{cell}, or a pair of words. Furthermore, all type -information that distinguishes one kind of non-immediate from another is -stored in the cell. The type information in the @code{SCM} value -indicates only that the object is a non-immediate; all finer -distinctions require one to examine the cell itself, usually with the -appropriate type predicate macro. - -The type predicates for non-immediate objects generally assume that -their argument is a non-immediate value. Thus, you must be sure that a -value is @code{SCM_NIMP} first before passing it to a non-immediate type -predicate. Thus, the idiom for testing whether a value is a cell or not -is: -@example -SCM_NIMP (@var{x}) && SCM_CONSP (@var{x}) -@end example - - -@node Pairs, Vectors, Non-immediate Type Predicates, Non-immediate Datatypes -@subsubsection Pairs - -Pairs are the essential building block of list structure in Scheme. A -pair object has two fields, called the @dfn{car} and the @dfn{cdr}. - -It is conventional for a pair's @sc{car} to contain an element of a -list, and the @sc{cdr} to point to the next pair in the list, or to -contain @code{SCM_EOL}, indicating the end of the list. Thus, a set of -pairs chained through their @sc{cdr}s constitutes a singly-linked list. -Scheme and libguile define many functions which operate on lists -constructed in this fashion, so although lists chained through the -@sc{car}s of pairs will work fine too, they may be less convenient to -manipulate, and receive less support from the community. - -Guile implements pairs by mapping the @sc{car} and @sc{cdr} of a pair -directly into the two words of the cell. - - -@deftypefn Macro int SCM_CONSP (SCM @var{x}) -Return non-zero iff @var{x} is a Scheme pair object. -The results are undefined if @var{x} is an immediate value. -@end deftypefn - -@deftypefn Macro int SCM_NCONSP (SCM @var{x}) -The complement of SCM_CONSP. -@end deftypefn - -@deftypefn Macro void SCM_NEWCELL (SCM @var{into}) -Allocate a new cell, and set @var{into} to point to it. This macro -expands to a statement, not an expression, and @var{into} must be an -lvalue of type SCM. - -This is the most primitive way to allocate a cell; it is quite fast. - -The @sc{car} of the cell initially tags it as a ``free cell''. If the -caller intends to use it as an ordinary cons, she must store ordinary -SCM values in its @sc{car} and @sc{cdr}. - -If the caller intends to use it as a header for some other type, she -must store an appropriate magic value in the cell's @sc{car}, to mark -it as a member of that type, and store whatever value in the @sc{cdr} -that type expects. You should generally not do this, unless you are -implementing a new datatype, and thoroughly understand the code in -@code{<libguile/tags.h>}. -@end deftypefn - -@deftypefun SCM scm_cons (SCM @var{car}, SCM @var{cdr}) -Allocate (``CONStruct'') a new pair, with @var{car} and @var{cdr} as its -contents. -@end deftypefun - - -The macros below perform no typechecking. The results are undefined if -@var{cell} is an immediate. However, since all non-immediate Guile -objects are constructed from cells, and these macros simply return the -first element of a cell, they actually can be useful on datatypes other -than pairs. (Of course, it is not very modular to use them outside of -the code which implements that datatype.) - -@deftypefn Macro SCM SCM_CAR (SCM @var{cell}) -Return the @sc{car}, or first field, of @var{cell}. -@end deftypefn - -@deftypefn Macro SCM SCM_CDR (SCM @var{cell}) -Return the @sc{cdr}, or second field, of @var{cell}. -@end deftypefn - -@deftypefn Macro void SCM_SETCAR (SCM @var{cell}, SCM @var{x}) -Set the @sc{car} of @var{cell} to @var{x}. -@end deftypefn - -@deftypefn Macro void SCM_SETCDR (SCM @var{cell}, SCM @var{x}) -Set the @sc{cdr} of @var{cell} to @var{x}. -@end deftypefn - -@deftypefn Macro SCM SCM_CAAR (SCM @var{cell}) -@deftypefnx Macro SCM SCM_CADR (SCM @var{cell}) -@deftypefnx Macro SCM SCM_CDAR (SCM @var{cell}) @dots{} -@deftypefnx Macro SCM SCM_CDDDDR (SCM @var{cell}) -Return the @sc{car} of the @sc{car} of @var{cell}, the @sc{car} of the -@sc{cdr} of @var{cell}, @i{et cetera}. -@end deftypefn - - -@node Vectors, Procedures, Pairs, Non-immediate Datatypes -@subsubsection Vectors, Strings, and Symbols - -Vectors, strings, and symbols have some properties in common. They all -have a length, and they all have an array of elements. In the case of a -vector, the elements are @code{SCM} values; in the case of a string or -symbol, the elements are characters. - -All these types store their length (along with some tagging bits) in the -@sc{car} of their header cell, and store a pointer to the elements in -their @sc{cdr}. Thus, the @code{SCM_CAR} and @code{SCM_CDR} macros -are (somewhat) meaningful when applied to these datatypes. - -@deftypefn Macro int SCM_VECTORP (SCM @var{x}) -Return non-zero iff @var{x} is a vector. -The results are undefined if @var{x} is an immediate value. -@end deftypefn - -@deftypefn Macro int SCM_STRINGP (SCM @var{x}) -Return non-zero iff @var{x} is a string. -The results are undefined if @var{x} is an immediate value. -@end deftypefn - -@deftypefn Macro int SCM_SYMBOLP (SCM @var{x}) -Return non-zero iff @var{x} is a symbol. -The results are undefined if @var{x} is an immediate value. -@end deftypefn - -@deftypefn Macro int SCM_LENGTH (SCM @var{x}) -Return the length of the object @var{x}. -The results are undefined if @var{x} is not a vector, string, or symbol. -@end deftypefn - -@deftypefn Macro {SCM *} SCM_VELTS (SCM @var{x}) -Return a pointer to the array of elements of the vector @var{x}. -The results are undefined if @var{x} is not a vector. -@end deftypefn - -@deftypefn Macro {char *} SCM_CHARS (SCM @var{x}) -Return a pointer to the characters of @var{x}. -The results are undefined if @var{x} is not a symbol or a string. -@end deftypefn - -There are also a few magic values stuffed into memory before a symbol's -characters, but you don't want to know about those. What cruft! - - -@node Procedures, Closures, Vectors, Non-immediate Datatypes -@subsubsection Procedures - -Guile provides two kinds of procedures: @dfn{closures}, which are the -result of evaluating a @code{lambda} expression, and @dfn{subrs}, which -are C functions packaged up as Scheme objects, to make them available to -Scheme programmers. - -(There are actually other sorts of procedures: compiled closures, and -continuations; see the source code for details about them.) - -@deftypefun SCM scm_procedure_p (SCM @var{x}) -Return @code{SCM_BOOL_T} iff @var{x} is a Scheme procedure object, of -any sort. Otherwise, return @code{SCM_BOOL_F}. -@end deftypefun - - -@node Closures, Subrs, Procedures, Non-immediate Datatypes -@subsubsection Closures - -[FIXME: this needs to be further subbed, but texinfo has no subsubsub] - -A closure is a procedure object, generated as the value of a -@code{lambda} expression in Scheme. The representation of a closure is -straightforward --- it contains a pointer to the code of the lambda -expression from which it was created, and a pointer to the environment -it closes over. - -In Guile, each closure also has a property list, allowing the system to -store information about the closure. I'm not sure what this is used for -at the moment --- the debugger, maybe? - -@deftypefn Macro int SCM_CLOSUREP (SCM @var{x}) -Return non-zero iff @var{x} is a closure. The results are -undefined if @var{x} is an immediate value. -@end deftypefn - -@deftypefn Macro SCM SCM_PROCPROPS (SCM @var{x}) -Return the property list of the closure @var{x}. The results are -undefined if @var{x} is not a closure. -@end deftypefn - -@deftypefn Macro void SCM_SETPROCPROPS (SCM @var{x}, SCM @var{p}) -Set the property list of the closure @var{x} to @var{p}. The results -are undefined if @var{x} is not a closure. -@end deftypefn - -@deftypefn Macro SCM SCM_CODE (SCM @var{x}) -Return the code of the closure @var{x}. The results are undefined if -@var{x} is not a closure. - -This function should probably only be used internally by the -interpreter, since the representation of the code is intimately -connected with the interpreter's implementation. -@end deftypefn - -@deftypefn Macro SCM SCM_ENV (SCM @var{x}) -Return the environment enclosed by @var{x}. -The results are undefined if @var{x} is not a closure. - -This function should probably only be used internally by the -interpreter, since the representation of the environment is intimately -connected with the interpreter's implementation. -@end deftypefn - - -@node Subrs, Ports, Closures, Non-immediate Datatypes -@subsubsection Subrs - -[FIXME: this needs to be further subbed, but texinfo has no subsubsub] - -A subr is a pointer to a C function, packaged up as a Scheme object to -make it callable by Scheme code. In addition to the function pointer, -the subr also contains a pointer to the name of the function, and -information about the number of arguments accepted by the C fuction, for -the sake of error checking. - -There is no single type predicate macro that recognizes subrs, as -distinct from other kinds of procedures. The closest thing is -@code{scm_procedure_p}; see @ref{Procedures}. - -@deftypefn Macro {char *} SCM_SNAME (@var{x}) -Return the name of the subr @var{x}. The results are undefined if -@var{x} is not a subr. -@end deftypefn - -@deftypefun SCM scm_make_gsubr (char *@var{name}, int @var{req}, int @var{opt}, int @var{rest}, SCM (*@var{function})()) -Create a new subr object named @var{name}, based on the C function -@var{function}, make it visible to Scheme the value of as a global -variable named @var{name}, and return the subr object. - -The subr object accepts @var{req} required arguments, @var{opt} optional -arguments, and a @var{rest} argument iff @var{rest} is non-zero. The C -function @var{function} should accept @code{@var{req} + @var{opt}} -arguments, or @code{@var{req} + @var{opt} + 1} arguments if @code{rest} -is non-zero. - -When a subr object is applied, it must be applied to at least @var{req} -arguments, or else Guile signals an error. @var{function} receives the -subr's first @var{req} arguments as its first @var{req} arguments. If -there are fewer than @var{opt} arguments remaining, then @var{function} -receives the value @code{SCM_UNDEFINED} for any missing optional -arguments. If @var{rst} is non-zero, then any arguments after the first -@code{@var{req} + @var{opt}} are packaged up as a list as passed as -@var{function}'s last argument. - -Note that subrs can actually only accept a predefined set of -combinations of required, optional, and rest arguments. For example, a -subr can take one required argument, or one required and one optional -argument, but a subr can't take one required and two optional arguments. -It's bizarre, but that's the way the interpreter was written. If the -arguments to @code{scm_make_gsubr} do not fit one of the predefined -patterns, then @code{scm_make_gsubr} will return a compiled closure -object instead of a subr object. -@end deftypefun - - -@node Ports, , Subrs, Non-immediate Datatypes -@subsubsection Ports - -Haven't written this yet, 'cos I don't understand ports yet. - - -@node Signalling Type Errors, , Non-immediate Datatypes, How Guile does it -@subsection Signalling Type Errors - -Every function visible at the Scheme level should aggressively check the -types of its arguments, to avoid misinterpreting a value, and perhaps -causing a segmentation fault. Guile provides some macros to make this -easier. - -@deftypefn Macro void SCM_ASSERT (int @var{test}, SCM @var{obj}, int @var{position}, char *@var{subr}) -If @var{test} is zero, signal an error, attributed to the subroutine -named @var{subr}, operating on the value @var{obj}. The @var{position} -value determines exactly what sort of error to signal. - -If @var{position} is a string, @code{SCM_ASSERT} raises a -``miscellaneous'' error whose message is that string. - -Otherwise, @var{position} should be one of the values defined below. -@end deftypefn - -@deftypefn Macro int SCM_ARG1 -@deftypefnx Macro int SCM_ARG2 -@deftypefnx Macro int SCM_ARG3 -@deftypefnx Macro int SCM_ARG4 -@deftypefnx Macro int SCM_ARG5 -Signal a ``wrong type argument'' error. When used as the @var{position} -argument of @code{SCM_ASSERT}, @code{SCM_ARG@var{n}} claims that -@var{obj} has the wrong type for the @var{n}'th argument of @var{subr}. - -The only way to complain about the type of an argument after the fifth -is to use @code{SCM_ARGn}, defined below, which doesn't specify which -argument is wrong. You could pass your own error message to -@code{SCM_ASSERT} as the @var{position}, but then the error signalled is -a ``miscellaneous'' error, not a ``wrong type argument'' error. This -seems kludgy to me. -@comment Any function with more than two arguments is wrong --- Perlis -@comment Despite Perlis, I agree. Why not have two Macros, one with -@comment a string error message, and the other with an integer position -@comment that only claims a type error in an argument? -@comment --- Keith Wright -@end deftypefn - -@deftypefn Macro int SCM_ARGn -As above, but does not specify which argument's type is incorrect. -@end deftypefn - -@deftypefn Macro int SCM_WNA -Signal an error complaining that the function received the wrong number -of arguments. - -Interestingly, the message is attributed to the function named by -@var{obj}, not @var{subr}, so @var{obj} must be a Scheme string object -naming the function. Usually, Guile catches these errors before ever -invoking the subr, so we don't run into these problems. -@end deftypefn - -@deftypefn Macro int SCM_OUTOFRANGE -Signal an error complaining that @var{obj} is ``out of range'' for -@var{subr}. -@end deftypefn - - -@node Defining New Types (Smobs), , How Guile does it, Top -@section Defining New Types (Smobs) - -@dfn{Smobs} are Guile's mechanism for adding new non-immediate types to -the system.@footnote{The term ``smob'' was coined by Aubrey Jaffer, who -says it comes from ``small object'', referring to the fact that only the -@sc{cdr} and part of the @sc{car} of a smob's cell are available for -use.} To define a new smob type, the programmer provides Guile with -some essential information about the type --- how to print it, how to -garbage collect it, @i{et cetera} --- and Guile returns a fresh type tag for -use in the @sc{car} of new cells. The programmer can then use -@code{scm_make_gsubr} to publish a set of C functions to the Scheme -world that create and operate on these objects. - - -@menu -* Describing a New Type:: -* Creating Instances:: -* Typechecking:: -* Garbage Collecting Smobs:: -* Garbage Collecting Simple Smobs:: -* A Complete Example:: -@end menu - -@node Describing a New Type, Creating Instances, Defining New Types (Smobs), Defining New Types (Smobs) -@subsection Describing a New Type - -To define a new type, the programmer must fill in an @code{scm_smobfuns} -structure with functions to manage instances of the type. Here is the -definition of the structure: - -@example -typedef struct scm_smobfuns -@{ - SCM (*mark) (SCM @var{obj}); - scm_sizet (*free) (SCM @var{obj}); - int (*print) (SCM @var{obj}, - SCM @var{port}, - scm_print_state *@var{pstate}); - SCM (*equalp) (SCM @var{a}, SCM @var{b}); -@} scm_smobfuns; -@end example - -@table @code -@item mark -Guile will apply this function to each instance of the new type it -encounters during garbage collection. This function is responsible for -telling the collector about any other non-immediate objects the object -refers to. @xref{Garbage Collecting Smobs}, for more details. - -@item free -Guile will apply this function to each instance of the new type it could -not find any live pointers to. The function should release all -resources held by the object and return. -@xref{Garbage Collecting Smobs}, for more details. - -@item print -Guile will apply this function to each instance of the new type to print -the value, as for @code{display} or @code{write}. The function should -write a printed representation of @var{exp} on @var{port}, in accordance -with the parameters in @var{pstate}. (For more information on print -states, see @ref{Ports}.) - -@item equalp -If Scheme code asks the @code{equal?} function to compare two instances -of the same smob type, Guile calls this function. It should return -@code{SCM_BOOL_T} if @var{a} and @var{b} should be considered -@code{equal?}, or @code{SCM_BOOL_F} otherwise. If @code{equalp} is -zero, @code{equal?} will assume that two instances of this type are -never @code{equal?} unless they are @code{eq?}. - -@end table - -Once you have built a @code{scm_smobfuns} structure, you can call the -@code{scm_newsmob} function to add the type to the system. - -@deftypefun long scm_newsmob (scm_smobfuns *@var{funs}) -This function adds the type described by @var{funs} to the system. The -return value is a tag, used in creating instances of the type. -@end deftypefun - -For example, here is how one might declare and register a new type -representing eight-bit grayscale images: -@example -#include <libguile.h> - -scm_smobfuns image_funs = @{ - mark_image, free_image, print_image, 0 -@}; - -long image_tag; - -void -init_image_type () -@{ - image_tag = scm_newsmob (&image_funs); -@} -@end example - - -@node Creating Instances, Typechecking, Describing a New Type, Defining New Types (Smobs) -@subsection Creating Instances - -Like other non-immediate types, smobs start with a cell whose @sc{car} -contains typing information, and whose @code{cdr} is free for any use. -To create an instance of a smob type, you must allocate a fresh cell, by -calling @code{SCM_NEWCELL}, and store the tag returned by -@code{scm_smobfuns} in its car. - -Guile provides the following functions for managing memory, which are -often helpful when implementing smobs: - -@deftypefun {char *} scm_must_malloc (long @var{len}, char *@var{what}) -Allocate @var{len} bytes of memory, using @code{malloc}, and return a -pointer to them. - -If there is not enough memory available, invoke the garbage collector, -and try once more. If there is still not enough, signal an error, -reporting that we could not allocate @var{what}. - -This function also helps maintain statistics about the size of the heap. -@end deftypefun - -@deftypefun {char *} scm_must_realloc (char *@var{addr}, long @var{olen}, long @var{len}, char *@var{what}) -Resize (and possibly relocate) the block of memory at @var{addr}, to -have a size of @var{len} bytes, by calling @code{realloc}. Return a -pointer to the new block. - -If there is not enough memory available, invoke the garbage collector, -and try once more. If there is still not enough, signal an error, -reporting that we could not allocate @var{what}. - -The value @var{olen} should be the old size of the block of memory at -@var{addr}; it is only used for keeping statistics on the size of the -heap. -@end deftypefun - -@deftypefun void scm_must_free (char *@var{addr}) -Free the block of memory at @var{addr}, using @code{free}. If -@var{addr} is zero, signal an error, complaining of an attempt to free -something that is already free. - -This does no record-keeping; instead, the smob's @code{free} function -must take care of that. - -This function isn't usually sufficiently different from the usual -@code{free} function to be worth using. -@end deftypefun - - -Continuing the above example, if the global variable @code{image_tag} -contains a tag returned by @code{scm_newsmob}, here is how we could -construct a smob whose @sc{cdr} contains a pointer to a freshly -allocated @code{struct image}: - -@example -struct image @{ - int width, height; - char *pixels; - - /* The name of this image */ - SCM name; - - /* A function to call when this image is - modified, e.g., to update the screen, - or SCM_BOOL_F if no action necessary */ - SCM update_func; -@}; - -SCM -create_image (SCM name, int width, int height) -@{ - struct image *image; - SCM image_smob; - - image = (struct image *) scm_must_malloc (sizeof (*image), "image"); - image->width = width; - image->height = height; - image->pixels = scm_must_malloc (width * height, "image pixels"); - image->name = name; - image->update_func = SCM_BOOL_F; - - SCM_NEWCELL (image_smob); - SCM_SETCAR (image_smob, image_tag); - SCM_SETCDR (image_smob, image); - - return image_smob; -@} -@end example - - -@node Typechecking, Garbage Collecting Smobs, Creating Instances, Defining New Types (Smobs) -@subsection Typechecking - -Functions that operate on smobs should aggressively check the types of -their arguments, to avoid misinterpreting some other datatype as a smob, -and perhaps causing a segmentation fault. Fortunately, this is pretty -simple to do. The function need only verify that its argument is a -non-immediate, whose @sc{car} is the type tag returned by -@code{scm_newsmob}. - -For example, here is a simple function that operates on an image smob, -and checks the type of its argument. We also present an expanded -version of the @code{init_image_type} function, to make clear_image -available to the Scheme level. -@example -SCM -clear_image (SCM image_smob) -@{ - int area; - struct image *image; - - SCM_ASSERT ((SCM_NIMP (image_smob) - && SCM_CAR (image_smob) == image_tag), - image_smob, SCM_ARG1, "clear-image"); - - image = (struct image *) SCM_CDR (image_smob); - area = image->width * image->height; - memset (image->pixels, 0, area); - - /* Invoke the image's update function. */ - if (image->update_func != SCM_BOOL_F) - scm_apply (image->update_func, SCM_EOL, SCM_EOL); - - return SCM_UNSPECIFIED; -@} - - -void -init_image_type () -@{ - image_tag = scm_newsmob (&image_funs); - scm_make_gsubr ("clear-image", 1, 0, 0, clear_image); -@} -@end example - -Note that checking types is a little more complicated during garbage -collection; see the description of @code{SCM_GCTYP16} in @ref{Garbage -Collecting Smobs}. - - -@node Garbage Collecting Smobs, Garbage Collecting Simple Smobs, Typechecking, Defining New Types (Smobs) -@subsection Garbage Collecting Smobs - -Once a smob has been released to the tender mercies of the Scheme -system, it must be prepared to survive garbage collection. Guile calls -the @code{mark} and @code{free} functions of the @code{scm_smobfuns} -structure to manage this. - -As described before (@pxref{Garbage Collection}), every object in the -Scheme system has a @dfn{mark bit}, which the garbage collector uses to -tell live objects from dead ones. When collection starts, every -object's mark bit is clear. The collector traces pointers through the -heap, starting from objects known to be live, and sets the mark bit on -each object it encounters. When it can find no more unmarked objects, -the collector walks all objects, live and dead, frees those whose mark -bits are still clear, and clears the mark bit on the others. - -The two main portions of the collection are called the @dfn{mark phase}, -during which the collector marks live objects, and the @dfn{sweep -phase}, during which the collector frees all unmarked objects. - -The mark bit of a smob lives in its @sc{car}, along with the smob's type -tag. When the collector encounters a smob, it sets the smob's mark bit, -and uses the smob's type tag to find the appropriate @code{mark} -function for that smob: the one listed in that smob's -@code{scm_smobfuns} structure. It then calls the @code{mark} function, -passing it the smob as its only argument. - -The @code{mark} function's is responsible for marking any other Scheme -objects the smob refers to. If it does not do so, the objects' mark -bits will still be clear when the collector begins to sweep, and the -collector will free them. If this occurs, it will probably break, or at -least confuse, any code operating on the smob; the smob's @code{SCM} -values will have become dangling references. - -To mark an arbitrary Scheme object, the @code{mark} function may call -this function: - -@deftypefun void scm_gc_mark (SCM @var{x}) -Mark the object @var{x}, and recurse on any objects @var{x} refers to. -If @var{x}'s mark bit is already set, return immediately. -@end deftypefun - -Thus, here is how we might write the @code{mark} function for the image -smob type discussed above: -@example -@group -SCM -mark_image (SCM image_smob) -@{ - /* Mark the image's name and update function. */ - struct image *image = (struct image *) SCM_CDR (image_smob); - - scm_gc_mark (image->name); - scm_gc_mark (image->update_func); - - return SCM_BOOL_F; -@} -@end group -@end example - -Note that, even though the image's @code{update_func} could be an -arbitrarily complex structure (representing a procedure and any values -enclosed in its environment), @code{scm_gc_mark} will recurse as -necessary to mark all its components. Because @code{scm_gc_mark} sets -an object's mark bit before it recurses, it is not confused by -circular structures. - -As an optimization, the collector will mark whatever value is returned -by the @code{mark} function; this helps limit depth of recursion during -the mark phase. Thus, the code above could also be written as: -@example -@group -SCM -mark_image (SCM image_smob) -@{ - /* Mark the image's name and update function. */ - struct image *image = (struct image *) SCM_CDR (image_smob); - - scm_gc_mark (image->name); - return image->update_func; -@} -@end group -@end example - - -Finally, when the collector encounters an unmarked smob during the sweep -phase, it uses the smob's tag to find the appropriate @code{free} -function for the smob. It then calls the function, passing it the smob -as its only argument. - -The @code{free} function must release any resources used by the smob. -However, it need not free objects managed by the collector; the -collector will take care of them. The return type of the @code{free} -function should be @code{scm_sizet}, an unsigned integral type; the -@code{free} function should return the number of bytes released, to help -the collector maintain statistics on the size of the heap. - -Here is how we might write the @code{free} function for the image smob -type: -@example -scm_sizet -free_image (SCM image_smob) -@{ - struct image *image = (struct image *) SCM_CDR (image_smob); - scm_sizet size = image->width * image->height + sizeof (*image); - - free (image->pixels); - free (image); - - return size; -@} -@end example - -During the sweep phase, the garbage collector will clear the mark bits -on all live objects. The code which implements a smob need not do this -itself. - -There is no way for smob code to be notified when collection is -complete. - -Note that, since a smob's mark bit lives in its @sc{car}, along with the -smob's type tag, the technique for checking the type of a smob described -in @ref{Typechecking} will not necessarily work during GC. If you need -to find out whether a given object is a particular smob type during GC, -use the following macro: - -@deftypefn Macro void SCM_GCTYP16 (SCM @var{x}) -Return the type bits of the smob @var{x}, with the mark bit clear. - -Use this macro instead of @code{SCM_CAR} to check the type of a smob -during GC. Usually, only code called by the smob's @code{mark} function -need worry about this. -@end deftypefn - -It is usually a good idea to minimize the amount of processing done -during garbage collection; keep @code{mark} and @code{free} functions -very simple. Since collections occur at unpredictable times, it is easy -for any unusual activity to interfere with normal code. - - -@node Garbage Collecting Simple Smobs, A Complete Example, Garbage Collecting Smobs, Defining New Types (Smobs) -@subsection Garbage Collecting Simple Smobs - -It is often useful to define very simple smob types --- smobs which have -no data to mark, other than the cell itself, or smobs whose @sc{cdr} is -simply an ordinary Scheme object, to be marked recursively. Guile -provides some functions to handle these common cases. - -If the smob refers to no other Scheme objects, then no action is -necessary; the garbage collector has already marked the smob cell -itself. In that case, you can use zero as your mark function. - -@deftypefun SCM scm_markcdr (SCM @var{x}) -Mark the references in the smob @var{x}, assuming that @var{x}'s -@sc{cdr} contains an ordinary Scheme object, and @var{x} refers to no -other objects. This function simply returns @var{x}'s @sc{cdr}. -@end deftypefun - -@deftypefun scm_sizet scm_free0 (SCM @var{x}) -Do nothing; return zero. This function is appropriate for smobs that -use either zero or @code{scm_markcdr} as their marking functions, and -refer to no heap storage, including memory managed by @code{malloc}, -other than the smob's header cell. -@end deftypefun - - -@node A Complete Example, , Garbage Collecting Simple Smobs, Defining New Types (Smobs) -@subsection A Complete Example - -Here is the complete text of the implementation of the image datatype, -as presented in the sections above. We also provide a definition for -the smob's @code{print} function. - -@example -#include <stdlib.h> -#include <libguile.h> - -long image_tag; - -struct image @{ - int width, height; - char *pixels; - - /* The name of this image */ - SCM name; - - /* A function to call when this image is - modified, e.g., to update the screen, - or SCM_BOOL_F if no action necessary */ - SCM update_func; -@}; - - -SCM -create_image (SCM name, int width, int height) -@{ - struct image *image; - SCM image_smob; - - image = (struct image *) scm_must_malloc (sizeof (*image), "image"); - image->width = width; - image->height = height; - image->pixels = scm_must_malloc (width * height, "image pixels"); - image->name = name; - image->update_func = SCM_BOOL_F; - - SCM_NEWCELL (image_smob); - SCM_SETCDR (image_smob, image); - SCM_SETCAR (image_smob, image_tag); - - return image_smob; -@} - - -SCM -clear_image (SCM image_smob) -@{ - int area; - struct image *image; - - SCM_ASSERT ((SCM_NIMP (image_smob) - && SCM_CAR (image_smob) == image_tag), - image_smob, SCM_ARG1, "clear-image"); - - image = (struct image *) SCM_CDR (image_smob); - area = image->width * image->height; - memset (image->pixels, 0, area); - - /* Invoke the image's update function. */ - if (image->update_func != SCM_BOOL_F) - scm_apply (image->update_func, SCM_EOL, SCM_EOL); - - return SCM_UNSPECIFIED; -@} - - -SCM -mark_image (SCM image_smob) -@{ - struct image *image = (struct image *) SCM_CDR (image_smob); - - scm_gc_mark (image->name); - return image->update_func; -@} - - -scm_sizet -free_image (SCM image_smob) -@{ - struct image *image = (struct image *) SCM_CDR (image_smob); - scm_sizet size = image->width * image->height + sizeof (*image); - - free (image->pixels); - free (image); - - return size; -@} - - -int -print_image (SCM obj, SCM port, scm_print_state *pstate) -@{ - struct image *image = (struct image *) SCM_CDR (image_smob); - - scm_gen_puts (scm_regular_string, "#<image ", port); - scm_display (image->name, port); - scm_gen_puts (scm_regular_string, ">", port); - - /* non-zero means success */ - return 1; -@} - -scm_smobfuns image_funs = @{ - mark_image, free_image, print_image, 0 -@}; - - -void -init_image_type () -@{ - image_tag = scm_newsmob (&image_funs); - scm_make_gsubr ("clear-image", 1, 0, 0, clear_image); -@} -@end example - -@bye diff --git a/doc/mdate-sh b/doc/mdate-sh deleted file mode 100755 index e69de29bb..000000000 --- a/doc/mdate-sh +++ /dev/null diff --git a/doc/stamp-vti b/doc/stamp-vti deleted file mode 100644 index 1ddc7738e..000000000 --- a/doc/stamp-vti +++ /dev/null @@ -1,3 +0,0 @@ -@set UPDATED 7 October 1998 -@set EDITION 1.2.91 -@set VERSION 1.2.91 diff --git a/doc/texinfo.tex b/doc/texinfo.tex deleted file mode 100644 index 128a59b18..000000000 --- a/doc/texinfo.tex +++ /dev/null @@ -1,4977 +0,0 @@ -% texinfo.tex -- TeX macros to handle Texinfo files. -% $Id: texinfo.tex,v 1.1 1998-10-07 07:37:17 jimb Exp $ -% -% Copyright (C) 1985, 86, 88, 90, 91, 92, 93, 94, 95, 96, 97, 98 -% Free Software Foundation, Inc. -% -% This texinfo.tex 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, or (at -% your option) any later version. -% -% This texinfo.tex file 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 texinfo.tex file; see the file COPYING. If not, write -% to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -% Boston, MA 02111-1307, USA. -% -% In other words, you are welcome to use, share and improve this program. -% You are forbidden to forbid anyone else to use, share and improve -% what you give them. Help stamp out software-hoarding! -% -% Please try the latest version of texinfo.tex before submitting bug -% reports; you can get the latest version from: -% ftp://ftp.cs.umb.edu/pub/tex/texinfo.tex -% /home/gd/gnu/doc/texinfo.tex on the GNU machines. -% -% Send bug reports to bug-texinfo@gnu.org. -% Please include a precise test case in each bug report, -% including a complete document with which we can reproduce the problem. -% -% Texinfo macros (with @macro) are *not* supported by texinfo.tex. You -% have to run makeinfo -E to expand macros first; the texi2dvi script -% does this. - - -% Make it possible to create a .fmt file just by loading this file: -% if the underlying format is not loaded, start by loading it now. -% Added by gildea November 1993. -\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi - -% This automatically updates the version number based on RCS. -\def\deftexinfoversion$#1: #2 ${\def\texinfoversion{#2}} -\deftexinfoversion$Revision: 1.1 $ -\message{Loading texinfo package [Version \texinfoversion]:} - -% If in a .fmt file, print the version number -% and turn on active characters that we couldn't do earlier because -% they might have appeared in the input file name. -\everyjob{\message{[Texinfo version \texinfoversion]}\message{} - \catcode`+=\active \catcode`\_=\active} - -% Save some parts of plain tex whose names we will redefine. - -\let\ptexb=\b -\let\ptexbullet=\bullet -\let\ptexc=\c -\let\ptexcomma=\, -\let\ptexdot=\. -\let\ptexdots=\dots -\let\ptexend=\end -\let\ptexequiv=\equiv -\let\ptexexclam=\! -\let\ptexi=\i -\let\ptexlbrace=\{ -\let\ptexrbrace=\} -\let\ptexstar=\* -\let\ptext=\t - -% Be sure we're in horizontal mode when doing a tie, since we make space -% equivalent to this in @example-like environments. Otherwise, a space -% at the beginning of a line will start with \penalty -- and -% since \penalty is valid in vertical mode, we'd end up putting the -% penalty on the vertical list instead of in the new paragraph. -{\catcode`@ = 11 - % Avoid using \@M directly, because that causes trouble - % if the definition is written into an index file. - \global\let\tiepenalty = \@M - \gdef\tie{\leavevmode\penalty\tiepenalty\ } -} - - -\message{Basics,} -\chardef\other=12 - -% If this character appears in an error message or help string, it -% starts a new line in the output. -\newlinechar = `^^J - -% Set up fixed words for English. -\ifx\putwordChapter\undefined{\gdef\putwordChapter{Chapter}}\fi% -\def\putwordInfo{Info}% -\ifx\putwordSee\undefined{\gdef\putwordSee{See}}\fi% -\ifx\putwordsee\undefined{\gdef\putwordsee{see}}\fi% -\ifx\putwordfile\undefined{\gdef\putwordfile{file}}\fi% -\ifx\putwordpage\undefined{\gdef\putwordpage{page}}\fi% -\ifx\putwordsection\undefined{\gdef\putwordsection{section}}\fi% -\ifx\putwordSection\undefined{\gdef\putwordSection{Section}}\fi% -\ifx\putwordTableofContents\undefined{\gdef\putwordTableofContents{Table of Contents}}\fi% -\ifx\putwordShortContents\undefined{\gdef\putwordShortContents{Short Contents}}\fi% -\ifx\putwordAppendix\undefined{\gdef\putwordAppendix{Appendix}}\fi% - -% Ignore a token. -% -\def\gobble#1{} - -\hyphenation{ap-pen-dix} -\hyphenation{mini-buf-fer mini-buf-fers} -\hyphenation{eshell} -\hyphenation{white-space} - -% Margin to add to right of even pages, to left of odd pages. -\newdimen \bindingoffset -\newdimen \normaloffset -\newdimen\pagewidth \newdimen\pageheight - -% Sometimes it is convenient to have everything in the transcript file -% and nothing on the terminal. We don't just call \tracingall here, -% since that produces some useless output on the terminal. -% -\def\gloggingall{\begingroup \globaldefs = 1 \loggingall \endgroup}% -\def\loggingall{\tracingcommands2 \tracingstats2 - \tracingpages1 \tracingoutput1 \tracinglostchars1 - \tracingmacros2 \tracingparagraphs1 \tracingrestores1 - \showboxbreadth\maxdimen\showboxdepth\maxdimen -}% - -% For @cropmarks command. -% Do @cropmarks to get crop marks. -% -\newif\ifcropmarks -\let\cropmarks = \cropmarkstrue -% -% Dimensions to add cropmarks at corners. -% Added by P. A. MacKay, 12 Nov. 1986 -% -\newdimen\cornerlong \newdimen\cornerthick -\newdimen\topandbottommargin -\newdimen\outerhsize \newdimen\outervsize -\cornerlong=1pc\cornerthick=.3pt % These set size of cropmarks -\outerhsize=7in -%\outervsize=9.5in -% Alternative @smallbook page size is 9.25in -\outervsize=9.25in -\topandbottommargin=.75in - -% Main output routine. -\chardef\PAGE = 255 -\output = {\onepageout{\pagecontents\PAGE}} - -\newbox\headlinebox -\newbox\footlinebox - -% \onepageout takes a vbox as an argument. Note that \pagecontents -% does insertions, but you have to call it yourself. -\def\onepageout#1{% - \ifcropmarks \hoffset=0pt \else \hoffset=\normaloffset \fi - % - \ifodd\pageno \advance\hoffset by \bindingoffset - \else \advance\hoffset by -\bindingoffset\fi - % - % Do this outside of the \shipout so @code etc. will be expanded in - % the headline as they should be, not taken literally (outputting ''code). - \setbox\headlinebox = \vbox{\let\hsize=\pagewidth \makeheadline}% - \setbox\footlinebox = \vbox{\let\hsize=\pagewidth \makefootline}% - % - {% - % Have to do this stuff outside the \shipout because we want it to - % take effect in \write's, yet the group defined by the \vbox ends - % before the \shipout runs. - % - \escapechar = `\\ % use backslash in output files. - \indexdummies % don't expand commands in the output. - \normalturnoffactive % \ in index entries must not stay \, e.g., if - % the page break happens to be in the middle of an example. - \shipout\vbox{% - \ifcropmarks \vbox to \outervsize\bgroup - \hsize = \outerhsize - \line{\ewtop\hfil\ewtop}% - \nointerlineskip - \line{% - \vbox{\moveleft\cornerthick\nstop}% - \hfill - \vbox{\moveright\cornerthick\nstop}% - }% - \vskip\topandbottommargin - \line\bgroup - \hfil % center the page within the outer (page) hsize. - \ifodd\pageno\hskip\bindingoffset\fi - \vbox\bgroup - \fi - % - \unvbox\headlinebox - \pagebody{#1}% - \ifdim\ht\footlinebox > 0pt - % Only leave this space if the footline is nonempty. - % (We lessened \vsize for it in \oddfootingxxx.) - % The \baselineskip=24pt in plain's \makefootline has no effect. - \vskip 2\baselineskip - \unvbox\footlinebox - \fi - % - \ifcropmarks - \egroup % end of \vbox\bgroup - \hfil\egroup % end of (centering) \line\bgroup - \vskip\topandbottommargin plus1fill minus1fill - \boxmaxdepth = \cornerthick - \line{% - \vbox{\moveleft\cornerthick\nsbot}% - \hfill - \vbox{\moveright\cornerthick\nsbot}% - }% - \nointerlineskip - \line{\ewbot\hfil\ewbot}% - \egroup % \vbox from first cropmarks clause - \fi - }% end of \shipout\vbox - }% end of group with \turnoffactive - \advancepageno - \ifnum\outputpenalty>-20000 \else\dosupereject\fi -} - -\newinsert\margin \dimen\margin=\maxdimen - -\def\pagebody#1{\vbox to\pageheight{\boxmaxdepth=\maxdepth #1}} -{\catcode`\@ =11 -\gdef\pagecontents#1{\ifvoid\topins\else\unvbox\topins\fi -% marginal hacks, juha@viisa.uucp (Juha Takala) -\ifvoid\margin\else % marginal info is present - \rlap{\kern\hsize\vbox to\z@{\kern1pt\box\margin \vss}}\fi -\dimen@=\dp#1 \unvbox#1 -\ifvoid\footins\else\vskip\skip\footins\footnoterule \unvbox\footins\fi -\ifr@ggedbottom \kern-\dimen@ \vfil \fi} -} - -% Here are the rules for the cropmarks. Note that they are -% offset so that the space between them is truly \outerhsize or \outervsize -% (P. A. MacKay, 12 November, 1986) -% -\def\ewtop{\vrule height\cornerthick depth0pt width\cornerlong} -\def\nstop{\vbox - {\hrule height\cornerthick depth\cornerlong width\cornerthick}} -\def\ewbot{\vrule height0pt depth\cornerthick width\cornerlong} -\def\nsbot{\vbox - {\hrule height\cornerlong depth\cornerthick width\cornerthick}} - -% Parse an argument, then pass it to #1. The argument is the rest of -% the input line (except we remove a trailing comment). #1 should be a -% macro which expects an ordinary undelimited TeX argument. -% -\def\parsearg#1{% - \let\next = #1% - \begingroup - \obeylines - \futurelet\temp\parseargx -} - -% If the next token is an obeyed space (from an @example environment or -% the like), remove it and recurse. Otherwise, we're done. -\def\parseargx{% - % \obeyedspace is defined far below, after the definition of \sepspaces. - \ifx\obeyedspace\temp - \expandafter\parseargdiscardspace - \else - \expandafter\parseargline - \fi -} - -% Remove a single space (as the delimiter token to the macro call). -{\obeyspaces % - \gdef\parseargdiscardspace {\futurelet\temp\parseargx}} - -{\obeylines % - \gdef\parseargline#1^^M{% - \endgroup % End of the group started in \parsearg. - % - % First remove any @c comment, then any @comment. - % Result of each macro is put in \toks0. - \argremovec #1\c\relax % - \expandafter\argremovecomment \the\toks0 \comment\relax % - % - % Call the caller's macro, saved as \next in \parsearg. - \expandafter\next\expandafter{\the\toks0}% - }% -} - -% Since all \c{,omment} does is throw away the argument, we can let TeX -% do that for us. The \relax here is matched by the \relax in the call -% in \parseargline; it could be more or less anything, its purpose is -% just to delimit the argument to the \c. -\def\argremovec#1\c#2\relax{\toks0 = {#1}} -\def\argremovecomment#1\comment#2\relax{\toks0 = {#1}} - -% \argremovec{,omment} might leave us with trailing spaces, though; e.g., -% @end itemize @c foo -% will have two active spaces as part of the argument with the -% `itemize'. Here we remove all active spaces from #1, and assign the -% result to \toks0. -% -% This loses if there are any *other* active characters besides spaces -% in the argument -- _ ^ +, for example -- since they get expanded. -% Fortunately, Texinfo does not define any such commands. (If it ever -% does, the catcode of the characters in questionwill have to be changed -% here.) But this means we cannot call \removeactivespaces as part of -% \argremovec{,omment}, since @c uses \parsearg, and thus the argument -% that \parsearg gets might well have any character at all in it. -% -\def\removeactivespaces#1{% - \begingroup - \ignoreactivespaces - \edef\temp{#1}% - \global\toks0 = \expandafter{\temp}% - \endgroup -} - -% Change the active space to expand to nothing. -% -\begingroup - \obeyspaces - \gdef\ignoreactivespaces{\obeyspaces\let =\empty} -\endgroup - - -\def\flushcr{\ifx\par\lisppar \def\next##1{}\else \let\next=\relax \fi \next} - -%% These are used to keep @begin/@end levels from running away -%% Call \inENV within environments (after a \begingroup) -\newif\ifENV \ENVfalse \def\inENV{\ifENV\relax\else\ENVtrue\fi} -\def\ENVcheck{% -\ifENV\errmessage{Still within an environment. Type Return to continue.} -\endgroup\fi} % This is not perfect, but it should reduce lossage - -% @begin foo is the same as @foo, for now. -\newhelp\EMsimple{Type <Return> to continue.} - -\outer\def\begin{\parsearg\beginxxx} - -\def\beginxxx #1{% -\expandafter\ifx\csname #1\endcsname\relax -{\errhelp=\EMsimple \errmessage{Undefined command @begin #1}}\else -\csname #1\endcsname\fi} - -% @end foo executes the definition of \Efoo. -% -\def\end{\parsearg\endxxx} -\def\endxxx #1{% - \removeactivespaces{#1}% - \edef\endthing{\the\toks0}% - % - \expandafter\ifx\csname E\endthing\endcsname\relax - \expandafter\ifx\csname \endthing\endcsname\relax - % There's no \foo, i.e., no ``environment'' foo. - \errhelp = \EMsimple - \errmessage{Undefined command `@end \endthing'}% - \else - \unmatchedenderror\endthing - \fi - \else - % Everything's ok; the right environment has been started. - \csname E\endthing\endcsname - \fi -} - -% There is an environment #1, but it hasn't been started. Give an error. -% -\def\unmatchedenderror#1{% - \errhelp = \EMsimple - \errmessage{This `@end #1' doesn't have a matching `@#1'}% -} - -% Define the control sequence \E#1 to give an unmatched @end error. -% -\def\defineunmatchedend#1{% - \expandafter\def\csname E#1\endcsname{\unmatchedenderror{#1}}% -} - - -% Single-spacing is done by various environments (specifically, in -% \nonfillstart and \quotations). -\newskip\singlespaceskip \singlespaceskip = 12.5pt -\def\singlespace{% - % Why was this kern here? It messes up equalizing space above and below - % environments. --karl, 6may93 - %{\advance \baselineskip by -\singlespaceskip - %\kern \baselineskip}% - \setleading \singlespaceskip -} - -%% Simple single-character @ commands - -% @@ prints an @ -% Kludge this until the fonts are right (grr). -\def\@{{\tt \char '100}} - -% This is turned off because it was never documented -% and you can use @w{...} around a quote to suppress ligatures. -%% Define @` and @' to be the same as ` and ' -%% but suppressing ligatures. -%\def\`{{`}} -%\def\'{{'}} - -% Used to generate quoted braces. -\def\mylbrace {{\tt \char '173}} -\def\myrbrace {{\tt \char '175}} -\let\{=\mylbrace -\let\}=\myrbrace -\begingroup - % Definitions to produce actual \{ & \} command in an index. - \catcode`\{ = 12 \catcode`\} = 12 - \catcode`\[ = 1 \catcode`\] = 2 - \catcode`\@ = 0 \catcode`\\ = 12 - @gdef@lbracecmd[\{]% - @gdef@rbracecmd[\}]% -@endgroup - -% Accents: @, @dotaccent @ringaccent @ubaraccent @udotaccent -% Others are defined by plain TeX: @` @' @" @^ @~ @= @v @H. -\let\, = \c -\let\dotaccent = \. -\def\ringaccent#1{{\accent23 #1}} -\let\tieaccent = \t -\let\ubaraccent = \b -\let\udotaccent = \d - -% Other special characters: @questiondown @exclamdown -% Plain TeX defines: @AA @AE @O @OE @L (and lowercase versions) @ss. -\def\questiondown{?`} -\def\exclamdown{!`} - -% Dotless i and dotless j, used for accents. -\def\imacro{i} -\def\jmacro{j} -\def\dotless#1{% - \def\temp{#1}% - \ifx\temp\imacro \ptexi - \else\ifx\temp\jmacro \j - \else \errmessage{@dotless can be used only with i or j}% - \fi\fi -} - -% @: forces normal size whitespace following. -\def\:{\spacefactor=1000 } - -% @* forces a line break. -\def\*{\hfil\break\hbox{}\ignorespaces} - -% @. is an end-of-sentence period. -\def\.{.\spacefactor=3000 } - -% @! is an end-of-sentence bang. -\def\!{!\spacefactor=3000 } - -% @? is an end-of-sentence query. -\def\?{?\spacefactor=3000 } - -% @w prevents a word break. Without the \leavevmode, @w at the -% beginning of a paragraph, when TeX is still in vertical mode, would -% produce a whole line of output instead of starting the paragraph. -\def\w#1{\leavevmode\hbox{#1}} - -% @group ... @end group forces ... to be all on one page, by enclosing -% it in a TeX vbox. We use \vtop instead of \vbox to construct the box -% to keep its height that of a normal line. According to the rules for -% \topskip (p.114 of the TeXbook), the glue inserted is -% max (\topskip - \ht (first item), 0). If that height is large, -% therefore, no glue is inserted, and the space between the headline and -% the text is small, which looks bad. -% -\def\group{\begingroup - \ifnum\catcode13=\active \else - \errhelp = \groupinvalidhelp - \errmessage{@group invalid in context where filling is enabled}% - \fi - % - % The \vtop we start below produces a box with normal height and large - % depth; thus, TeX puts \baselineskip glue before it, and (when the - % next line of text is done) \lineskip glue after it. (See p.82 of - % the TeXbook.) Thus, space below is not quite equal to space - % above. But it's pretty close. - \def\Egroup{% - \egroup % End the \vtop. - \endgroup % End the \group. - }% - % - \vtop\bgroup - % We have to put a strut on the last line in case the @group is in - % the midst of an example, rather than completely enclosing it. - % Otherwise, the interline space between the last line of the group - % and the first line afterwards is too small. But we can't put the - % strut in \Egroup, since there it would be on a line by itself. - % Hence this just inserts a strut at the beginning of each line. - \everypar = {\strut}% - % - % Since we have a strut on every line, we don't need any of TeX's - % normal interline spacing. - \offinterlineskip - % - % OK, but now we have to do something about blank - % lines in the input in @example-like environments, which normally - % just turn into \lisppar, which will insert no space now that we've - % turned off the interline space. Simplest is to make them be an - % empty paragraph. - \ifx\par\lisppar - \edef\par{\leavevmode \par}% - % - % Reset ^^M's definition to new definition of \par. - \obeylines - \fi - % - % Do @comment since we are called inside an environment such as - % @example, where each end-of-line in the input causes an - % end-of-line in the output. We don't want the end-of-line after - % the `@group' to put extra space in the output. Since @group - % should appear on a line by itself (according to the Texinfo - % manual), we don't worry about eating any user text. - \comment -} -% -% TeX puts in an \escapechar (i.e., `@') at the beginning of the help -% message, so this ends up printing `@group can only ...'. -% -\newhelp\groupinvalidhelp{% -group can only be used in environments such as @example,^^J% -where each line of input produces a line of output.} - -% @need space-in-mils -% forces a page break if there is not space-in-mils remaining. - -\newdimen\mil \mil=0.001in - -\def\need{\parsearg\needx} - -% Old definition--didn't work. -%\def\needx #1{\par % -%% This method tries to make TeX break the page naturally -%% if the depth of the box does not fit. -%{\baselineskip=0pt% -%\vtop to #1\mil{\vfil}\kern -#1\mil\penalty 10000 -%\prevdepth=-1000pt -%}} - -\def\needx#1{% - % Go into vertical mode, so we don't make a big box in the middle of a - % paragraph. - \par - % - % Don't add any leading before our big empty box, but allow a page - % break, since the best break might be right here. - \allowbreak - \nointerlineskip - \vtop to #1\mil{\vfil}% - % - % TeX does not even consider page breaks if a penalty added to the - % main vertical list is 10000 or more. But in order to see if the - % empty box we just added fits on the page, we must make it consider - % page breaks. On the other hand, we don't want to actually break the - % page after the empty box. So we use a penalty of 9999. - % - % There is an extremely small chance that TeX will actually break the - % page at this \penalty, if there are no other feasible breakpoints in - % sight. (If the user is using lots of big @group commands, which - % almost-but-not-quite fill up a page, TeX will have a hard time doing - % good page breaking, for example.) However, I could not construct an - % example where a page broke at this \penalty; if it happens in a real - % document, then we can reconsider our strategy. - \penalty9999 - % - % Back up by the size of the box, whether we did a page break or not. - \kern -#1\mil - % - % Do not allow a page break right after this kern. - \nobreak -} - -% @br forces paragraph break - -\let\br = \par - -% @dots{} output an ellipsis using the current font. -% We do .5em per period so that it has the same spacing in a typewriter -% font as three actual period characters. -% -\def\dots{\hbox to 1.5em{% - \hskip 0pt plus 0.25fil minus 0.25fil - .\hss.\hss.% - \hskip 0pt plus 0.5fil minus 0.5fil -}} - -% @enddots{} is an end-of-sentence ellipsis. -% -\def\enddots{% - \hbox to 2em{% - \hskip 0pt plus 0.25fil minus 0.25fil - .\hss.\hss.\hss.% - \hskip 0pt plus 0.5fil minus 0.5fil - }% - \spacefactor=3000 -} - - -% @page forces the start of a new page - -\def\page{\par\vfill\supereject} - -% @exdent text.... -% outputs text on separate line in roman font, starting at standard page margin - -% This records the amount of indent in the innermost environment. -% That's how much \exdent should take out. -\newskip\exdentamount - -% This defn is used inside fill environments such as @defun. -\def\exdent{\parsearg\exdentyyy} -\def\exdentyyy #1{{\hfil\break\hbox{\kern -\exdentamount{\rm#1}}\hfil\break}} - -% This defn is used inside nofill environments such as @example. -\def\nofillexdent{\parsearg\nofillexdentyyy} -\def\nofillexdentyyy #1{{\advance \leftskip by -\exdentamount -\leftline{\hskip\leftskip{\rm#1}}}} - -% @inmargin{TEXT} puts TEXT in the margin next to the current paragraph. - -\def\inmargin#1{% -\strut\vadjust{\nobreak\kern-\strutdepth - \vtop to \strutdepth{\baselineskip\strutdepth\vss - \llap{\rightskip=\inmarginspacing \vbox{\noindent #1}}\null}}} -\newskip\inmarginspacing \inmarginspacing=1cm -\def\strutdepth{\dp\strutbox} - -%\hbox{{\rm#1}}\hfil\break}} - -% @include file insert text of that file as input. -% Allow normal characters that we make active in the argument (a file name). -\def\include{\begingroup - \catcode`\\=12 - \catcode`~=12 - \catcode`^=12 - \catcode`_=12 - \catcode`|=12 - \catcode`<=12 - \catcode`>=12 - \catcode`+=12 - \parsearg\includezzz} -% Restore active chars for included file. -\def\includezzz#1{\endgroup\begingroup - % Read the included file in a group so nested @include's work. - \def\thisfile{#1}% - \input\thisfile -\endgroup} - -\def\thisfile{} - -% @center line outputs that line, centered - -\def\center{\parsearg\centerzzz} -\def\centerzzz #1{{\advance\hsize by -\leftskip -\advance\hsize by -\rightskip -\centerline{#1}}} - -% @sp n outputs n lines of vertical space - -\def\sp{\parsearg\spxxx} -\def\spxxx #1{\vskip #1\baselineskip} - -% @comment ...line which is ignored... -% @c is the same as @comment -% @ignore ... @end ignore is another way to write a comment - -\def\comment{\catcode 64=\other \catcode 123=\other \catcode 125=\other% -\parsearg \commentxxx} - -\def\commentxxx #1{\catcode 64=0 \catcode 123=1 \catcode 125=2 } - -\let\c=\comment - -% @paragraphindent is defined for the Info formatting commands only. -\let\paragraphindent=\comment - -% Prevent errors for section commands. -% Used in @ignore and in failing conditionals. -\def\ignoresections{% -\let\chapter=\relax -\let\unnumbered=\relax -\let\top=\relax -\let\unnumberedsec=\relax -\let\unnumberedsection=\relax -\let\unnumberedsubsec=\relax -\let\unnumberedsubsection=\relax -\let\unnumberedsubsubsec=\relax -\let\unnumberedsubsubsection=\relax -\let\section=\relax -\let\subsec=\relax -\let\subsubsec=\relax -\let\subsection=\relax -\let\subsubsection=\relax -\let\appendix=\relax -\let\appendixsec=\relax -\let\appendixsection=\relax -\let\appendixsubsec=\relax -\let\appendixsubsection=\relax -\let\appendixsubsubsec=\relax -\let\appendixsubsubsection=\relax -\let\contents=\relax -\let\smallbook=\relax -\let\titlepage=\relax -} - -% Used in nested conditionals, where we have to parse the Texinfo source -% and so want to turn off most commands, in case they are used -% incorrectly. -% -\def\ignoremorecommands{% - \let\defcodeindex = \relax - \let\defcv = \relax - \let\deffn = \relax - \let\deffnx = \relax - \let\defindex = \relax - \let\defivar = \relax - \let\defmac = \relax - \let\defmethod = \relax - \let\defop = \relax - \let\defopt = \relax - \let\defspec = \relax - \let\deftp = \relax - \let\deftypefn = \relax - \let\deftypefun = \relax - \let\deftypevar = \relax - \let\deftypevr = \relax - \let\defun = \relax - \let\defvar = \relax - \let\defvr = \relax - \let\ref = \relax - \let\xref = \relax - \let\printindex = \relax - \let\pxref = \relax - \let\settitle = \relax - \let\setchapternewpage = \relax - \let\setchapterstyle = \relax - \let\everyheading = \relax - \let\evenheading = \relax - \let\oddheading = \relax - \let\everyfooting = \relax - \let\evenfooting = \relax - \let\oddfooting = \relax - \let\headings = \relax - \let\include = \relax - \let\lowersections = \relax - \let\down = \relax - \let\raisesections = \relax - \let\up = \relax - \let\set = \relax - \let\clear = \relax - \let\item = \relax -} - -% Ignore @ignore ... @end ignore. -% -\def\ignore{\doignore{ignore}} - -% Ignore @ifinfo, @ifhtml, @ifnottex, @html, @menu, and @direntry text. -% -\def\ifinfo{\doignore{ifinfo}} -\def\ifhtml{\doignore{ifhtml}} -\def\ifnottex{\doignore{ifnottex}} -\def\html{\doignore{html}} -\def\menu{\doignore{menu}} -\def\direntry{\doignore{direntry}} - -% Also ignore @macro ... @end macro. The user must run texi2dvi, -% which runs makeinfo to do macro expansion. Ignore @unmacro, too. -\def\macro{\doignore{macro}} -\let\unmacro = \comment - - -% @dircategory CATEGORY -- specify a category of the dir file -% which this file should belong to. Ignore this in TeX. -\let\dircategory = \comment - -% Ignore text until a line `@end #1'. -% -\def\doignore#1{\begingroup - % Don't complain about control sequences we have declared \outer. - \ignoresections - % - % Define a command to swallow text until we reach `@end #1'. - \long\def\doignoretext##1\end #1{\enddoignore}% - % - % Make sure that spaces turn into tokens that match what \doignoretext wants. - \catcode32 = 10 - % - % Ignore braces, too, so mismatched braces don't cause trouble. - \catcode`\{ = 9 - \catcode`\} = 9 - % - % And now expand that command. - \doignoretext -} - -% What we do to finish off ignored text. -% -\def\enddoignore{\endgroup\ignorespaces}% - -\newif\ifwarnedobs\warnedobsfalse -\def\obstexwarn{% - \ifwarnedobs\relax\else - % We need to warn folks that they may have trouble with TeX 3.0. - % This uses \immediate\write16 rather than \message to get newlines. - \immediate\write16{} - \immediate\write16{***WARNING*** for users of Unix TeX 3.0!} - \immediate\write16{This manual trips a bug in TeX version 3.0 (tex hangs).} - \immediate\write16{If you are running another version of TeX, relax.} - \immediate\write16{If you are running Unix TeX 3.0, kill this TeX process.} - \immediate\write16{ Then upgrade your TeX installation if you can.} - \immediate\write16{ (See ftp://ftp.gnu.ai.mit.edu/pub/gnu/TeX.README.)} - \immediate\write16{If you are stuck with version 3.0, run the} - \immediate\write16{ script ``tex3patch'' from the Texinfo distribution} - \immediate\write16{ to use a workaround.} - \immediate\write16{} - \global\warnedobstrue - \fi -} - -% **In TeX 3.0, setting text in \nullfont hangs tex. For a -% workaround (which requires the file ``dummy.tfm'' to be installed), -% uncomment the following line: -%%%%%\font\nullfont=dummy\let\obstexwarn=\relax - -% Ignore text, except that we keep track of conditional commands for -% purposes of nesting, up to an `@end #1' command. -% -\def\nestedignore#1{% - \obstexwarn - % We must actually expand the ignored text to look for the @end - % command, so that nested ignore constructs work. Thus, we put the - % text into a \vbox and then do nothing with the result. To minimize - % the change of memory overflow, we follow the approach outlined on - % page 401 of the TeXbook: make the current font be a dummy font. - % - \setbox0 = \vbox\bgroup - % Don't complain about control sequences we have declared \outer. - \ignoresections - % - % Define `@end #1' to end the box, which will in turn undefine the - % @end command again. - \expandafter\def\csname E#1\endcsname{\egroup\ignorespaces}% - % - % We are going to be parsing Texinfo commands. Most cause no - % trouble when they are used incorrectly, but some commands do - % complicated argument parsing or otherwise get confused, so we - % undefine them. - % - % We can't do anything about stray @-signs, unfortunately; - % they'll produce `undefined control sequence' errors. - \ignoremorecommands - % - % Set the current font to be \nullfont, a TeX primitive, and define - % all the font commands to also use \nullfont. We don't use - % dummy.tfm, as suggested in the TeXbook, because not all sites - % might have that installed. Therefore, math mode will still - % produce output, but that should be an extremely small amount of - % stuff compared to the main input. - % - \nullfont - \let\tenrm = \nullfont \let\tenit = \nullfont \let\tensl = \nullfont - \let\tenbf = \nullfont \let\tentt = \nullfont \let\smallcaps = \nullfont - \let\tensf = \nullfont - % Similarly for index fonts (mostly for their use in - % smallexample) - \let\indrm = \nullfont \let\indit = \nullfont \let\indsl = \nullfont - \let\indbf = \nullfont \let\indtt = \nullfont \let\indsc = \nullfont - \let\indsf = \nullfont - % - % Don't complain when characters are missing from the fonts. - \tracinglostchars = 0 - % - % Don't bother to do space factor calculations. - \frenchspacing - % - % Don't report underfull hboxes. - \hbadness = 10000 - % - % Do minimal line-breaking. - \pretolerance = 10000 - % - % Do not execute instructions in @tex - \def\tex{\doignore{tex}}% -} - -% @set VAR sets the variable VAR to an empty value. -% @set VAR REST-OF-LINE sets VAR to the value REST-OF-LINE. -% -% Since we want to separate VAR from REST-OF-LINE (which might be -% empty), we can't just use \parsearg; we have to insert a space of our -% own to delimit the rest of the line, and then take it out again if we -% didn't need it. Make sure the catcode of space is correct to avoid -% losing inside @example, for instance. -% -\def\set{\begingroup\catcode` =10 - \catcode`\-=12 \catcode`\_=12 % Allow - and _ in VAR. - \parsearg\setxxx} -\def\setxxx#1{\setyyy#1 \endsetyyy} -\def\setyyy#1 #2\endsetyyy{% - \def\temp{#2}% - \ifx\temp\empty \global\expandafter\let\csname SET#1\endcsname = \empty - \else \setzzz{#1}#2\endsetzzz % Remove the trailing space \setxxx inserted. - \fi - \endgroup -} -% Can't use \xdef to pre-expand #2 and save some time, since \temp or -% \next or other control sequences that we've defined might get us into -% an infinite loop. Consider `@set foo @cite{bar}'. -\def\setzzz#1#2 \endsetzzz{\expandafter\gdef\csname SET#1\endcsname{#2}} - -% @clear VAR clears (i.e., unsets) the variable VAR. -% -\def\clear{\parsearg\clearxxx} -\def\clearxxx#1{\global\expandafter\let\csname SET#1\endcsname=\relax} - -% @value{foo} gets the text saved in variable foo. -% -\def\value{\begingroup - \catcode`\-=12 \catcode`\_=12 % Allow - and _ in VAR. - \valuexxx} -\def\valuexxx#1{% - \expandafter\ifx\csname SET#1\endcsname\relax - {\{No value for ``#1''\}}% - \else - \csname SET#1\endcsname - \fi -\endgroup} - -% @ifset VAR ... @end ifset reads the `...' iff VAR has been defined -% with @set. -% -\def\ifset{\parsearg\ifsetxxx} -\def\ifsetxxx #1{% - \expandafter\ifx\csname SET#1\endcsname\relax - \expandafter\ifsetfail - \else - \expandafter\ifsetsucceed - \fi -} -\def\ifsetsucceed{\conditionalsucceed{ifset}} -\def\ifsetfail{\nestedignore{ifset}} -\defineunmatchedend{ifset} - -% @ifclear VAR ... @end ifclear reads the `...' iff VAR has never been -% defined with @set, or has been undefined with @clear. -% -\def\ifclear{\parsearg\ifclearxxx} -\def\ifclearxxx #1{% - \expandafter\ifx\csname SET#1\endcsname\relax - \expandafter\ifclearsucceed - \else - \expandafter\ifclearfail - \fi -} -\def\ifclearsucceed{\conditionalsucceed{ifclear}} -\def\ifclearfail{\nestedignore{ifclear}} -\defineunmatchedend{ifclear} - -% @iftex, @ifnothtml, @ifnotinfo always succeed; we read the text -% following, through the first @end iftex (etc.). Make `@end iftex' -% (etc.) valid only after an @iftex. -% -\def\iftex{\conditionalsucceed{iftex}} -\def\ifnothtml{\conditionalsucceed{ifnothtml}} -\def\ifnotinfo{\conditionalsucceed{ifnotinfo}} -\defineunmatchedend{iftex} -\defineunmatchedend{ifnothtml} -\defineunmatchedend{ifnotinfo} - -% We can't just want to start a group at @iftex (for example) and end it -% at @end iftex, since then @set commands inside the conditional have no -% effect (they'd get reverted at the end of the group). So we must -% define \Eiftex to redefine itself to be its previous value. (We can't -% just define it to fail again with an ``unmatched end'' error, since -% the @ifset might be nested.) -% -\def\conditionalsucceed#1{% - \edef\temp{% - % Remember the current value of \E#1. - \let\nece{prevE#1} = \nece{E#1}% - % - % At the `@end #1', redefine \E#1 to be its previous value. - \def\nece{E#1}{\let\nece{E#1} = \nece{prevE#1}}% - }% - \temp -} - -% We need to expand lots of \csname's, but we don't want to expand the -% control sequences after we've constructed them. -% -\def\nece#1{\expandafter\noexpand\csname#1\endcsname} - -% @asis just yields its argument. Used with @table, for example. -% -\def\asis#1{#1} - -% @math means output in math mode. -% We don't use $'s directly in the definition of \math because control -% sequences like \math are expanded when the toc file is written. Then, -% we read the toc file back, the $'s will be normal characters (as they -% should be, according to the definition of Texinfo). So we must use a -% control sequence to switch into and out of math mode. -% -% This isn't quite enough for @math to work properly in indices, but it -% seems unlikely it will ever be needed there. -% -\let\implicitmath = $ -\def\math#1{\implicitmath #1\implicitmath} - -% @bullet and @minus need the same treatment as @math, just above. -\def\bullet{\implicitmath\ptexbullet\implicitmath} -\def\minus{\implicitmath-\implicitmath} - -\def\node{\ENVcheck\parsearg\nodezzz} -\def\nodezzz#1{\nodexxx [#1,]} -\def\nodexxx[#1,#2]{\gdef\lastnode{#1}} -\let\nwnode=\node -\let\lastnode=\relax - -\def\donoderef{\ifx\lastnode\relax\else -\expandafter\expandafter\expandafter\setref{\lastnode}\fi -\global\let\lastnode=\relax} - -\def\unnumbnoderef{\ifx\lastnode\relax\else -\expandafter\expandafter\expandafter\unnumbsetref{\lastnode}\fi -\global\let\lastnode=\relax} - -\def\appendixnoderef{\ifx\lastnode\relax\else -\expandafter\expandafter\expandafter\appendixsetref{\lastnode}\fi -\global\let\lastnode=\relax} - -% @refill is a no-op. -\let\refill=\relax - -% @setfilename is done at the beginning of every texinfo file. -% So open here the files we need to have open while reading the input. -% This makes it possible to make a .fmt file for texinfo. -\def\setfilename{% - \readauxfile - \opencontents - \openindices - \fixbackslash % Turn off hack to swallow `\input texinfo'. - \global\let\setfilename=\comment % Ignore extra @setfilename cmds. - % - % If texinfo.cnf is present on the system, read it. - % Useful for site-wide @afourpaper, etc. - % Just to be on the safe side, close the input stream before the \input. - \openin 1 texinfo.cnf - \ifeof1 \let\temp=\relax \else \def\temp{\input texinfo.cnf }\fi - \closein1 - \temp - % - \comment % Ignore the actual filename. -} - -% @bye. -\outer\def\bye{\pagealignmacro\tracingstats=1\ptexend} - -% \def\macro#1{\begingroup\ignoresections\catcode`\#=6\def\macrotemp{#1}\parsearg\macroxxx} -% \def\macroxxx#1#2 \end macro{% -% \expandafter\gdef\macrotemp#1{#2}% -% \endgroup} - -%\def\linemacro#1{\begingroup\ignoresections\catcode`\#=6\def\macrotemp{#1}\parsearg\linemacroxxx} -%\def\linemacroxxx#1#2 \end linemacro{% -%\let\parsearg=\relax -%\edef\macrotempx{\csname M\butfirst\expandafter\string\macrotemp\endcsname}% -%\expandafter\xdef\macrotemp{\parsearg\macrotempx}% -%\expandafter\gdef\macrotempx#1{#2}% -%\endgroup} - -%\def\butfirst#1{} - - -\message{fonts,} - -% Font-change commands. - -% Texinfo supports the sans serif font style, which plain TeX does not. -% So we set up a \sf analogous to plain's \rm, etc. -\newfam\sffam -\def\sf{\fam=\sffam \tensf} -\let\li = \sf % Sometimes we call it \li, not \sf. - -% We don't need math for this one. -\def\ttsl{\tenttsl} - -% Use Computer Modern fonts at \magstephalf (11pt). -\newcount\mainmagstep -\mainmagstep=\magstephalf - -% Set the font macro #1 to the font named #2, adding on the -% specified font prefix (normally `cm'). -% #3 is the font's design size, #4 is a scale factor -\def\setfont#1#2#3#4{\font#1=\fontprefix#2#3 scaled #4} - -% Use cm as the default font prefix. -% To specify the font prefix, you must define \fontprefix -% before you read in texinfo.tex. -\ifx\fontprefix\undefined -\def\fontprefix{cm} -\fi -% Support font families that don't use the same naming scheme as CM. -\def\rmshape{r} -\def\rmbshape{bx} %where the normal face is bold -\def\bfshape{b} -\def\bxshape{bx} -\def\ttshape{tt} -\def\ttbshape{tt} -\def\ttslshape{sltt} -\def\itshape{ti} -\def\itbshape{bxti} -\def\slshape{sl} -\def\slbshape{bxsl} -\def\sfshape{ss} -\def\sfbshape{ss} -\def\scshape{csc} -\def\scbshape{csc} - -\ifx\bigger\relax -\let\mainmagstep=\magstep1 -\setfont\textrm\rmshape{12}{1000} -\setfont\texttt\ttshape{12}{1000} -\else -\setfont\textrm\rmshape{10}{\mainmagstep} -\setfont\texttt\ttshape{10}{\mainmagstep} -\fi -% Instead of cmb10, you many want to use cmbx10. -% cmbx10 is a prettier font on its own, but cmb10 -% looks better when embedded in a line with cmr10. -\setfont\textbf\bfshape{10}{\mainmagstep} -\setfont\textit\itshape{10}{\mainmagstep} -\setfont\textsl\slshape{10}{\mainmagstep} -\setfont\textsf\sfshape{10}{\mainmagstep} -\setfont\textsc\scshape{10}{\mainmagstep} -\setfont\textttsl\ttslshape{10}{\mainmagstep} -\font\texti=cmmi10 scaled \mainmagstep -\font\textsy=cmsy10 scaled \mainmagstep - -% A few fonts for @defun, etc. -\setfont\defbf\bxshape{10}{\magstep1} %was 1314 -\setfont\deftt\ttshape{10}{\magstep1} -\def\df{\let\tentt=\deftt \let\tenbf = \defbf \bf} - -% Fonts for indices and small examples (9pt). -% We actually use the slanted font rather than the italic, -% because texinfo normally uses the slanted fonts for that. -% Do not make many font distinctions in general in the index, since they -% aren't very useful. -\setfont\ninett\ttshape{9}{1000} -\setfont\indrm\rmshape{9}{1000} -\setfont\indit\slshape{9}{1000} -\let\indsl=\indit -\let\indtt=\ninett -\let\indttsl=\ninett -\let\indsf=\indrm -\let\indbf=\indrm -\setfont\indsc\scshape{10}{900} -\font\indi=cmmi9 -\font\indsy=cmsy9 - -% Fonts for title page: -\setfont\titlerm\rmbshape{12}{\magstep3} -\setfont\titleit\itbshape{10}{\magstep4} -\setfont\titlesl\slbshape{10}{\magstep4} -\setfont\titlett\ttbshape{12}{\magstep3} -\setfont\titlettsl\ttslshape{10}{\magstep4} -\setfont\titlesf\sfbshape{17}{\magstep1} -\let\titlebf=\titlerm -\setfont\titlesc\scbshape{10}{\magstep4} -\font\titlei=cmmi12 scaled \magstep3 -\font\titlesy=cmsy10 scaled \magstep4 -\def\authorrm{\secrm} - -% Chapter (and unnumbered) fonts (17.28pt). -\setfont\chaprm\rmbshape{12}{\magstep2} -\setfont\chapit\itbshape{10}{\magstep3} -\setfont\chapsl\slbshape{10}{\magstep3} -\setfont\chaptt\ttbshape{12}{\magstep2} -\setfont\chapttsl\ttslshape{10}{\magstep3} -\setfont\chapsf\sfbshape{17}{1000} -\let\chapbf=\chaprm -\setfont\chapsc\scbshape{10}{\magstep3} -\font\chapi=cmmi12 scaled \magstep2 -\font\chapsy=cmsy10 scaled \magstep3 - -% Section fonts (14.4pt). -\setfont\secrm\rmbshape{12}{\magstep1} -\setfont\secit\itbshape{10}{\magstep2} -\setfont\secsl\slbshape{10}{\magstep2} -\setfont\sectt\ttbshape{12}{\magstep1} -\setfont\secttsl\ttslshape{10}{\magstep2} -\setfont\secsf\sfbshape{12}{\magstep1} -\let\secbf\secrm -\setfont\secsc\scbshape{10}{\magstep2} -\font\seci=cmmi12 scaled \magstep1 -\font\secsy=cmsy10 scaled \magstep2 - -% \setfont\ssecrm\bxshape{10}{\magstep1} % This size an font looked bad. -% \setfont\ssecit\itshape{10}{\magstep1} % The letters were too crowded. -% \setfont\ssecsl\slshape{10}{\magstep1} -% \setfont\ssectt\ttshape{10}{\magstep1} -% \setfont\ssecsf\sfshape{10}{\magstep1} - -%\setfont\ssecrm\bfshape{10}{1315} % Note the use of cmb rather than cmbx. -%\setfont\ssecit\itshape{10}{1315} % Also, the size is a little larger than -%\setfont\ssecsl\slshape{10}{1315} % being scaled magstep1. -%\setfont\ssectt\ttshape{10}{1315} -%\setfont\ssecsf\sfshape{10}{1315} - -%\let\ssecbf=\ssecrm - -% Subsection fonts (13.15pt). -\setfont\ssecrm\rmbshape{12}{\magstephalf} -\setfont\ssecit\itbshape{10}{1315} -\setfont\ssecsl\slbshape{10}{1315} -\setfont\ssectt\ttbshape{12}{\magstephalf} -\setfont\ssecttsl\ttslshape{10}{1315} -\setfont\ssecsf\sfbshape{12}{\magstephalf} -\let\ssecbf\ssecrm -\setfont\ssecsc\scbshape{10}{\magstep1} -\font\sseci=cmmi12 scaled \magstephalf -\font\ssecsy=cmsy10 scaled 1315 -% The smallcaps and symbol fonts should actually be scaled \magstep1.5, -% but that is not a standard magnification. - -% In order for the font changes to affect most math symbols and letters, -% we have to define the \textfont of the standard families. Since -% texinfo doesn't allow for producing subscripts and superscripts, we -% don't bother to reset \scriptfont and \scriptscriptfont (which would -% also require loading a lot more fonts). -% -\def\resetmathfonts{% - \textfont0 = \tenrm \textfont1 = \teni \textfont2 = \tensy - \textfont\itfam = \tenit \textfont\slfam = \tensl \textfont\bffam = \tenbf - \textfont\ttfam = \tentt \textfont\sffam = \tensf -} - - -% The font-changing commands redefine the meanings of \tenSTYLE, instead -% of just \STYLE. We do this so that font changes will continue to work -% in math mode, where it is the current \fam that is relevant in most -% cases, not the current font. Plain TeX does \def\bf{\fam=\bffam -% \tenbf}, for example. By redefining \tenbf, we obviate the need to -% redefine \bf itself. -\def\textfonts{% - \let\tenrm=\textrm \let\tenit=\textit \let\tensl=\textsl - \let\tenbf=\textbf \let\tentt=\texttt \let\smallcaps=\textsc - \let\tensf=\textsf \let\teni=\texti \let\tensy=\textsy \let\tenttsl=\textttsl - \resetmathfonts} -\def\titlefonts{% - \let\tenrm=\titlerm \let\tenit=\titleit \let\tensl=\titlesl - \let\tenbf=\titlebf \let\tentt=\titlett \let\smallcaps=\titlesc - \let\tensf=\titlesf \let\teni=\titlei \let\tensy=\titlesy - \let\tenttsl=\titlettsl - \resetmathfonts \setleading{25pt}} -\def\titlefont#1{{\titlefonts\rm #1}} -\def\chapfonts{% - \let\tenrm=\chaprm \let\tenit=\chapit \let\tensl=\chapsl - \let\tenbf=\chapbf \let\tentt=\chaptt \let\smallcaps=\chapsc - \let\tensf=\chapsf \let\teni=\chapi \let\tensy=\chapsy \let\tenttsl=\chapttsl - \resetmathfonts \setleading{19pt}} -\def\secfonts{% - \let\tenrm=\secrm \let\tenit=\secit \let\tensl=\secsl - \let\tenbf=\secbf \let\tentt=\sectt \let\smallcaps=\secsc - \let\tensf=\secsf \let\teni=\seci \let\tensy=\secsy \let\tenttsl=\secttsl - \resetmathfonts \setleading{16pt}} -\def\subsecfonts{% - \let\tenrm=\ssecrm \let\tenit=\ssecit \let\tensl=\ssecsl - \let\tenbf=\ssecbf \let\tentt=\ssectt \let\smallcaps=\ssecsc - \let\tensf=\ssecsf \let\teni=\sseci \let\tensy=\ssecsy \let\tenttsl=\ssecttsl - \resetmathfonts \setleading{15pt}} -\let\subsubsecfonts = \subsecfonts % Maybe make sssec fonts scaled magstephalf? -\def\indexfonts{% - \let\tenrm=\indrm \let\tenit=\indit \let\tensl=\indsl - \let\tenbf=\indbf \let\tentt=\indtt \let\smallcaps=\indsc - \let\tensf=\indsf \let\teni=\indi \let\tensy=\indsy \let\tenttsl=\indttsl - \resetmathfonts \setleading{12pt}} - -% Set up the default fonts, so we can use them for creating boxes. -% -\textfonts - -% Define these so they can be easily changed for other fonts. -\def\angleleft{$\langle$} -\def\angleright{$\rangle$} - -% Count depth in font-changes, for error checks -\newcount\fontdepth \fontdepth=0 - -% Fonts for short table of contents. -\setfont\shortcontrm\rmshape{12}{1000} -\setfont\shortcontbf\bxshape{12}{1000} -\setfont\shortcontsl\slshape{12}{1000} - -%% Add scribe-like font environments, plus @l for inline lisp (usually sans -%% serif) and @ii for TeX italic - -% \smartitalic{ARG} outputs arg in italics, followed by an italic correction -% unless the following character is such as not to need one. -\def\smartitalicx{\ifx\next,\else\ifx\next-\else\ifx\next.\else\/\fi\fi\fi} -\def\smartitalic#1{{\sl #1}\futurelet\next\smartitalicx} - -\let\i=\smartitalic -\let\var=\smartitalic -\let\dfn=\smartitalic -\let\emph=\smartitalic -\let\cite=\smartitalic - -\def\b#1{{\bf #1}} -\let\strong=\b - -% We can't just use \exhyphenpenalty, because that only has effect at -% the end of a paragraph. Restore normal hyphenation at the end of the -% group within which \nohyphenation is presumably called. -% -\def\nohyphenation{\hyphenchar\font = -1 \aftergroup\restorehyphenation} -\def\restorehyphenation{\hyphenchar\font = `- } - -\def\t#1{% - {\tt \rawbackslash \frenchspacing #1}% - \null -} -\let\ttfont=\t -\def\samp#1{`\tclose{#1}'\null} -\setfont\smallrm\rmshape{8}{1000} -\font\smallsy=cmsy9 -\def\key#1{{\smallrm\textfont2=\smallsy \leavevmode\hbox{% - \raise0.4pt\hbox{\angleleft}\kern-.08em\vtop{% - \vbox{\hrule\kern-0.4pt - \hbox{\raise0.4pt\hbox{\vphantom{\angleleft}}#1}}% - \kern-0.4pt\hrule}% - \kern-.06em\raise0.4pt\hbox{\angleright}}}} -% The old definition, with no lozenge: -%\def\key #1{{\ttsl \nohyphenation \uppercase{#1}}\null} -\def\ctrl #1{{\tt \rawbackslash \hat}#1} - -\let\file=\samp - -% @code is a modification of @t, -% which makes spaces the same size as normal in the surrounding text. -\def\tclose#1{% - {% - % Change normal interword space to be same as for the current font. - \spaceskip = \fontdimen2\font - % - % Switch to typewriter. - \tt - % - % But `\ ' produces the large typewriter interword space. - \def\ {{\spaceskip = 0pt{} }}% - % - % Turn off hyphenation. - \nohyphenation - % - \rawbackslash - \frenchspacing - #1% - }% - \null -} - -% We *must* turn on hyphenation at `-' and `_' in \code. -% Otherwise, it is too hard to avoid overfull hboxes -% in the Emacs manual, the Library manual, etc. - -% Unfortunately, TeX uses one parameter (\hyphenchar) to control -% both hyphenation at - and hyphenation within words. -% We must therefore turn them both off (\tclose does that) -% and arrange explicitly to hyphenate at a dash. -% -- rms. -{ -\catcode`\-=\active -\catcode`\_=\active -\catcode`\|=\active -\global\def\code{\begingroup \catcode`\-=\active \let-\codedash \catcode`\_=\active \let_\codeunder \codex} -% The following is used by \doprintindex to insure that long function names -% wrap around. It is necessary for - and _ to be active before the index is -% read from the file, as \entry parses the arguments long before \code is -% ever called. -- mycroft -% _ is always active; and it shouldn't be \let = to an _ that is a -% subscript character anyway. Then, @cindex @samp{_} (for example) -% fails. --karl -\global\def\indexbreaks{% - \catcode`\-=\active \let-\realdash -} -} - -\def\realdash{-} -\def\codedash{-\discretionary{}{}{}} -\def\codeunder{\ifusingtt{\normalunderscore\discretionary{}{}{}}{\_}} -\def\codex #1{\tclose{#1}\endgroup} - -%\let\exp=\tclose %Was temporary - -% @kbd is like @code, except that if the argument is just one @key command, -% then @kbd has no effect. - -% @kbdinputstyle -- arg is `distinct' (@kbd uses slanted tty font always), -% `example' (@kbd uses ttsl only inside of @example and friends), -% or `code' (@kbd uses normal tty font always). -\def\kbdinputstyle{\parsearg\kbdinputstylexxx} -\def\kbdinputstylexxx#1{% - \def\arg{#1}% - \ifx\arg\worddistinct - \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\ttsl}% - \else\ifx\arg\wordexample - \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\tt}% - \else\ifx\arg\wordcode - \gdef\kbdexamplefont{\tt}\gdef\kbdfont{\tt}% - \fi\fi\fi -} -\def\worddistinct{distinct} -\def\wordexample{example} -\def\wordcode{code} - -% Default is kbdinputdistinct. (Too much of a hassle to call the macro, -% the catcodes are wrong for parsearg to work.) -\gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\ttsl} - -\def\xkey{\key} -\def\kbdfoo#1#2#3\par{\def\one{#1}\def\three{#3}\def\threex{??}% -\ifx\one\xkey\ifx\threex\three \key{#2}% -\else{\tclose{\kbdfont\look}}\fi -\else{\tclose{\kbdfont\look}}\fi} - -% @url. Quotes do not seem necessary, so use \code. -\let\url=\code - -% @uref (abbreviation for `urlref') takes an optional second argument -% specifying the text to display. First (mandatory) arg is the url. -% Perhaps eventually put in a hypertex \special here. -% -\def\uref#1{\urefxxx #1,,\finish} -\def\urefxxx#1,#2,#3\finish{% - \setbox0 = \hbox{\ignorespaces #2}% - \ifdim\wd0 > 0pt - \unhbox0\ (\code{#1})% - \else - \code{#1}% - \fi -} - -% rms does not like the angle brackets --karl, 17may97. -% So now @email is just like @uref. -%\def\email#1{\angleleft{\tt #1}\angleright} -\let\email=\uref - -% Check if we are currently using a typewriter font. Since all the -% Computer Modern typewriter fonts have zero interword stretch (and -% shrink), and it is reasonable to expect all typewriter fonts to have -% this property, we can check that font parameter. -% -\def\ifmonospace{\ifdim\fontdimen3\font=0pt } - -% Typeset a dimension, e.g., `in' or `pt'. The only reason for the -% argument is to make the input look right: @dmn{pt} instead of -% @dmn{}pt. -% -\def\dmn#1{\thinspace #1} - -\def\kbd#1{\def\look{#1}\expandafter\kbdfoo\look??\par} - -% @l was never documented to mean ``switch to the Lisp font'', -% and it is not used as such in any manual I can find. We need it for -% Polish suppressed-l. --karl, 22sep96. -%\def\l#1{{\li #1}\null} - -\def\r#1{{\rm #1}} % roman font -% Use of \lowercase was suggested. -\def\sc#1{{\smallcaps#1}} % smallcaps font -\def\ii#1{{\it #1}} % italic font - -% @pounds{} is a sterling sign. -\def\pounds{{\it\$}} - - -\message{page headings,} - -\newskip\titlepagetopglue \titlepagetopglue = 1.5in -\newskip\titlepagebottomglue \titlepagebottomglue = 2pc - -% First the title page. Must do @settitle before @titlepage. -\newif\ifseenauthor -\newif\iffinishedtitlepage - -\def\shorttitlepage{\parsearg\shorttitlepagezzz} -\def\shorttitlepagezzz #1{\begingroup\hbox{}\vskip 1.5in \chaprm \centerline{#1}% - \endgroup\page\hbox{}\page} - -\def\titlepage{\begingroup \parindent=0pt \textfonts - \let\subtitlerm=\tenrm -% I deinstalled the following change because \cmr12 is undefined. -% This change was not in the ChangeLog anyway. --rms. -% \let\subtitlerm=\cmr12 - \def\subtitlefont{\subtitlerm \normalbaselineskip = 13pt \normalbaselines}% - % - \def\authorfont{\authorrm \normalbaselineskip = 16pt \normalbaselines}% - % - % Leave some space at the very top of the page. - \vglue\titlepagetopglue - % - % Now you can print the title using @title. - \def\title{\parsearg\titlezzz}% - \def\titlezzz##1{\leftline{\titlefonts\rm ##1} - % print a rule at the page bottom also. - \finishedtitlepagefalse - \vskip4pt \hrule height 4pt width \hsize \vskip4pt}% - % No rule at page bottom unless we print one at the top with @title. - \finishedtitlepagetrue - % - % Now you can put text using @subtitle. - \def\subtitle{\parsearg\subtitlezzz}% - \def\subtitlezzz##1{{\subtitlefont \rightline{##1}}}% - % - % @author should come last, but may come many times. - \def\author{\parsearg\authorzzz}% - \def\authorzzz##1{\ifseenauthor\else\vskip 0pt plus 1filll\seenauthortrue\fi - {\authorfont \leftline{##1}}}% - % - % Most title ``pages'' are actually two pages long, with space - % at the top of the second. We don't want the ragged left on the second. - \let\oldpage = \page - \def\page{% - \iffinishedtitlepage\else - \finishtitlepage - \fi - \oldpage - \let\page = \oldpage - \hbox{}}% -% \def\page{\oldpage \hbox{}} -} - -\def\Etitlepage{% - \iffinishedtitlepage\else - \finishtitlepage - \fi - % It is important to do the page break before ending the group, - % because the headline and footline are only empty inside the group. - % If we use the new definition of \page, we always get a blank page - % after the title page, which we certainly don't want. - \oldpage - \endgroup - \HEADINGSon -} - -\def\finishtitlepage{% - \vskip4pt \hrule height 2pt width \hsize - \vskip\titlepagebottomglue - \finishedtitlepagetrue -} - -%%% Set up page headings and footings. - -\let\thispage=\folio - -\newtoks \evenheadline % Token sequence for heading line of even pages -\newtoks \oddheadline % Token sequence for heading line of odd pages -\newtoks \evenfootline % Token sequence for footing line of even pages -\newtoks \oddfootline % Token sequence for footing line of odd pages - -% Now make Tex use those variables -\headline={{\textfonts\rm \ifodd\pageno \the\oddheadline - \else \the\evenheadline \fi}} -\footline={{\textfonts\rm \ifodd\pageno \the\oddfootline - \else \the\evenfootline \fi}\HEADINGShook} -\let\HEADINGShook=\relax - -% Commands to set those variables. -% For example, this is what @headings on does -% @evenheading @thistitle|@thispage|@thischapter -% @oddheading @thischapter|@thispage|@thistitle -% @evenfooting @thisfile|| -% @oddfooting ||@thisfile - -\def\evenheading{\parsearg\evenheadingxxx} -\def\oddheading{\parsearg\oddheadingxxx} -\def\everyheading{\parsearg\everyheadingxxx} - -\def\evenfooting{\parsearg\evenfootingxxx} -\def\oddfooting{\parsearg\oddfootingxxx} -\def\everyfooting{\parsearg\everyfootingxxx} - -{\catcode`\@=0 % - -\gdef\evenheadingxxx #1{\evenheadingyyy #1@|@|@|@|\finish} -\gdef\evenheadingyyy #1@|#2@|#3@|#4\finish{% -\global\evenheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}} - -\gdef\oddheadingxxx #1{\oddheadingyyy #1@|@|@|@|\finish} -\gdef\oddheadingyyy #1@|#2@|#3@|#4\finish{% -\global\oddheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}} - -\gdef\everyheadingxxx#1{\oddheadingxxx{#1}\evenheadingxxx{#1}}% - -\gdef\evenfootingxxx #1{\evenfootingyyy #1@|@|@|@|\finish} -\gdef\evenfootingyyy #1@|#2@|#3@|#4\finish{% -\global\evenfootline={\rlap{\centerline{#2}}\line{#1\hfil#3}}} - -\gdef\oddfootingxxx #1{\oddfootingyyy #1@|@|@|@|\finish} -\gdef\oddfootingyyy #1@|#2@|#3@|#4\finish{% - \global\oddfootline = {\rlap{\centerline{#2}}\line{#1\hfil#3}}% - % - % Leave some space for the footline. Hopefully ok to assume - % @evenfooting will not be used by itself. - \global\advance\pageheight by -\baselineskip - \global\advance\vsize by -\baselineskip -} - -\gdef\everyfootingxxx#1{\oddfootingxxx{#1}\evenfootingxxx{#1}} -% -}% unbind the catcode of @. - -% @headings double turns headings on for double-sided printing. -% @headings single turns headings on for single-sided printing. -% @headings off turns them off. -% @headings on same as @headings double, retained for compatibility. -% @headings after turns on double-sided headings after this page. -% @headings doubleafter turns on double-sided headings after this page. -% @headings singleafter turns on single-sided headings after this page. -% By default, they are off at the start of a document, -% and turned `on' after @end titlepage. - -\def\headings #1 {\csname HEADINGS#1\endcsname} - -\def\HEADINGSoff{ -\global\evenheadline={\hfil} \global\evenfootline={\hfil} -\global\oddheadline={\hfil} \global\oddfootline={\hfil}} -\HEADINGSoff -% When we turn headings on, set the page number to 1. -% For double-sided printing, put current file name in lower left corner, -% chapter name on inside top of right hand pages, document -% title on inside top of left hand pages, and page numbers on outside top -% edge of all pages. -\def\HEADINGSdouble{ -\global\pageno=1 -\global\evenfootline={\hfil} -\global\oddfootline={\hfil} -\global\evenheadline={\line{\folio\hfil\thistitle}} -\global\oddheadline={\line{\thischapter\hfil\folio}} -\global\let\contentsalignmacro = \chapoddpage -} -\let\contentsalignmacro = \chappager - -% For single-sided printing, chapter title goes across top left of page, -% page number on top right. -\def\HEADINGSsingle{ -\global\pageno=1 -\global\evenfootline={\hfil} -\global\oddfootline={\hfil} -\global\evenheadline={\line{\thischapter\hfil\folio}} -\global\oddheadline={\line{\thischapter\hfil\folio}} -\global\let\contentsalignmacro = \chappager -} -\def\HEADINGSon{\HEADINGSdouble} - -\def\HEADINGSafter{\let\HEADINGShook=\HEADINGSdoublex} -\let\HEADINGSdoubleafter=\HEADINGSafter -\def\HEADINGSdoublex{% -\global\evenfootline={\hfil} -\global\oddfootline={\hfil} -\global\evenheadline={\line{\folio\hfil\thistitle}} -\global\oddheadline={\line{\thischapter\hfil\folio}} -\global\let\contentsalignmacro = \chapoddpage -} - -\def\HEADINGSsingleafter{\let\HEADINGShook=\HEADINGSsinglex} -\def\HEADINGSsinglex{% -\global\evenfootline={\hfil} -\global\oddfootline={\hfil} -\global\evenheadline={\line{\thischapter\hfil\folio}} -\global\oddheadline={\line{\thischapter\hfil\folio}} -\global\let\contentsalignmacro = \chappager -} - -% Subroutines used in generating headings -% Produces Day Month Year style of output. -\def\today{\number\day\space -\ifcase\month\or -January\or February\or March\or April\or May\or June\or -July\or August\or September\or October\or November\or December\fi -\space\number\year} - -% Use this if you want the Month Day, Year style of output. -%\def\today{\ifcase\month\or -%January\or February\or March\or April\or May\or June\or -%July\or August\or September\or October\or November\or December\fi -%\space\number\day, \number\year} - -% @settitle line... specifies the title of the document, for headings -% It generates no output of its own - -\def\thistitle{No Title} -\def\settitle{\parsearg\settitlezzz} -\def\settitlezzz #1{\gdef\thistitle{#1}} - - -\message{tables,} - -% @tabs -- simple alignment - -% These don't work. For one thing, \+ is defined as outer. -% So these macros cannot even be defined. - -%\def\tabs{\parsearg\tabszzz} -%\def\tabszzz #1{\settabs\+#1\cr} -%\def\tabline{\parsearg\tablinezzz} -%\def\tablinezzz #1{\+#1\cr} -%\def\&{&} - -% Tables -- @table, @ftable, @vtable, @item(x), @kitem(x), @xitem(x). - -% default indentation of table text -\newdimen\tableindent \tableindent=.8in -% default indentation of @itemize and @enumerate text -\newdimen\itemindent \itemindent=.3in -% margin between end of table item and start of table text. -\newdimen\itemmargin \itemmargin=.1in - -% used internally for \itemindent minus \itemmargin -\newdimen\itemmax - -% Note @table, @vtable, and @vtable define @item, @itemx, etc., with -% these defs. -% They also define \itemindex -% to index the item name in whatever manner is desired (perhaps none). - -\newif\ifitemxneedsnegativevskip - -\def\itemxpar{\par\ifitemxneedsnegativevskip\nobreak\vskip-\parskip\nobreak\fi} - -\def\internalBitem{\smallbreak \parsearg\itemzzz} -\def\internalBitemx{\itemxpar \parsearg\itemzzz} - -\def\internalBxitem "#1"{\def\xitemsubtopix{#1} \smallbreak \parsearg\xitemzzz} -\def\internalBxitemx "#1"{\def\xitemsubtopix{#1} \itemxpar \parsearg\xitemzzz} - -\def\internalBkitem{\smallbreak \parsearg\kitemzzz} -\def\internalBkitemx{\itemxpar \parsearg\kitemzzz} - -\def\kitemzzz #1{\dosubind {kw}{\code{#1}}{for {\bf \lastfunction}}% - \itemzzz {#1}} - -\def\xitemzzz #1{\dosubind {kw}{\code{#1}}{for {\bf \xitemsubtopic}}% - \itemzzz {#1}} - -\def\itemzzz #1{\begingroup % - \advance\hsize by -\rightskip - \advance\hsize by -\tableindent - \setbox0=\hbox{\itemfont{#1}}% - \itemindex{#1}% - \nobreak % This prevents a break before @itemx. - % - % Be sure we are not still in the middle of a paragraph. - %{\parskip = 0in - %\par - %}% - % - % If the item text does not fit in the space we have, put it on a line - % by itself, and do not allow a page break either before or after that - % line. We do not start a paragraph here because then if the next - % command is, e.g., @kindex, the whatsit would get put into the - % horizontal list on a line by itself, resulting in extra blank space. - \ifdim \wd0>\itemmax - % - % Make this a paragraph so we get the \parskip glue and wrapping, - % but leave it ragged-right. - \begingroup - \advance\leftskip by-\tableindent - \advance\hsize by\tableindent - \advance\rightskip by0pt plus1fil - \leavevmode\unhbox0\par - \endgroup - % - % We're going to be starting a paragraph, but we don't want the - % \parskip glue -- logically it's part of the @item we just started. - \nobreak \vskip-\parskip - % - % Stop a page break at the \parskip glue coming up. Unfortunately - % we can't prevent a possible page break at the following - % \baselineskip glue. - \nobreak - \endgroup - \itemxneedsnegativevskipfalse - \else - % The item text fits into the space. Start a paragraph, so that the - % following text (if any) will end up on the same line. Since that - % text will be indented by \tableindent, we make the item text be in - % a zero-width box. - \noindent - \rlap{\hskip -\tableindent\box0}\ignorespaces% - \endgroup% - \itemxneedsnegativevskiptrue% - \fi -} - -\def\item{\errmessage{@item while not in a table}} -\def\itemx{\errmessage{@itemx while not in a table}} -\def\kitem{\errmessage{@kitem while not in a table}} -\def\kitemx{\errmessage{@kitemx while not in a table}} -\def\xitem{\errmessage{@xitem while not in a table}} -\def\xitemx{\errmessage{@xitemx while not in a table}} - -%% Contains a kludge to get @end[description] to work -\def\description{\tablez{\dontindex}{1}{}{}{}{}} - -\def\table{\begingroup\inENV\obeylines\obeyspaces\tablex} -{\obeylines\obeyspaces% -\gdef\tablex #1^^M{% -\tabley\dontindex#1 \endtabley}} - -\def\ftable{\begingroup\inENV\obeylines\obeyspaces\ftablex} -{\obeylines\obeyspaces% -\gdef\ftablex #1^^M{% -\tabley\fnitemindex#1 \endtabley -\def\Eftable{\endgraf\afterenvbreak\endgroup}% -\let\Etable=\relax}} - -\def\vtable{\begingroup\inENV\obeylines\obeyspaces\vtablex} -{\obeylines\obeyspaces% -\gdef\vtablex #1^^M{% -\tabley\vritemindex#1 \endtabley -\def\Evtable{\endgraf\afterenvbreak\endgroup}% -\let\Etable=\relax}} - -\def\dontindex #1{} -\def\fnitemindex #1{\doind {fn}{\code{#1}}}% -\def\vritemindex #1{\doind {vr}{\code{#1}}}% - -{\obeyspaces % -\gdef\tabley#1#2 #3 #4 #5 #6 #7\endtabley{\endgroup% -\tablez{#1}{#2}{#3}{#4}{#5}{#6}}} - -\def\tablez #1#2#3#4#5#6{% -\aboveenvbreak % -\begingroup % -\def\Edescription{\Etable}% Necessary kludge. -\let\itemindex=#1% -\ifnum 0#3>0 \advance \leftskip by #3\mil \fi % -\ifnum 0#4>0 \tableindent=#4\mil \fi % -\ifnum 0#5>0 \advance \rightskip by #5\mil \fi % -\def\itemfont{#2}% -\itemmax=\tableindent % -\advance \itemmax by -\itemmargin % -\advance \leftskip by \tableindent % -\exdentamount=\tableindent -\parindent = 0pt -\parskip = \smallskipamount -\ifdim \parskip=0pt \parskip=2pt \fi% -\def\Etable{\endgraf\afterenvbreak\endgroup}% -\let\item = \internalBitem % -\let\itemx = \internalBitemx % -\let\kitem = \internalBkitem % -\let\kitemx = \internalBkitemx % -\let\xitem = \internalBxitem % -\let\xitemx = \internalBxitemx % -} - -% This is the counter used by @enumerate, which is really @itemize - -\newcount \itemno - -\def\itemize{\parsearg\itemizezzz} - -\def\itemizezzz #1{% - \begingroup % ended by the @end itemsize - \itemizey {#1}{\Eitemize} -} - -\def\itemizey #1#2{% -\aboveenvbreak % -\itemmax=\itemindent % -\advance \itemmax by -\itemmargin % -\advance \leftskip by \itemindent % -\exdentamount=\itemindent -\parindent = 0pt % -\parskip = \smallskipamount % -\ifdim \parskip=0pt \parskip=2pt \fi% -\def#2{\endgraf\afterenvbreak\endgroup}% -\def\itemcontents{#1}% -\let\item=\itemizeitem} - -% Set sfcode to normal for the chars that usually have another value. -% These are `.?!:;,' -\def\frenchspacing{\sfcode46=1000 \sfcode63=1000 \sfcode33=1000 - \sfcode58=1000 \sfcode59=1000 \sfcode44=1000 } - -% \splitoff TOKENS\endmark defines \first to be the first token in -% TOKENS, and \rest to be the remainder. -% -\def\splitoff#1#2\endmark{\def\first{#1}\def\rest{#2}}% - -% Allow an optional argument of an uppercase letter, lowercase letter, -% or number, to specify the first label in the enumerated list. No -% argument is the same as `1'. -% -\def\enumerate{\parsearg\enumeratezzz} -\def\enumeratezzz #1{\enumeratey #1 \endenumeratey} -\def\enumeratey #1 #2\endenumeratey{% - \begingroup % ended by the @end enumerate - % - % If we were given no argument, pretend we were given `1'. - \def\thearg{#1}% - \ifx\thearg\empty \def\thearg{1}\fi - % - % Detect if the argument is a single token. If so, it might be a - % letter. Otherwise, the only valid thing it can be is a number. - % (We will always have one token, because of the test we just made. - % This is a good thing, since \splitoff doesn't work given nothing at - % all -- the first parameter is undelimited.) - \expandafter\splitoff\thearg\endmark - \ifx\rest\empty - % Only one token in the argument. It could still be anything. - % A ``lowercase letter'' is one whose \lccode is nonzero. - % An ``uppercase letter'' is one whose \lccode is both nonzero, and - % not equal to itself. - % Otherwise, we assume it's a number. - % - % We need the \relax at the end of the \ifnum lines to stop TeX from - % continuing to look for a <number>. - % - \ifnum\lccode\expandafter`\thearg=0\relax - \numericenumerate % a number (we hope) - \else - % It's a letter. - \ifnum\lccode\expandafter`\thearg=\expandafter`\thearg\relax - \lowercaseenumerate % lowercase letter - \else - \uppercaseenumerate % uppercase letter - \fi - \fi - \else - % Multiple tokens in the argument. We hope it's a number. - \numericenumerate - \fi -} - -% An @enumerate whose labels are integers. The starting integer is -% given in \thearg. -% -\def\numericenumerate{% - \itemno = \thearg - \startenumeration{\the\itemno}% -} - -% The starting (lowercase) letter is in \thearg. -\def\lowercaseenumerate{% - \itemno = \expandafter`\thearg - \startenumeration{% - % Be sure we're not beyond the end of the alphabet. - \ifnum\itemno=0 - \errmessage{No more lowercase letters in @enumerate; get a bigger - alphabet}% - \fi - \char\lccode\itemno - }% -} - -% The starting (uppercase) letter is in \thearg. -\def\uppercaseenumerate{% - \itemno = \expandafter`\thearg - \startenumeration{% - % Be sure we're not beyond the end of the alphabet. - \ifnum\itemno=0 - \errmessage{No more uppercase letters in @enumerate; get a bigger - alphabet} - \fi - \char\uccode\itemno - }% -} - -% Call itemizey, adding a period to the first argument and supplying the -% common last two arguments. Also subtract one from the initial value in -% \itemno, since @item increments \itemno. -% -\def\startenumeration#1{% - \advance\itemno by -1 - \itemizey{#1.}\Eenumerate\flushcr -} - -% @alphaenumerate and @capsenumerate are abbreviations for giving an arg -% to @enumerate. -% -\def\alphaenumerate{\enumerate{a}} -\def\capsenumerate{\enumerate{A}} -\def\Ealphaenumerate{\Eenumerate} -\def\Ecapsenumerate{\Eenumerate} - -% Definition of @item while inside @itemize. - -\def\itemizeitem{% -\advance\itemno by 1 -{\let\par=\endgraf \smallbreak}% -\ifhmode \errmessage{In hmode at itemizeitem}\fi -{\parskip=0in \hskip 0pt -\hbox to 0pt{\hss \itemcontents\hskip \itemmargin}% -\vadjust{\penalty 1200}}% -\flushcr} - -% @multitable macros -% Amy Hendrickson, 8/18/94, 3/6/96 -% -% @multitable ... @end multitable will make as many columns as desired. -% Contents of each column will wrap at width given in preamble. Width -% can be specified either with sample text given in a template line, -% or in percent of \hsize, the current width of text on page. - -% Table can continue over pages but will only break between lines. - -% To make preamble: -% -% Either define widths of columns in terms of percent of \hsize: -% @multitable @columnfractions .25 .3 .45 -% @item ... -% -% Numbers following @columnfractions are the percent of the total -% current hsize to be used for each column. You may use as many -% columns as desired. - - -% Or use a template: -% @multitable {Column 1 template} {Column 2 template} {Column 3 template} -% @item ... -% using the widest term desired in each column. -% -% For those who want to use more than one line's worth of words in -% the preamble, break the line within one argument and it -% will parse correctly, i.e., -% -% @multitable {Column 1 template} {Column 2 template} {Column 3 -% template} -% Not: -% @multitable {Column 1 template} {Column 2 template} -% {Column 3 template} - -% Each new table line starts with @item, each subsequent new column -% starts with @tab. Empty columns may be produced by supplying @tab's -% with nothing between them for as many times as empty columns are needed, -% ie, @tab@tab@tab will produce two empty columns. - -% @item, @tab, @multitable or @end multitable do not need to be on their -% own lines, but it will not hurt if they are. - -% Sample multitable: - -% @multitable {Column 1 template} {Column 2 template} {Column 3 template} -% @item first col stuff @tab second col stuff @tab third col -% @item -% first col stuff -% @tab -% second col stuff -% @tab -% third col -% @item first col stuff @tab second col stuff -% @tab Many paragraphs of text may be used in any column. -% -% They will wrap at the width determined by the template. -% @item@tab@tab This will be in third column. -% @end multitable - -% Default dimensions may be reset by user. -% @multitableparskip is vertical space between paragraphs in table. -% @multitableparindent is paragraph indent in table. -% @multitablecolmargin is horizontal space to be left between columns. -% @multitablelinespace is space to leave between table items, baseline -% to baseline. -% 0pt means it depends on current normal line spacing. -% -\newskip\multitableparskip -\newskip\multitableparindent -\newdimen\multitablecolspace -\newskip\multitablelinespace -\multitableparskip=0pt -\multitableparindent=6pt -\multitablecolspace=12pt -\multitablelinespace=0pt - -% Macros used to set up halign preamble: -% -\let\endsetuptable\relax -\def\xendsetuptable{\endsetuptable} -\let\columnfractions\relax -\def\xcolumnfractions{\columnfractions} -\newif\ifsetpercent - -% 2/1/96, to allow fractions to be given with more than one digit. -\def\pickupwholefraction#1 {\global\advance\colcount by1 % -\expandafter\xdef\csname col\the\colcount\endcsname{.#1\hsize}% -\setuptable} - -\newcount\colcount -\def\setuptable#1{\def\firstarg{#1}% -\ifx\firstarg\xendsetuptable\let\go\relax% -\else - \ifx\firstarg\xcolumnfractions\global\setpercenttrue% - \else - \ifsetpercent - \let\go\pickupwholefraction % In this case arg of setuptable - % is the decimal point before the - % number given in percent of hsize. - % We don't need this so we don't use it. - \else - \global\advance\colcount by1 - \setbox0=\hbox{#1 }% Add a normal word space as a separator; - % typically that is always in the input, anyway. - \expandafter\xdef\csname col\the\colcount\endcsname{\the\wd0}% - \fi% - \fi% -\ifx\go\pickupwholefraction\else\let\go\setuptable\fi% -\fi\go} - -% multitable syntax -\def\tab{&\hskip1sp\relax} % 2/2/96 - % tiny skip here makes sure this column space is - % maintained, even if it is never used. - -% @multitable ... @end multitable definitions: - -\def\multitable{\parsearg\dotable} -\def\dotable#1{\bgroup - \vskip\parskip - \let\item\crcr - \tolerance=9500 - \hbadness=9500 - \setmultitablespacing - \parskip=\multitableparskip - \parindent=\multitableparindent - \overfullrule=0pt - \global\colcount=0 - \def\Emultitable{\global\setpercentfalse\cr\egroup\egroup}% - % - % To parse everything between @multitable and @item: - \setuptable#1 \endsetuptable - % - % \everycr will reset column counter, \colcount, at the end of - % each line. Every column entry will cause \colcount to advance by one. - % The table preamble - % looks at the current \colcount to find the correct column width. - \everycr{\noalign{% - % - % \filbreak%% keeps underfull box messages off when table breaks over pages. - % Maybe so, but it also creates really weird page breaks when the table - % breaks over pages. Wouldn't \vfil be better? Wait until the problem - % manifests itself, so it can be fixed for real --karl. - \global\colcount=0\relax}}% - % - % This preamble sets up a generic column definition, which will - % be used as many times as user calls for columns. - % \vtop will set a single line and will also let text wrap and - % continue for many paragraphs if desired. - \halign\bgroup&\global\advance\colcount by 1\relax - \multistrut\vtop{\hsize=\expandafter\csname col\the\colcount\endcsname - % - % In order to keep entries from bumping into each other - % we will add a \leftskip of \multitablecolspace to all columns after - % the first one. - % - % If a template has been used, we will add \multitablecolspace - % to the width of each template entry. - % - % If the user has set preamble in terms of percent of \hsize we will - % use that dimension as the width of the column, and the \leftskip - % will keep entries from bumping into each other. Table will start at - % left margin and final column will justify at right margin. - % - % Make sure we don't inherit \rightskip from the outer environment. - \rightskip=0pt - \ifnum\colcount=1 - % The first column will be indented with the surrounding text. - \advance\hsize by\leftskip - \else - \ifsetpercent \else - % If user has not set preamble in terms of percent of \hsize - % we will advance \hsize by \multitablecolspace. - \advance\hsize by \multitablecolspace - \fi - % In either case we will make \leftskip=\multitablecolspace: - \leftskip=\multitablecolspace - \fi - % Ignoring space at the beginning and end avoids an occasional spurious - % blank line, when TeX decides to break the line at the space before the - % box from the multistrut, so the strut ends up on a line by itself. - % For example: - % @multitable @columnfractions .11 .89 - % @item @code{#} - % @tab Legal holiday which is valid in major parts of the whole country. - % Is automatically provided with highlighting sequences respectively marking - % characters. - \noindent\ignorespaces##\unskip\multistrut}\cr -} - -\def\setmultitablespacing{% test to see if user has set \multitablelinespace. -% If so, do nothing. If not, give it an appropriate dimension based on -% current baselineskip. -\ifdim\multitablelinespace=0pt -%% strut to put in table in case some entry doesn't have descenders, -%% to keep lines equally spaced -\let\multistrut = \strut -%% Test to see if parskip is larger than space between lines of -%% table. If not, do nothing. -%% If so, set to same dimension as multitablelinespace. -\else -\gdef\multistrut{\vrule height\multitablelinespace depth\dp0 -width0pt\relax} \fi -\ifdim\multitableparskip>\multitablelinespace -\global\multitableparskip=\multitablelinespace -\global\advance\multitableparskip-7pt %% to keep parskip somewhat smaller - %% than skip between lines in the table. -\fi% -\ifdim\multitableparskip=0pt -\global\multitableparskip=\multitablelinespace -\global\advance\multitableparskip-7pt %% to keep parskip somewhat smaller - %% than skip between lines in the table. -\fi} - - -\message{indexing,} -% Index generation facilities - -% Define \newwrite to be identical to plain tex's \newwrite -% except not \outer, so it can be used within \newindex. -{\catcode`\@=11 -\gdef\newwrite{\alloc@7\write\chardef\sixt@@n}} - -% \newindex {foo} defines an index named foo. -% It automatically defines \fooindex such that -% \fooindex ...rest of line... puts an entry in the index foo. -% It also defines \fooindfile to be the number of the output channel for -% the file that accumulates this index. The file's extension is foo. -% The name of an index should be no more than 2 characters long -% for the sake of vms. - -\def\newindex #1{ -\expandafter\newwrite \csname#1indfile\endcsname% Define number for output file -\openout \csname#1indfile\endcsname \jobname.#1 % Open the file -\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex -\noexpand\doindex {#1}} -} - -% @defindex foo == \newindex{foo} - -\def\defindex{\parsearg\newindex} - -% Define @defcodeindex, like @defindex except put all entries in @code. - -\def\newcodeindex #1{ -\expandafter\newwrite \csname#1indfile\endcsname% Define number for output file -\openout \csname#1indfile\endcsname \jobname.#1 % Open the file -\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex -\noexpand\docodeindex {#1}} -} - -\def\defcodeindex{\parsearg\newcodeindex} - -% @synindex foo bar makes index foo feed into index bar. -% Do this instead of @defindex foo if you don't want it as a separate index. -\def\synindex #1 #2 {% -\expandafter\let\expandafter\synindexfoo\expandafter=\csname#2indfile\endcsname -\expandafter\let\csname#1indfile\endcsname=\synindexfoo -\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex -\noexpand\doindex {#2}}% -} - -% @syncodeindex foo bar similar, but put all entries made for index foo -% inside @code. -\def\syncodeindex #1 #2 {% -\expandafter\let\expandafter\synindexfoo\expandafter=\csname#2indfile\endcsname -\expandafter\let\csname#1indfile\endcsname=\synindexfoo -\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex -\noexpand\docodeindex {#2}}% -} - -% Define \doindex, the driver for all \fooindex macros. -% Argument #1 is generated by the calling \fooindex macro, -% and it is "foo", the name of the index. - -% \doindex just uses \parsearg; it calls \doind for the actual work. -% This is because \doind is more useful to call from other macros. - -% There is also \dosubind {index}{topic}{subtopic} -% which makes an entry in a two-level index such as the operation index. - -\def\doindex#1{\edef\indexname{#1}\parsearg\singleindexer} -\def\singleindexer #1{\doind{\indexname}{#1}} - -% like the previous two, but they put @code around the argument. -\def\docodeindex#1{\edef\indexname{#1}\parsearg\singlecodeindexer} -\def\singlecodeindexer #1{\doind{\indexname}{\code{#1}}} - -\def\indexdummies{% -% Take care of the plain tex accent commands. -\def\"{\realbackslash "}% -\def\`{\realbackslash `}% -\def\'{\realbackslash '}% -\def\^{\realbackslash ^}% -\def\~{\realbackslash ~}% -\def\={\realbackslash =}% -\def\b{\realbackslash b}% -\def\c{\realbackslash c}% -\def\d{\realbackslash d}% -\def\u{\realbackslash u}% -\def\v{\realbackslash v}% -\def\H{\realbackslash H}% -% Take care of the plain tex special European modified letters. -\def\oe{\realbackslash oe}% -\def\ae{\realbackslash ae}% -\def\aa{\realbackslash aa}% -\def\OE{\realbackslash OE}% -\def\AE{\realbackslash AE}% -\def\AA{\realbackslash AA}% -\def\o{\realbackslash o}% -\def\O{\realbackslash O}% -\def\l{\realbackslash l}% -\def\L{\realbackslash L}% -\def\ss{\realbackslash ss}% -% Take care of texinfo commands likely to appear in an index entry. -% (Must be a way to avoid doing expansion at all, and thus not have to -% laboriously list every single command here.) -\def\@{@}% will be @@ when we switch to @ as escape char. -%\let\{ = \lbracecmd -%\let\} = \rbracecmd -\def\_{{\realbackslash _}}% -\def\w{\realbackslash w }% -\def\bf{\realbackslash bf }% -%\def\rm{\realbackslash rm }% -\def\sl{\realbackslash sl }% -\def\sf{\realbackslash sf}% -\def\tt{\realbackslash tt}% -\def\gtr{\realbackslash gtr}% -\def\less{\realbackslash less}% -\def\hat{\realbackslash hat}% -%\def\char{\realbackslash char}% -\def\TeX{\realbackslash TeX}% -\def\dots{\realbackslash dots }% -\def\result{\realbackslash result}% -\def\equiv{\realbackslash equiv}% -\def\expansion{\realbackslash expansion}% -\def\print{\realbackslash print}% -\def\error{\realbackslash error}% -\def\point{\realbackslash point}% -\def\copyright{\realbackslash copyright}% -\def\tclose##1{\realbackslash tclose {##1}}% -\def\code##1{\realbackslash code {##1}}% -\def\dotless##1{\realbackslash dotless {##1}}% -\def\samp##1{\realbackslash samp {##1}}% -\def\,##1{\realbackslash ,{##1}}% -\def\t##1{\realbackslash t {##1}}% -\def\r##1{\realbackslash r {##1}}% -\def\i##1{\realbackslash i {##1}}% -\def\b##1{\realbackslash b {##1}}% -\def\sc##1{\realbackslash sc {##1}}% -\def\cite##1{\realbackslash cite {##1}}% -\def\key##1{\realbackslash key {##1}}% -\def\file##1{\realbackslash file {##1}}% -\def\var##1{\realbackslash var {##1}}% -\def\kbd##1{\realbackslash kbd {##1}}% -\def\dfn##1{\realbackslash dfn {##1}}% -\def\emph##1{\realbackslash emph {##1}}% -\def\value##1{\realbackslash value {##1}}% -\unsepspaces -} - -% If an index command is used in an @example environment, any spaces -% therein should become regular spaces in the raw index file, not the -% expansion of \tie (\\leavevmode \penalty \@M \ ). -{\obeyspaces - \gdef\unsepspaces{\obeyspaces\let =\space}} - -% \indexnofonts no-ops all font-change commands. -% This is used when outputting the strings to sort the index by. -\def\indexdummyfont#1{#1} -\def\indexdummytex{TeX} -\def\indexdummydots{...} - -\def\indexnofonts{% -% Just ignore accents. -\let\,=\indexdummyfont -\let\"=\indexdummyfont -\let\`=\indexdummyfont -\let\'=\indexdummyfont -\let\^=\indexdummyfont -\let\~=\indexdummyfont -\let\==\indexdummyfont -\let\b=\indexdummyfont -\let\c=\indexdummyfont -\let\d=\indexdummyfont -\let\u=\indexdummyfont -\let\v=\indexdummyfont -\let\H=\indexdummyfont -\let\dotless=\indexdummyfont -% Take care of the plain tex special European modified letters. -\def\oe{oe}% -\def\ae{ae}% -\def\aa{aa}% -\def\OE{OE}% -\def\AE{AE}% -\def\AA{AA}% -\def\o{o}% -\def\O{O}% -\def\l{l}% -\def\L{L}% -\def\ss{ss}% -\let\w=\indexdummyfont -\let\t=\indexdummyfont -\let\r=\indexdummyfont -\let\i=\indexdummyfont -\let\b=\indexdummyfont -\let\emph=\indexdummyfont -\let\strong=\indexdummyfont -\let\cite=\indexdummyfont -\let\sc=\indexdummyfont -%Don't no-op \tt, since it isn't a user-level command -% and is used in the definitions of the active chars like <, >, |... -%\let\tt=\indexdummyfont -\let\tclose=\indexdummyfont -\let\code=\indexdummyfont -\let\file=\indexdummyfont -\let\samp=\indexdummyfont -\let\kbd=\indexdummyfont -\let\key=\indexdummyfont -\let\var=\indexdummyfont -\let\TeX=\indexdummytex -\let\dots=\indexdummydots -\def\@{@}% -} - -% To define \realbackslash, we must make \ not be an escape. -% We must first make another character (@) an escape -% so we do not become unable to do a definition. - -{\catcode`\@=0 \catcode`\\=\other -@gdef@realbackslash{\}} - -\let\indexbackslash=0 %overridden during \printindex. - -\let\SETmarginindex=\relax %initialize! -% workhorse for all \fooindexes -% #1 is name of index, #2 is stuff to put there -\def\doind #1#2{% - % Put the index entry in the margin if desired. - \ifx\SETmarginindex\relax\else - \insert\margin{\hbox{\vrule height8pt depth3pt width0pt #2}}% - \fi - {% - \count255=\lastpenalty - {% - \indexdummies % Must do this here, since \bf, etc expand at this stage - \escapechar=`\\ - {% - \let\folio=0% We will expand all macros now EXCEPT \folio. - \def\rawbackslashxx{\indexbackslash}% \indexbackslash isn't defined now - % so it will be output as is; and it will print as backslash. - % - % First process the index-string with all font commands turned off - % to get the string to sort by. - {\indexnofonts \xdef\indexsorttmp{#2}}% - % - % Now produce the complete index entry, with both the sort key and the - % original text, including any font commands. - \toks0 = {#2}% - \edef\temp{% - \write\csname#1indfile\endcsname{% - \realbackslash entry{\indexsorttmp}{\folio}{\the\toks0}}% - }% - \temp - }% - }% - \penalty\count255 - }% -} - -\def\dosubind #1#2#3{% -{\count10=\lastpenalty % -{\indexdummies % Must do this here, since \bf, etc expand at this stage -\escapechar=`\\% -{\let\folio=0% -\def\rawbackslashxx{\indexbackslash}% -% -% Now process the index-string once, with all font commands turned off, -% to get the string to sort the index by. -{\indexnofonts -\xdef\temp1{#2 #3}% -}% -% Now produce the complete index entry. We process the index-string again, -% this time with font commands expanded, to get what to print in the index. -\edef\temp{% -\write \csname#1indfile\endcsname{% -\realbackslash entry {\temp1}{\folio}{#2}{#3}}}% -\temp }% -}\penalty\count10}} - -% The index entry written in the file actually looks like -% \entry {sortstring}{page}{topic} -% or -% \entry {sortstring}{page}{topic}{subtopic} -% The texindex program reads in these files and writes files -% containing these kinds of lines: -% \initial {c} -% before the first topic whose initial is c -% \entry {topic}{pagelist} -% for a topic that is used without subtopics -% \primary {topic} -% for the beginning of a topic that is used with subtopics -% \secondary {subtopic}{pagelist} -% for each subtopic. - -% Define the user-accessible indexing commands -% @findex, @vindex, @kindex, @cindex. - -\def\findex {\fnindex} -\def\kindex {\kyindex} -\def\cindex {\cpindex} -\def\vindex {\vrindex} -\def\tindex {\tpindex} -\def\pindex {\pgindex} - -\def\cindexsub {\begingroup\obeylines\cindexsub} -{\obeylines % -\gdef\cindexsub "#1" #2^^M{\endgroup % -\dosubind{cp}{#2}{#1}}} - -% Define the macros used in formatting output of the sorted index material. - -% @printindex causes a particular index (the ??s file) to get printed. -% It does not print any chapter heading (usually an @unnumbered). -% -\def\printindex{\parsearg\doprintindex} -\def\doprintindex#1{\begingroup - \dobreak \chapheadingskip{10000}% - % - \indexfonts \rm - \tolerance = 9500 - \indexbreaks - % - % See if the index file exists and is nonempty. - % Change catcode of @ here so that if the index file contains - % \initial {@} - % as its first line, TeX doesn't complain about mismatched braces - % (because it thinks @} is a control sequence). - \catcode`\@ = 11 - \openin 1 \jobname.#1s - \ifeof 1 - % \enddoublecolumns gets confused if there is no text in the index, - % and it loses the chapter title and the aux file entries for the - % index. The easiest way to prevent this problem is to make sure - % there is some text. - (Index is nonexistent) - \else - % - % If the index file exists but is empty, then \openin leaves \ifeof - % false. We have to make TeX try to read something from the file, so - % it can discover if there is anything in it. - \read 1 to \temp - \ifeof 1 - (Index is empty) - \else - % Index files are almost Texinfo source, but we use \ as the escape - % character. It would be better to use @, but that's too big a change - % to make right now. - \def\indexbackslash{\rawbackslashxx}% - \catcode`\\ = 0 - \escapechar = `\\ - \begindoublecolumns - \input \jobname.#1s - \enddoublecolumns - \fi - \fi - \closein 1 -\endgroup} - -% These macros are used by the sorted index file itself. -% Change them to control the appearance of the index. - -% Same as \bigskipamount except no shrink. -% \balancecolumns gets confused if there is any shrink. -\newskip\initialskipamount \initialskipamount 12pt plus4pt - -\def\initial #1{% -{\let\tentt=\sectt \let\tt=\sectt \let\sf=\sectt -\ifdim\lastskip<\initialskipamount -\removelastskip \penalty-200 \vskip \initialskipamount\fi -\line{\secbf#1\hfill}\kern 2pt\penalty10000}} - -% This typesets a paragraph consisting of #1, dot leaders, and then #2 -% flush to the right margin. It is used for index and table of contents -% entries. The paragraph is indented by \leftskip. -% -\def\entry #1#2{\begingroup - % - % Start a new paragraph if necessary, so our assignments below can't - % affect previous text. - \par - % - % Do not fill out the last line with white space. - \parfillskip = 0in - % - % No extra space above this paragraph. - \parskip = 0in - % - % Do not prefer a separate line ending with a hyphen to fewer lines. - \finalhyphendemerits = 0 - % - % \hangindent is only relevant when the entry text and page number - % don't both fit on one line. In that case, bob suggests starting the - % dots pretty far over on the line. Unfortunately, a large - % indentation looks wrong when the entry text itself is broken across - % lines. So we use a small indentation and put up with long leaders. - % - % \hangafter is reset to 1 (which is the value we want) at the start - % of each paragraph, so we need not do anything with that. - \hangindent=2em - % - % When the entry text needs to be broken, just fill out the first line - % with blank space. - \rightskip = 0pt plus1fil - % - % Start a ``paragraph'' for the index entry so the line breaking - % parameters we've set above will have an effect. - \noindent - % - % Insert the text of the index entry. TeX will do line-breaking on it. - #1% - % The following is kludged to not output a line of dots in the index if - % there are no page numbers. The next person who breaks this will be - % cursed by a Unix daemon. - \def\tempa{{\rm }}% - \def\tempb{#2}% - \edef\tempc{\tempa}% - \edef\tempd{\tempb}% - \ifx\tempc\tempd\ \else% - % - % If we must, put the page number on a line of its own, and fill out - % this line with blank space. (The \hfil is overwhelmed with the - % fill leaders glue in \indexdotfill if the page number does fit.) - \hfil\penalty50 - \null\nobreak\indexdotfill % Have leaders before the page number. - % - % The `\ ' here is removed by the implicit \unskip that TeX does as - % part of (the primitive) \par. Without it, a spurious underfull - % \hbox ensues. - \ #2% The page number ends the paragraph. - \fi% - \par -\endgroup} - -% Like \dotfill except takes at least 1 em. -\def\indexdotfill{\cleaders - \hbox{$\mathsurround=0pt \mkern1.5mu ${\it .}$ \mkern1.5mu$}\hskip 1em plus 1fill} - -\def\primary #1{\line{#1\hfil}} - -\newskip\secondaryindent \secondaryindent=0.5cm - -\def\secondary #1#2{ -{\parfillskip=0in \parskip=0in -\hangindent =1in \hangafter=1 -\noindent\hskip\secondaryindent\hbox{#1}\indexdotfill #2\par -}} - -% Define two-column mode, which we use to typeset indexes. -% Adapted from the TeXbook, page 416, which is to say, -% the manmac.tex format used to print the TeXbook itself. -\catcode`\@=11 - -\newbox\partialpage -\newdimen\doublecolumnhsize - -\def\begindoublecolumns{\begingroup % ended by \enddoublecolumns - % Grab any single-column material above us. - \output = {\global\setbox\partialpage = \vbox{% - % - % Here is a possibility not foreseen in manmac: if we accumulate a - % whole lot of material, we might end up calling this \output - % routine twice in a row (see the doublecol-lose test, which is - % essentially a couple of indexes with @setchapternewpage off). In - % that case, we must prevent the second \partialpage from - % simply overwriting the first, causing us to lose the page. - % This will preserve it until a real output routine can ship it - % out. Generally, \partialpage will be empty when this runs and - % this will be a no-op. - \unvbox\partialpage - % - % Unvbox the main output page. - \unvbox255 - \kern-\topskip \kern\baselineskip - }}% - \eject - % - % Use the double-column output routine for subsequent pages. - \output = {\doublecolumnout}% - % - % Change the page size parameters. We could do this once outside this - % routine, in each of @smallbook, @afourpaper, and the default 8.5x11 - % format, but then we repeat the same computation. Repeating a couple - % of assignments once per index is clearly meaningless for the - % execution time, so we may as well do it in one place. - % - % First we halve the line length, less a little for the gutter between - % the columns. We compute the gutter based on the line length, so it - % changes automatically with the paper format. The magic constant - % below is chosen so that the gutter has the same value (well, +-<1pt) - % as it did when we hard-coded it. - % - % We put the result in a separate register, \doublecolumhsize, so we - % can restore it in \pagesofar, after \hsize itself has (potentially) - % been clobbered. - % - \doublecolumnhsize = \hsize - \advance\doublecolumnhsize by -.04154\hsize - \divide\doublecolumnhsize by 2 - \hsize = \doublecolumnhsize - % - % Double the \vsize as well. (We don't need a separate register here, - % since nobody clobbers \vsize.) - \vsize = 2\vsize -} -\def\doublecolumnout{% - \splittopskip=\topskip \splitmaxdepth=\maxdepth - % Get the available space for the double columns -- the normal - % (undoubled) page height minus any material left over from the - % previous page. - \dimen@=\pageheight \advance\dimen@ by-\ht\partialpage - % box0 will be the left-hand column, box2 the right. - \setbox0=\vsplit255 to\dimen@ \setbox2=\vsplit255 to\dimen@ - \onepageout\pagesofar - \unvbox255 - \penalty\outputpenalty -} -\def\pagesofar{% - % Re-output the contents of the output page -- any previous material, - % followed by the two boxes we just split. - \unvbox\partialpage - \hsize = \doublecolumnhsize - \wd0=\hsize \wd2=\hsize \hbox to\pagewidth{\box0\hfil\box2}% -} -\def\enddoublecolumns{% - \output = {\balancecolumns}\eject % split what we have - \endgroup % started in \begindoublecolumns - % - % Back to normal single-column typesetting, but take account of the - % fact that we just accumulated some stuff on the output page. - \pagegoal = \vsize -} -\def\balancecolumns{% - % Called at the end of the double column material. - \setbox0 = \vbox{\unvbox255}% - \dimen@ = \ht0 - \advance\dimen@ by \topskip - \advance\dimen@ by-\baselineskip - \divide\dimen@ by 2 - \splittopskip = \topskip - % Loop until we get a decent breakpoint. - {\vbadness=10000 \loop - \global\setbox3=\copy0 - \global\setbox1=\vsplit3 to\dimen@ - \ifdim\ht3>\dimen@ \global\advance\dimen@ by1pt - \repeat}% - \setbox0=\vbox to\dimen@{\unvbox1}% - \setbox2=\vbox to\dimen@{\unvbox3}% - \pagesofar -} -\catcode`\@ = \other - - -\message{sectioning,} -% Define chapters, sections, etc. - -\newcount\chapno -\newcount\secno \secno=0 -\newcount\subsecno \subsecno=0 -\newcount\subsubsecno \subsubsecno=0 - -% This counter is funny since it counts through charcodes of letters A, B, ... -\newcount\appendixno \appendixno = `\@ -\def\appendixletter{\char\the\appendixno} - -\newwrite\contentsfile -% This is called from \setfilename. -\def\opencontents{\openout\contentsfile = \jobname.toc } - -% Each @chapter defines this as the name of the chapter. -% page headings and footings can use it. @section does likewise - -\def\thischapter{} \def\thissection{} -\def\seccheck#1{\ifnum \pageno<0 - \errmessage{@#1 not allowed after generating table of contents}% -\fi} - -\def\chapternofonts{% - \let\rawbackslash=\relax - \let\frenchspacing=\relax - \def\result{\realbackslash result}% - \def\equiv{\realbackslash equiv}% - \def\expansion{\realbackslash expansion}% - \def\print{\realbackslash print}% - \def\TeX{\realbackslash TeX}% - \def\dots{\realbackslash dots}% - \def\result{\realbackslash result}% - \def\equiv{\realbackslash equiv}% - \def\expansion{\realbackslash expansion}% - \def\print{\realbackslash print}% - \def\error{\realbackslash error}% - \def\point{\realbackslash point}% - \def\copyright{\realbackslash copyright}% - \def\tt{\realbackslash tt}% - \def\bf{\realbackslash bf}% - \def\w{\realbackslash w}% - \def\less{\realbackslash less}% - \def\gtr{\realbackslash gtr}% - \def\hat{\realbackslash hat}% - \def\char{\realbackslash char}% - \def\tclose##1{\realbackslash tclose{##1}}% - \def\code##1{\realbackslash code{##1}}% - \def\samp##1{\realbackslash samp{##1}}% - \def\r##1{\realbackslash r{##1}}% - \def\b##1{\realbackslash b{##1}}% - \def\key##1{\realbackslash key{##1}}% - \def\file##1{\realbackslash file{##1}}% - \def\kbd##1{\realbackslash kbd{##1}}% - % These are redefined because @smartitalic wouldn't work inside xdef. - \def\i##1{\realbackslash i{##1}}% - \def\cite##1{\realbackslash cite{##1}}% - \def\var##1{\realbackslash var{##1}}% - \def\emph##1{\realbackslash emph{##1}}% - \def\dfn##1{\realbackslash dfn{##1}}% -} - -\newcount\absseclevel % used to calculate proper heading level -\newcount\secbase\secbase=0 % @raise/lowersections modify this count - -% @raisesections: treat @section as chapter, @subsection as section, etc. -\def\raisesections{\global\advance\secbase by -1} -\let\up=\raisesections % original BFox name - -% @lowersections: treat @chapter as section, @section as subsection, etc. -\def\lowersections{\global\advance\secbase by 1} -\let\down=\lowersections % original BFox name - -% Choose a numbered-heading macro -% #1 is heading level if unmodified by @raisesections or @lowersections -% #2 is text for heading -\def\numhead#1#2{\absseclevel=\secbase\advance\absseclevel by #1 -\ifcase\absseclevel - \chapterzzz{#2} -\or - \seczzz{#2} -\or - \numberedsubseczzz{#2} -\or - \numberedsubsubseczzz{#2} -\else - \ifnum \absseclevel<0 - \chapterzzz{#2} - \else - \numberedsubsubseczzz{#2} - \fi -\fi -} - -% like \numhead, but chooses appendix heading levels -\def\apphead#1#2{\absseclevel=\secbase\advance\absseclevel by #1 -\ifcase\absseclevel - \appendixzzz{#2} -\or - \appendixsectionzzz{#2} -\or - \appendixsubseczzz{#2} -\or - \appendixsubsubseczzz{#2} -\else - \ifnum \absseclevel<0 - \appendixzzz{#2} - \else - \appendixsubsubseczzz{#2} - \fi -\fi -} - -% like \numhead, but chooses numberless heading levels -\def\unnmhead#1#2{\absseclevel=\secbase\advance\absseclevel by #1 -\ifcase\absseclevel - \unnumberedzzz{#2} -\or - \unnumberedseczzz{#2} -\or - \unnumberedsubseczzz{#2} -\or - \unnumberedsubsubseczzz{#2} -\else - \ifnum \absseclevel<0 - \unnumberedzzz{#2} - \else - \unnumberedsubsubseczzz{#2} - \fi -\fi -} - - -\def\thischaptername{No Chapter Title} -\outer\def\chapter{\parsearg\chapteryyy} -\def\chapteryyy #1{\numhead0{#1}} % normally numhead0 calls chapterzzz -\def\chapterzzz #1{\seccheck{chapter}% -\secno=0 \subsecno=0 \subsubsecno=0 -\global\advance \chapno by 1 \message{\putwordChapter \the\chapno}% -\chapmacro {#1}{\the\chapno}% -\gdef\thissection{#1}% -\gdef\thischaptername{#1}% -% We don't substitute the actual chapter name into \thischapter -% because we don't want its macros evaluated now. -\xdef\thischapter{\putwordChapter{} \the\chapno: \noexpand\thischaptername}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash chapentry{\the\toks0}{\the\chapno}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\donoderef % -\global\let\section = \numberedsec -\global\let\subsection = \numberedsubsec -\global\let\subsubsection = \numberedsubsubsec -}} - -\outer\def\appendix{\parsearg\appendixyyy} -\def\appendixyyy #1{\apphead0{#1}} % normally apphead0 calls appendixzzz -\def\appendixzzz #1{\seccheck{appendix}% -\secno=0 \subsecno=0 \subsubsecno=0 -\global\advance \appendixno by 1 \message{Appendix \appendixletter}% -\chapmacro {#1}{\putwordAppendix{} \appendixletter}% -\gdef\thissection{#1}% -\gdef\thischaptername{#1}% -\xdef\thischapter{\putwordAppendix{} \appendixletter: \noexpand\thischaptername}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash chapentry{\the\toks0}% - {\putwordAppendix{} \appendixletter}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\appendixnoderef % -\global\let\section = \appendixsec -\global\let\subsection = \appendixsubsec -\global\let\subsubsection = \appendixsubsubsec -}} - -% @centerchap is like @unnumbered, but the heading is centered. -\outer\def\centerchap{\parsearg\centerchapyyy} -\def\centerchapyyy #1{{\let\unnumbchapmacro=\centerchapmacro \unnumberedyyy{#1}}} - -\outer\def\top{\parsearg\unnumberedyyy} -\outer\def\unnumbered{\parsearg\unnumberedyyy} -\def\unnumberedyyy #1{\unnmhead0{#1}} % normally unnmhead0 calls unnumberedzzz -\def\unnumberedzzz #1{\seccheck{unnumbered}% -\secno=0 \subsecno=0 \subsubsecno=0 -% -% This used to be simply \message{#1}, but TeX fully expands the -% argument to \message. Therefore, if #1 contained @-commands, TeX -% expanded them. For example, in `@unnumbered The @cite{Book}', TeX -% expanded @cite (which turns out to cause errors because \cite is meant -% to be executed, not expanded). -% -% Anyway, we don't want the fully-expanded definition of @cite to appear -% as a result of the \message, we just want `@cite' itself. We use -% \the<toks register> to achieve this: TeX expands \the<toks> only once, -% simply yielding the contents of the <toks register>. -\toks0 = {#1}\message{(\the\toks0)}% -% -\unnumbchapmacro {#1}% -\gdef\thischapter{#1}\gdef\thissection{#1}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash unnumbchapentry{\the\toks0}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\unnumbnoderef % -\global\let\section = \unnumberedsec -\global\let\subsection = \unnumberedsubsec -\global\let\subsubsection = \unnumberedsubsubsec -}} - -\outer\def\numberedsec{\parsearg\secyyy} -\def\secyyy #1{\numhead1{#1}} % normally calls seczzz -\def\seczzz #1{\seccheck{section}% -\subsecno=0 \subsubsecno=0 \global\advance \secno by 1 % -\gdef\thissection{#1}\secheading {#1}{\the\chapno}{\the\secno}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash secentry % -{\the\toks0}{\the\chapno}{\the\secno}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\donoderef % -\penalty 10000 % -}} - -\outer\def\appendixsection{\parsearg\appendixsecyyy} -\outer\def\appendixsec{\parsearg\appendixsecyyy} -\def\appendixsecyyy #1{\apphead1{#1}} % normally calls appendixsectionzzz -\def\appendixsectionzzz #1{\seccheck{appendixsection}% -\subsecno=0 \subsubsecno=0 \global\advance \secno by 1 % -\gdef\thissection{#1}\secheading {#1}{\appendixletter}{\the\secno}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash secentry % -{\the\toks0}{\appendixletter}{\the\secno}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\appendixnoderef % -\penalty 10000 % -}} - -\outer\def\unnumberedsec{\parsearg\unnumberedsecyyy} -\def\unnumberedsecyyy #1{\unnmhead1{#1}} % normally calls unnumberedseczzz -\def\unnumberedseczzz #1{\seccheck{unnumberedsec}% -\plainsecheading {#1}\gdef\thissection{#1}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash unnumbsecentry{\the\toks0}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\unnumbnoderef % -\penalty 10000 % -}} - -\outer\def\numberedsubsec{\parsearg\numberedsubsecyyy} -\def\numberedsubsecyyy #1{\numhead2{#1}} % normally calls numberedsubseczzz -\def\numberedsubseczzz #1{\seccheck{subsection}% -\gdef\thissection{#1}\subsubsecno=0 \global\advance \subsecno by 1 % -\subsecheading {#1}{\the\chapno}{\the\secno}{\the\subsecno}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash subsecentry % -{\the\toks0}{\the\chapno}{\the\secno}{\the\subsecno}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\donoderef % -\penalty 10000 % -}} - -\outer\def\appendixsubsec{\parsearg\appendixsubsecyyy} -\def\appendixsubsecyyy #1{\apphead2{#1}} % normally calls appendixsubseczzz -\def\appendixsubseczzz #1{\seccheck{appendixsubsec}% -\gdef\thissection{#1}\subsubsecno=0 \global\advance \subsecno by 1 % -\subsecheading {#1}{\appendixletter}{\the\secno}{\the\subsecno}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash subsecentry % -{\the\toks0}{\appendixletter}{\the\secno}{\the\subsecno}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\appendixnoderef % -\penalty 10000 % -}} - -\outer\def\unnumberedsubsec{\parsearg\unnumberedsubsecyyy} -\def\unnumberedsubsecyyy #1{\unnmhead2{#1}} %normally calls unnumberedsubseczzz -\def\unnumberedsubseczzz #1{\seccheck{unnumberedsubsec}% -\plainsubsecheading {#1}\gdef\thissection{#1}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash unnumbsubsecentry{\the\toks0}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\unnumbnoderef % -\penalty 10000 % -}} - -\outer\def\numberedsubsubsec{\parsearg\numberedsubsubsecyyy} -\def\numberedsubsubsecyyy #1{\numhead3{#1}} % normally numberedsubsubseczzz -\def\numberedsubsubseczzz #1{\seccheck{subsubsection}% -\gdef\thissection{#1}\global\advance \subsubsecno by 1 % -\subsubsecheading {#1} - {\the\chapno}{\the\secno}{\the\subsecno}{\the\subsubsecno}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash subsubsecentry{\the\toks0} - {\the\chapno}{\the\secno}{\the\subsecno}{\the\subsubsecno} - {\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\donoderef % -\penalty 10000 % -}} - -\outer\def\appendixsubsubsec{\parsearg\appendixsubsubsecyyy} -\def\appendixsubsubsecyyy #1{\apphead3{#1}} % normally appendixsubsubseczzz -\def\appendixsubsubseczzz #1{\seccheck{appendixsubsubsec}% -\gdef\thissection{#1}\global\advance \subsubsecno by 1 % -\subsubsecheading {#1} - {\appendixletter}{\the\secno}{\the\subsecno}{\the\subsubsecno}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash subsubsecentry{\the\toks0}% - {\appendixletter} - {\the\secno}{\the\subsecno}{\the\subsubsecno}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\appendixnoderef % -\penalty 10000 % -}} - -\outer\def\unnumberedsubsubsec{\parsearg\unnumberedsubsubsecyyy} -\def\unnumberedsubsubsecyyy #1{\unnmhead3{#1}} %normally unnumberedsubsubseczzz -\def\unnumberedsubsubseczzz #1{\seccheck{unnumberedsubsubsec}% -\plainsubsubsecheading {#1}\gdef\thissection{#1}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash unnumbsubsubsecentry{\the\toks0}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\unnumbnoderef % -\penalty 10000 % -}} - -% These are variants which are not "outer", so they can appear in @ifinfo. -% Actually, they should now be obsolete; ordinary section commands should work. -\def\infotop{\parsearg\unnumberedzzz} -\def\infounnumbered{\parsearg\unnumberedzzz} -\def\infounnumberedsec{\parsearg\unnumberedseczzz} -\def\infounnumberedsubsec{\parsearg\unnumberedsubseczzz} -\def\infounnumberedsubsubsec{\parsearg\unnumberedsubsubseczzz} - -\def\infoappendix{\parsearg\appendixzzz} -\def\infoappendixsec{\parsearg\appendixseczzz} -\def\infoappendixsubsec{\parsearg\appendixsubseczzz} -\def\infoappendixsubsubsec{\parsearg\appendixsubsubseczzz} - -\def\infochapter{\parsearg\chapterzzz} -\def\infosection{\parsearg\sectionzzz} -\def\infosubsection{\parsearg\subsectionzzz} -\def\infosubsubsection{\parsearg\subsubsectionzzz} - -% These macros control what the section commands do, according -% to what kind of chapter we are in (ordinary, appendix, or unnumbered). -% Define them by default for a numbered chapter. -\global\let\section = \numberedsec -\global\let\subsection = \numberedsubsec -\global\let\subsubsection = \numberedsubsubsec - -% Define @majorheading, @heading and @subheading - -% NOTE on use of \vbox for chapter headings, section headings, and -% such: -% 1) We use \vbox rather than the earlier \line to permit -% overlong headings to fold. -% 2) \hyphenpenalty is set to 10000 because hyphenation in a -% heading is obnoxious; this forbids it. -% 3) Likewise, headings look best if no \parindent is used, and -% if justification is not attempted. Hence \raggedright. - - -\def\majorheading{\parsearg\majorheadingzzz} -\def\majorheadingzzz #1{% -{\advance\chapheadingskip by 10pt \chapbreak }% -{\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000 - \parindent=0pt\raggedright - \rm #1\hfill}}\bigskip \par\penalty 200} - -\def\chapheading{\parsearg\chapheadingzzz} -\def\chapheadingzzz #1{\chapbreak % -{\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000 - \parindent=0pt\raggedright - \rm #1\hfill}}\bigskip \par\penalty 200} - -% @heading, @subheading, @subsubheading. -\def\heading{\parsearg\plainsecheading} -\def\subheading{\parsearg\plainsubsecheading} -\def\subsubheading{\parsearg\plainsubsubsecheading} - -% These macros generate a chapter, section, etc. heading only -% (including whitespace, linebreaking, etc. around it), -% given all the information in convenient, parsed form. - -%%% Args are the skip and penalty (usually negative) -\def\dobreak#1#2{\par\ifdim\lastskip<#1\removelastskip\penalty#2\vskip#1\fi} - -\def\setchapterstyle #1 {\csname CHAPF#1\endcsname} - -%%% Define plain chapter starts, and page on/off switching for it -% Parameter controlling skip before chapter headings (if needed) - -\newskip\chapheadingskip - -\def\chapbreak{\dobreak \chapheadingskip {-4000}} -\def\chappager{\par\vfill\supereject} -\def\chapoddpage{\chappager \ifodd\pageno \else \hbox to 0pt{} \chappager\fi} - -\def\setchapternewpage #1 {\csname CHAPPAG#1\endcsname} - -\def\CHAPPAGoff{ -\global\let\contentsalignmacro = \chappager -\global\let\pchapsepmacro=\chapbreak -\global\let\pagealignmacro=\chappager} - -\def\CHAPPAGon{ -\global\let\contentsalignmacro = \chappager -\global\let\pchapsepmacro=\chappager -\global\let\pagealignmacro=\chappager -\global\def\HEADINGSon{\HEADINGSsingle}} - -\def\CHAPPAGodd{ -\global\let\contentsalignmacro = \chapoddpage -\global\let\pchapsepmacro=\chapoddpage -\global\let\pagealignmacro=\chapoddpage -\global\def\HEADINGSon{\HEADINGSdouble}} - -\CHAPPAGon - -\def\CHAPFplain{ -\global\let\chapmacro=\chfplain -\global\let\unnumbchapmacro=\unnchfplain -\global\let\centerchapmacro=\centerchfplain} - -% Plain chapter opening. -% #1 is the text, #2 the chapter number or empty if unnumbered. -\def\chfplain#1#2{% - \pchapsepmacro - {% - \chapfonts \rm - \def\chapnum{#2}% - \setbox0 = \hbox{#2\ifx\chapnum\empty\else\enspace\fi}% - \vbox{\hyphenpenalty=10000 \tolerance=5000 \parindent=0pt \raggedright - \hangindent = \wd0 \centerparametersmaybe - \unhbox0 #1\par}% - }% - \nobreak\bigskip % no page break after a chapter title - \nobreak -} - -% Plain opening for unnumbered. -\def\unnchfplain#1{\chfplain{#1}{}} - -% @centerchap -- centered and unnumbered. -\let\centerparametersmaybe = \relax -\def\centerchfplain#1{{% - \def\centerparametersmaybe{% - \advance\rightskip by 3\rightskip - \leftskip = \rightskip - \parfillskip = 0pt - }% - \chfplain{#1}{}% -}} - -\CHAPFplain % The default - -\def\unnchfopen #1{% -\chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000 - \parindent=0pt\raggedright - \rm #1\hfill}}\bigskip \par\penalty 10000 % -} - -\def\chfopen #1#2{\chapoddpage {\chapfonts -\vbox to 3in{\vfil \hbox to\hsize{\hfil #2} \hbox to\hsize{\hfil #1} \vfil}}% -\par\penalty 5000 % -} - -\def\centerchfopen #1{% -\chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000 - \parindent=0pt - \hfill {\rm #1}\hfill}}\bigskip \par\penalty 10000 % -} - -\def\CHAPFopen{ -\global\let\chapmacro=\chfopen -\global\let\unnumbchapmacro=\unnchfopen -\global\let\centerchapmacro=\centerchfopen} - - -% Section titles. -\newskip\secheadingskip -\def\secheadingbreak{\dobreak \secheadingskip {-1000}} -\def\secheading#1#2#3{\sectionheading{sec}{#2.#3}{#1}} -\def\plainsecheading#1{\sectionheading{sec}{}{#1}} - -% Subsection titles. -\newskip \subsecheadingskip -\def\subsecheadingbreak{\dobreak \subsecheadingskip {-500}} -\def\subsecheading#1#2#3#4{\sectionheading{subsec}{#2.#3.#4}{#1}} -\def\plainsubsecheading#1{\sectionheading{subsec}{}{#1}} - -% Subsubsection titles. -\let\subsubsecheadingskip = \subsecheadingskip -\let\subsubsecheadingbreak = \subsecheadingbreak -\def\subsubsecheading#1#2#3#4#5{\sectionheading{subsubsec}{#2.#3.#4.#5}{#1}} -\def\plainsubsubsecheading#1{\sectionheading{subsubsec}{}{#1}} - - -% Print any size section title. -% -% #1 is the section type (sec/subsec/subsubsec), #2 is the section -% number (maybe empty), #3 the text. -\def\sectionheading#1#2#3{% - {% - \expandafter\advance\csname #1headingskip\endcsname by \parskip - \csname #1headingbreak\endcsname - }% - {% - % Switch to the right set of fonts. - \csname #1fonts\endcsname \rm - % - % Only insert the separating space if we have a section number. - \def\secnum{#2}% - \setbox0 = \hbox{#2\ifx\secnum\empty\else\enspace\fi}% - % - \vbox{\hyphenpenalty=10000 \tolerance=5000 \parindent=0pt \raggedright - \hangindent = \wd0 % zero if no section number - \unhbox0 #3}% - }% - \ifdim\parskip<10pt \nobreak\kern10pt\nobreak\kern-\parskip\fi \nobreak -} - - -\message{toc printing,} -% Finish up the main text and prepare to read what we've written -% to \contentsfile. - -\newskip\contentsrightmargin \contentsrightmargin=1in -\def\startcontents#1{% - % If @setchapternewpage on, and @headings double, the contents should - % start on an odd page, unlike chapters. Thus, we maintain - % \contentsalignmacro in parallel with \pagealignmacro. - % From: Torbjorn Granlund <tege@matematik.su.se> - \contentsalignmacro - \immediate\closeout \contentsfile - \ifnum \pageno>0 - \pageno = -1 % Request roman numbered pages. - \fi - % Don't need to put `Contents' or `Short Contents' in the headline. - % It is abundantly clear what they are. - \unnumbchapmacro{#1}\def\thischapter{}% - \begingroup % Set up to handle contents files properly. - \catcode`\\=0 \catcode`\{=1 \catcode`\}=2 \catcode`\@=11 - % We can't do this, because then an actual ^ in a section - % title fails, e.g., @chapter ^ -- exponentiation. --karl, 9jul97. - %\catcode`\^=7 % to see ^^e4 as \"a etc. juha@piuha.ydi.vtt.fi - \raggedbottom % Worry more about breakpoints than the bottom. - \advance\hsize by -\contentsrightmargin % Don't use the full line length. -} - - -% Normal (long) toc. -\outer\def\contents{% - \startcontents{\putwordTableofContents}% - \input \jobname.toc - \endgroup - \vfill \eject -} - -% And just the chapters. -\outer\def\summarycontents{% - \startcontents{\putwordShortContents}% - % - \let\chapentry = \shortchapentry - \let\unnumbchapentry = \shortunnumberedentry - % We want a true roman here for the page numbers. - \secfonts - \let\rm=\shortcontrm \let\bf=\shortcontbf \let\sl=\shortcontsl - \rm - \hyphenpenalty = 10000 - \advance\baselineskip by 1pt % Open it up a little. - \def\secentry ##1##2##3##4{} - \def\unnumbsecentry ##1##2{} - \def\subsecentry ##1##2##3##4##5{} - \def\unnumbsubsecentry ##1##2{} - \def\subsubsecentry ##1##2##3##4##5##6{} - \def\unnumbsubsubsecentry ##1##2{} - \input \jobname.toc - \endgroup - \vfill \eject -} -\let\shortcontents = \summarycontents - -% These macros generate individual entries in the table of contents. -% The first argument is the chapter or section name. -% The last argument is the page number. -% The arguments in between are the chapter number, section number, ... - -% Chapter-level things, for both the long and short contents. -\def\chapentry#1#2#3{\dochapentry{#2\labelspace#1}{#3}} - -% See comments in \dochapentry re vbox and related settings -\def\shortchapentry#1#2#3{% - \tocentry{\shortchaplabel{#2}\labelspace #1}{\doshortpageno{#3}}% -} - -% Typeset the label for a chapter or appendix for the short contents. -% The arg is, e.g. `Appendix A' for an appendix, or `3' for a chapter. -% We could simplify the code here by writing out an \appendixentry -% command in the toc file for appendices, instead of using \chapentry -% for both, but it doesn't seem worth it. -\setbox0 = \hbox{\shortcontrm \putwordAppendix } -\newdimen\shortappendixwidth \shortappendixwidth = \wd0 - -\def\shortchaplabel#1{% - % We typeset #1 in a box of constant width, regardless of the text of - % #1, so the chapter titles will come out aligned. - \setbox0 = \hbox{#1}% - \dimen0 = \ifdim\wd0 > \shortappendixwidth \shortappendixwidth \else 0pt \fi - % - % This space should be plenty, since a single number is .5em, and the - % widest letter (M) is 1em, at least in the Computer Modern fonts. - % (This space doesn't include the extra space that gets added after - % the label; that gets put in by \shortchapentry above.) - \advance\dimen0 by 1.1em - \hbox to \dimen0{#1\hfil}% -} - -\def\unnumbchapentry#1#2{\dochapentry{#1}{#2}} -\def\shortunnumberedentry#1#2{\tocentry{#1}{\doshortpageno{#2}}} - -% Sections. -\def\secentry#1#2#3#4{\dosecentry{#2.#3\labelspace#1}{#4}} -\def\unnumbsecentry#1#2{\dosecentry{#1}{#2}} - -% Subsections. -\def\subsecentry#1#2#3#4#5{\dosubsecentry{#2.#3.#4\labelspace#1}{#5}} -\def\unnumbsubsecentry#1#2{\dosubsecentry{#1}{#2}} - -% And subsubsections. -\def\subsubsecentry#1#2#3#4#5#6{% - \dosubsubsecentry{#2.#3.#4.#5\labelspace#1}{#6}} -\def\unnumbsubsubsecentry#1#2{\dosubsubsecentry{#1}{#2}} - -% This parameter controls the indentation of the various levels. -\newdimen\tocindent \tocindent = 3pc - -% Now for the actual typesetting. In all these, #1 is the text and #2 is the -% page number. -% -% If the toc has to be broken over pages, we want it to be at chapters -% if at all possible; hence the \penalty. -\def\dochapentry#1#2{% - \penalty-300 \vskip1\baselineskip plus.33\baselineskip minus.25\baselineskip - \begingroup - \chapentryfonts - \tocentry{#1}{\dopageno{#2}}% - \endgroup - \nobreak\vskip .25\baselineskip plus.1\baselineskip -} - -\def\dosecentry#1#2{\begingroup - \secentryfonts \leftskip=\tocindent - \tocentry{#1}{\dopageno{#2}}% -\endgroup} - -\def\dosubsecentry#1#2{\begingroup - \subsecentryfonts \leftskip=2\tocindent - \tocentry{#1}{\dopageno{#2}}% -\endgroup} - -\def\dosubsubsecentry#1#2{\begingroup - \subsubsecentryfonts \leftskip=3\tocindent - \tocentry{#1}{\dopageno{#2}}% -\endgroup} - -% Final typesetting of a toc entry; we use the same \entry macro as for -% the index entries, but we want to suppress hyphenation here. (We -% can't do that in the \entry macro, since index entries might consist -% of hyphenated-identifiers-that-do-not-fit-on-a-line-and-nothing-else.) -\def\tocentry#1#2{\begingroup - \vskip 0pt plus1pt % allow a little stretch for the sake of nice page breaks - % Do not use \turnoffactive in these arguments. Since the toc is - % typeset in cmr, so characters such as _ would come out wrong; we - % have to do the usual translation tricks. - \entry{#1}{#2}% -\endgroup} - -% Space between chapter (or whatever) number and the title. -\def\labelspace{\hskip1em \relax} - -\def\dopageno#1{{\rm #1}} -\def\doshortpageno#1{{\rm #1}} - -\def\chapentryfonts{\secfonts \rm} -\def\secentryfonts{\textfonts} -\let\subsecentryfonts = \textfonts -\let\subsubsecentryfonts = \textfonts - - -\message{environments,} - -% Since these characters are used in examples, it should be an even number of -% \tt widths. Each \tt character is 1en, so two makes it 1em. -% Furthermore, these definitions must come after we define our fonts. -\newbox\dblarrowbox \newbox\longdblarrowbox -\newbox\pushcharbox \newbox\bullbox -\newbox\equivbox \newbox\errorbox - -%{\tentt -%\global\setbox\dblarrowbox = \hbox to 1em{\hfil$\Rightarrow$\hfil} -%\global\setbox\longdblarrowbox = \hbox to 1em{\hfil$\mapsto$\hfil} -%\global\setbox\pushcharbox = \hbox to 1em{\hfil$\dashv$\hfil} -%\global\setbox\equivbox = \hbox to 1em{\hfil$\ptexequiv$\hfil} -% Adapted from the manmac format (p.420 of TeXbook) -%\global\setbox\bullbox = \hbox to 1em{\kern.15em\vrule height .75ex width .85ex -% depth .1ex\hfil} -%} - -% @point{}, @result{}, @expansion{}, @print{}, @equiv{}. -\def\point{$\star$} -\def\result{\leavevmode\raise.15ex\hbox to 1em{\hfil$\Rightarrow$\hfil}} -\def\expansion{\leavevmode\raise.1ex\hbox to 1em{\hfil$\mapsto$\hfil}} -\def\print{\leavevmode\lower.1ex\hbox to 1em{\hfil$\dashv$\hfil}} -\def\equiv{\leavevmode\lower.1ex\hbox to 1em{\hfil$\ptexequiv$\hfil}} - -% Adapted from the TeXbook's \boxit. -{\tentt \global\dimen0 = 3em}% Width of the box. -\dimen2 = .55pt % Thickness of rules -% The text. (`r' is open on the right, `e' somewhat less so on the left.) -\setbox0 = \hbox{\kern-.75pt \tensf error\kern-1.5pt} - -\global\setbox\errorbox=\hbox to \dimen0{\hfil - \hsize = \dimen0 \advance\hsize by -5.8pt % Space to left+right. - \advance\hsize by -2\dimen2 % Rules. - \vbox{ - \hrule height\dimen2 - \hbox{\vrule width\dimen2 \kern3pt % Space to left of text. - \vtop{\kern2.4pt \box0 \kern2.4pt}% Space above/below. - \kern3pt\vrule width\dimen2}% Space to right. - \hrule height\dimen2} - \hfil} - -% The @error{} command. -\def\error{\leavevmode\lower.7ex\copy\errorbox} - -% @tex ... @end tex escapes into raw Tex temporarily. -% One exception: @ is still an escape character, so that @end tex works. -% But \@ or @@ will get a plain tex @ character. - -\def\tex{\begingroup - \catcode `\\=0 \catcode `\{=1 \catcode `\}=2 - \catcode `\$=3 \catcode `\&=4 \catcode `\#=6 - \catcode `\^=7 \catcode `\_=8 \catcode `\~=13 \let~=\tie - \catcode `\%=14 - \catcode 43=12 % plus - \catcode`\"=12 - \catcode`\==12 - \catcode`\|=12 - \catcode`\<=12 - \catcode`\>=12 - \escapechar=`\\ - % - \let\b=\ptexb - \let\bullet=\ptexbullet - \let\c=\ptexc - \let\,=\ptexcomma - \let\.=\ptexdot - \let\dots=\ptexdots - \let\equiv=\ptexequiv - \let\!=\ptexexclam - \let\i=\ptexi - \let\{=\ptexlbrace - \let\}=\ptexrbrace - \let\*=\ptexstar - \let\t=\ptext - % - \def\endldots{\mathinner{\ldots\ldots\ldots\ldots}}% - \def\enddots{\relax\ifmmode\endldots\else$\mathsurround=0pt \endldots\,$\fi}% - \def\@{@}% -\let\Etex=\endgroup} - -% Define @lisp ... @endlisp. -% @lisp does a \begingroup so it can rebind things, -% including the definition of @endlisp (which normally is erroneous). - -% Amount to narrow the margins by for @lisp. -\newskip\lispnarrowing \lispnarrowing=0.4in - -% This is the definition that ^^M gets inside @lisp, @example, and other -% such environments. \null is better than a space, since it doesn't -% have any width. -\def\lisppar{\null\endgraf} - -% Make each space character in the input produce a normal interword -% space in the output. Don't allow a line break at this space, as this -% is used only in environments like @example, where each line of input -% should produce a line of output anyway. -% -{\obeyspaces % -\gdef\sepspaces{\obeyspaces\let =\tie}} - -% Define \obeyedspace to be our active space, whatever it is. This is -% for use in \parsearg. -{\sepspaces% -\global\let\obeyedspace= } - -% This space is always present above and below environments. -\newskip\envskipamount \envskipamount = 0pt - -% Make spacing and below environment symmetrical. We use \parskip here -% to help in doing that, since in @example-like environments \parskip -% is reset to zero; thus the \afterenvbreak inserts no space -- but the -% start of the next paragraph will insert \parskip -% -\def\aboveenvbreak{{\advance\envskipamount by \parskip -\endgraf \ifdim\lastskip<\envskipamount -\removelastskip \penalty-50 \vskip\envskipamount \fi}} - -\let\afterenvbreak = \aboveenvbreak - -% \nonarrowing is a flag. If "set", @lisp etc don't narrow margins. -\let\nonarrowing=\relax - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% \cartouche: draw rectangle w/rounded corners around argument -\font\circle=lcircle10 -\newdimen\circthick -\newdimen\cartouter\newdimen\cartinner -\newskip\normbskip\newskip\normpskip\newskip\normlskip -\circthick=\fontdimen8\circle -% -\def\ctl{{\circle\char'013\hskip -6pt}}% 6pt from pl file: 1/2charwidth -\def\ctr{{\hskip 6pt\circle\char'010}} -\def\cbl{{\circle\char'012\hskip -6pt}} -\def\cbr{{\hskip 6pt\circle\char'011}} -\def\carttop{\hbox to \cartouter{\hskip\lskip - \ctl\leaders\hrule height\circthick\hfil\ctr - \hskip\rskip}} -\def\cartbot{\hbox to \cartouter{\hskip\lskip - \cbl\leaders\hrule height\circthick\hfil\cbr - \hskip\rskip}} -% -\newskip\lskip\newskip\rskip - -\long\def\cartouche{% -\begingroup - \lskip=\leftskip \rskip=\rightskip - \leftskip=0pt\rightskip=0pt %we want these *outside*. - \cartinner=\hsize \advance\cartinner by-\lskip - \advance\cartinner by-\rskip - \cartouter=\hsize - \advance\cartouter by 18pt % allow for 3pt kerns on either -% side, and for 6pt waste from -% each corner char - \normbskip=\baselineskip \normpskip=\parskip \normlskip=\lineskip - % Flag to tell @lisp, etc., not to narrow margin. - \let\nonarrowing=\comment - \vbox\bgroup - \baselineskip=0pt\parskip=0pt\lineskip=0pt - \carttop - \hbox\bgroup - \hskip\lskip - \vrule\kern3pt - \vbox\bgroup - \hsize=\cartinner - \kern3pt - \begingroup - \baselineskip=\normbskip - \lineskip=\normlskip - \parskip=\normpskip - \vskip -\parskip -\def\Ecartouche{% - \endgroup - \kern3pt - \egroup - \kern3pt\vrule - \hskip\rskip - \egroup - \cartbot - \egroup -\endgroup -}} - - -% This macro is called at the beginning of all the @example variants, -% inside a group. -\def\nonfillstart{% - \aboveenvbreak - \inENV % This group ends at the end of the body - \hfuzz = 12pt % Don't be fussy - \sepspaces % Make spaces be word-separators rather than space tokens. - \singlespace - \let\par = \lisppar % don't ignore blank lines - \obeylines % each line of input is a line of output - \parskip = 0pt - \parindent = 0pt - \emergencystretch = 0pt % don't try to avoid overfull boxes - % @cartouche defines \nonarrowing to inhibit narrowing - % at next level down. - \ifx\nonarrowing\relax - \advance \leftskip by \lispnarrowing - \exdentamount=\lispnarrowing - \let\exdent=\nofillexdent - \let\nonarrowing=\relax - \fi -} - -% To ending an @example-like environment, we first end the paragraph -% (via \afterenvbreak's vertical glue), and then the group. That way we -% keep the zero \parskip that the environments set -- \parskip glue -% will be inserted at the beginning of the next paragraph in the -% document, after the environment. -% -\def\nonfillfinish{\afterenvbreak\endgroup}% - -\def\lisp{\begingroup - \nonfillstart - \let\Elisp = \nonfillfinish - \tt - % Make @kbd do something special, if requested. - \let\kbdfont\kbdexamplefont - \rawbackslash % have \ input char produce \ char from current font - \gobble -} - -% Define the \E... control sequence only if we are inside the -% environment, so the error checking in \end will work. -% -% We must call \lisp last in the definition, since it reads the -% return following the @example (or whatever) command. -% -\def\example{\begingroup \def\Eexample{\nonfillfinish\endgroup}\lisp} -\def\smallexample{\begingroup \def\Esmallexample{\nonfillfinish\endgroup}\lisp} -\def\smalllisp{\begingroup \def\Esmalllisp{\nonfillfinish\endgroup}\lisp} - -% @smallexample and @smalllisp. This is not used unless the @smallbook -% command is given. Originally contributed by Pavel@xerox. -% -\def\smalllispx{\begingroup - \nonfillstart - \let\Esmalllisp = \nonfillfinish - \let\Esmallexample = \nonfillfinish - % - % Smaller fonts for small examples. - \indexfonts \tt - \rawbackslash % make \ output the \ character from the current font (tt) - \gobble -} - -% This is @display; same as @lisp except use roman font. -% -\def\display{\begingroup - \nonfillstart - \let\Edisplay = \nonfillfinish - \gobble -} - -% This is @format; same as @display except don't narrow margins. -% -\def\format{\begingroup - \let\nonarrowing = t - \nonfillstart - \let\Eformat = \nonfillfinish - \gobble -} - -% @flushleft (same as @format) and @flushright. -% -\def\flushleft{\begingroup - \let\nonarrowing = t - \nonfillstart - \let\Eflushleft = \nonfillfinish - \gobble -} -\def\flushright{\begingroup - \let\nonarrowing = t - \nonfillstart - \let\Eflushright = \nonfillfinish - \advance\leftskip by 0pt plus 1fill - \gobble} - -% @quotation does normal linebreaking (hence we can't use \nonfillstart) -% and narrows the margins. -% -\def\quotation{% - \begingroup\inENV %This group ends at the end of the @quotation body - {\parskip=0pt \aboveenvbreak}% because \aboveenvbreak inserts \parskip - \singlespace - \parindent=0pt - % We have retained a nonzero parskip for the environment, since we're - % doing normal filling. So to avoid extra space below the environment... - \def\Equotation{\parskip = 0pt \nonfillfinish}% - % - % @cartouche defines \nonarrowing to inhibit narrowing at next level down. - \ifx\nonarrowing\relax - \advance\leftskip by \lispnarrowing - \advance\rightskip by \lispnarrowing - \exdentamount = \lispnarrowing - \let\nonarrowing = \relax - \fi -} - -\message{defuns,} -% Define formatter for defuns -% First, allow user to change definition object font (\df) internally -\def\setdeffont #1 {\csname DEF#1\endcsname} - -\newskip\defbodyindent \defbodyindent=.4in -\newskip\defargsindent \defargsindent=50pt -\newskip\deftypemargin \deftypemargin=12pt -\newskip\deflastargmargin \deflastargmargin=18pt - -\newcount\parencount -% define \functionparens, which makes ( and ) and & do special things. -% \functionparens affects the group it is contained in. -\def\activeparens{% -\catcode`\(=\active \catcode`\)=\active \catcode`\&=\active -\catcode`\[=\active \catcode`\]=\active} - -% Make control sequences which act like normal parenthesis chars. -\let\lparen = ( \let\rparen = ) - -{\activeparens % Now, smart parens don't turn on until &foo (see \amprm) - -% Be sure that we always have a definition for `(', etc. For example, -% if the fn name has parens in it, \boldbrax will not be in effect yet, -% so TeX would otherwise complain about undefined control sequence. -\global\let(=\lparen \global\let)=\rparen -\global\let[=\lbrack \global\let]=\rbrack - -\gdef\functionparens{\boldbrax\let&=\amprm\parencount=0 } -\gdef\boldbrax{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb} -% This is used to turn on special parens -% but make & act ordinary (given that it's active). -\gdef\boldbraxnoamp{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb\let&=\ampnr} - -% Definitions of (, ) and & used in args for functions. -% This is the definition of ( outside of all parentheses. -\gdef\oprm#1 {{\rm\char`\(}#1 \bf \let(=\opnested - \global\advance\parencount by 1 -} -% -% This is the definition of ( when already inside a level of parens. -\gdef\opnested{\char`\(\global\advance\parencount by 1 } -% -\gdef\clrm{% Print a paren in roman if it is taking us back to depth of 0. - % also in that case restore the outer-level definition of (. - \ifnum \parencount=1 {\rm \char `\)}\sl \let(=\oprm \else \char `\) \fi - \global\advance \parencount by -1 } -% If we encounter &foo, then turn on ()-hacking afterwards -\gdef\amprm#1 {{\rm\}\let(=\oprm \let)=\clrm\ } -% -\gdef\normalparens{\boldbrax\let&=\ampnr} -} % End of definition inside \activeparens -%% These parens (in \boldbrax) actually are a little bolder than the -%% contained text. This is especially needed for [ and ] -\def\opnr{{\sf\char`\(}\global\advance\parencount by 1 } -\def\clnr{{\sf\char`\)}\global\advance\parencount by -1 } -\def\ampnr{\&} -\def\lbrb{{\bf\char`\[}} -\def\rbrb{{\bf\char`\]}} - -% First, defname, which formats the header line itself. -% #1 should be the function name. -% #2 should be the type of definition, such as "Function". - -\def\defname #1#2{% -% Get the values of \leftskip and \rightskip as they were -% outside the @def... -\dimen2=\leftskip -\advance\dimen2 by -\defbodyindent -\dimen3=\rightskip -\advance\dimen3 by -\defbodyindent -\noindent % -\setbox0=\hbox{\hskip \deflastargmargin{\rm #2}\hskip \deftypemargin}% -\dimen0=\hsize \advance \dimen0 by -\wd0 % compute size for first line -\dimen1=\hsize \advance \dimen1 by -\defargsindent %size for continuations -\parshape 2 0in \dimen0 \defargsindent \dimen1 % -% Now output arg 2 ("Function" or some such) -% ending at \deftypemargin from the right margin, -% but stuck inside a box of width 0 so it does not interfere with linebreaking -{% Adjust \hsize to exclude the ambient margins, -% so that \rightline will obey them. -\advance \hsize by -\dimen2 \advance \hsize by -\dimen3 -\rlap{\rightline{{\rm #2}\hskip \deftypemargin}}}% -% Make all lines underfull and no complaints: -\tolerance=10000 \hbadness=10000 -\advance\leftskip by -\defbodyindent -\exdentamount=\defbodyindent -{\df #1}\enskip % Generate function name -} - -% Actually process the body of a definition -% #1 should be the terminating control sequence, such as \Edefun. -% #2 should be the "another name" control sequence, such as \defunx. -% #3 should be the control sequence that actually processes the header, -% such as \defunheader. - -\def\defparsebody #1#2#3{\begingroup\inENV% Environment for definitionbody -\medbreak % -% Define the end token that this defining construct specifies -% so that it will exit this group. -\def#1{\endgraf\endgroup\medbreak}% -\def#2{\begingroup\obeylines\activeparens\spacesplit#3}% -\parindent=0in -\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent -\exdentamount=\defbodyindent -\begingroup % -\catcode 61=\active % 61 is `=' -\obeylines\activeparens\spacesplit#3} - -\def\defmethparsebody #1#2#3#4 {\begingroup\inENV % -\medbreak % -% Define the end token that this defining construct specifies -% so that it will exit this group. -\def#1{\endgraf\endgroup\medbreak}% -\def#2##1 {\begingroup\obeylines\activeparens\spacesplit{#3{##1}}}% -\parindent=0in -\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent -\exdentamount=\defbodyindent -\begingroup\obeylines\activeparens\spacesplit{#3{#4}}} - -\def\defopparsebody #1#2#3#4#5 {\begingroup\inENV % -\medbreak % -% Define the end token that this defining construct specifies -% so that it will exit this group. -\def#1{\endgraf\endgroup\medbreak}% -\def#2##1 ##2 {\def#4{##1}% -\begingroup\obeylines\activeparens\spacesplit{#3{##2}}}% -\parindent=0in -\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent -\exdentamount=\defbodyindent -\begingroup\obeylines\activeparens\spacesplit{#3{#5}}} - -% These parsing functions are similar to the preceding ones -% except that they do not make parens into active characters. -% These are used for "variables" since they have no arguments. - -\def\defvarparsebody #1#2#3{\begingroup\inENV% Environment for definitionbody -\medbreak % -% Define the end token that this defining construct specifies -% so that it will exit this group. -\def#1{\endgraf\endgroup\medbreak}% -\def#2{\begingroup\obeylines\spacesplit#3}% -\parindent=0in -\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent -\exdentamount=\defbodyindent -\begingroup % -\catcode 61=\active % -\obeylines\spacesplit#3} - -% This is used for \def{tp,vr}parsebody. It could probably be used for -% some of the others, too, with some judicious conditionals. -% -\def\parsebodycommon#1#2#3{% - \begingroup\inENV % - \medbreak % - % Define the end token that this defining construct specifies - % so that it will exit this group. - \def#1{\endgraf\endgroup\medbreak}% - \def#2##1 {\begingroup\obeylines\spacesplit{#3{##1}}}% - \parindent=0in - \advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent - \exdentamount=\defbodyindent - \begingroup\obeylines -} - -\def\defvrparsebody#1#2#3#4 {% - \parsebodycommon{#1}{#2}{#3}% - \spacesplit{#3{#4}}% -} - -% This loses on `@deftp {Data Type} {struct termios}' -- it thinks the -% type is just `struct', because we lose the braces in `{struct -% termios}' when \spacesplit reads its undelimited argument. Sigh. -% \let\deftpparsebody=\defvrparsebody -% -% So, to get around this, we put \empty in with the type name. That -% way, TeX won't find exactly `{...}' as an undelimited argument, and -% won't strip off the braces. -% -\def\deftpparsebody #1#2#3#4 {% - \parsebodycommon{#1}{#2}{#3}% - \spacesplit{\parsetpheaderline{#3{#4}}}\empty -} - -% Fine, but then we have to eventually remove the \empty *and* the -% braces (if any). That's what this does. -% -\def\removeemptybraces\empty#1\relax{#1} - -% After \spacesplit has done its work, this is called -- #1 is the final -% thing to call, #2 the type name (which starts with \empty), and #3 -% (which might be empty) the arguments. -% -\def\parsetpheaderline#1#2#3{% - #1{\removeemptybraces#2\relax}{#3}% -}% - -\def\defopvarparsebody #1#2#3#4#5 {\begingroup\inENV % -\medbreak % -% Define the end token that this defining construct specifies -% so that it will exit this group. -\def#1{\endgraf\endgroup\medbreak}% -\def#2##1 ##2 {\def#4{##1}% -\begingroup\obeylines\spacesplit{#3{##2}}}% -\parindent=0in -\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent -\exdentamount=\defbodyindent -\begingroup\obeylines\spacesplit{#3{#5}}} - -% Split up #2 at the first space token. -% call #1 with two arguments: -% the first is all of #2 before the space token, -% the second is all of #2 after that space token. -% If #2 contains no space token, all of it is passed as the first arg -% and the second is passed as empty. - -{\obeylines -\gdef\spacesplit#1#2^^M{\endgroup\spacesplitfoo{#1}#2 \relax\spacesplitfoo}% -\long\gdef\spacesplitfoo#1#2 #3#4\spacesplitfoo{% -\ifx\relax #3% -#1{#2}{}\else #1{#2}{#3#4}\fi}} - -% So much for the things common to all kinds of definitions. - -% Define @defun. - -% First, define the processing that is wanted for arguments of \defun -% Use this to expand the args and terminate the paragraph they make up - -\def\defunargs #1{\functionparens \sl -% Expand, preventing hyphenation at `-' chars. -% Note that groups don't affect changes in \hyphenchar. -\hyphenchar\tensl=0 -#1% -\hyphenchar\tensl=45 -\ifnum\parencount=0 \else \errmessage{Unbalanced parentheses in @def}\fi% -\interlinepenalty=10000 -\advance\rightskip by 0pt plus 1fil -\endgraf\penalty 10000\vskip -\parskip\penalty 10000% -} - -\def\deftypefunargs #1{% -% Expand, preventing hyphenation at `-' chars. -% Note that groups don't affect changes in \hyphenchar. -% Use \boldbraxnoamp, not \functionparens, so that & is not special. -\boldbraxnoamp -\tclose{#1}% avoid \code because of side effects on active chars -\interlinepenalty=10000 -\advance\rightskip by 0pt plus 1fil -\endgraf\penalty 10000\vskip -\parskip\penalty 10000% -} - -% Do complete processing of one @defun or @defunx line already parsed. - -% @deffn Command forward-char nchars - -\def\deffn{\defmethparsebody\Edeffn\deffnx\deffnheader} - -\def\deffnheader #1#2#3{\doind {fn}{\code{#2}}% -\begingroup\defname {#2}{#1}\defunargs{#3}\endgroup % -\catcode 61=\other % Turn off change made in \defparsebody -} - -% @defun == @deffn Function - -\def\defun{\defparsebody\Edefun\defunx\defunheader} - -\def\defunheader #1#2{\doind {fn}{\code{#1}}% Make entry in function index -\begingroup\defname {#1}{Function}% -\defunargs {#2}\endgroup % -\catcode 61=\other % Turn off change made in \defparsebody -} - -% @deftypefun int foobar (int @var{foo}, float @var{bar}) - -\def\deftypefun{\defparsebody\Edeftypefun\deftypefunx\deftypefunheader} - -% #1 is the data type. #2 is the name and args. -\def\deftypefunheader #1#2{\deftypefunheaderx{#1}#2 \relax} -% #1 is the data type, #2 the name, #3 the args. -\def\deftypefunheaderx #1#2 #3\relax{% -\doind {fn}{\code{#2}}% Make entry in function index -\begingroup\defname {\defheaderxcond#1\relax$$$#2}{Function}% -\deftypefunargs {#3}\endgroup % -\catcode 61=\other % Turn off change made in \defparsebody -} - -% @deftypefn {Library Function} int foobar (int @var{foo}, float @var{bar}) - -\def\deftypefn{\defmethparsebody\Edeftypefn\deftypefnx\deftypefnheader} - -% \defheaderxcond#1\relax$$$ -% puts #1 in @code, followed by a space, but does nothing if #1 is null. -\def\defheaderxcond#1#2$$${\ifx#1\relax\else\code{#1#2} \fi} - -% #1 is the classification. #2 is the data type. #3 is the name and args. -\def\deftypefnheader #1#2#3{\deftypefnheaderx{#1}{#2}#3 \relax} -% #1 is the classification, #2 the data type, #3 the name, #4 the args. -\def\deftypefnheaderx #1#2#3 #4\relax{% -\doind {fn}{\code{#3}}% Make entry in function index -\begingroup -\normalparens % notably, turn off `&' magic, which prevents -% at least some C++ text from working -\defname {\defheaderxcond#2\relax$$$#3}{#1}% -\deftypefunargs {#4}\endgroup % -\catcode 61=\other % Turn off change made in \defparsebody -} - -% @defmac == @deffn Macro - -\def\defmac{\defparsebody\Edefmac\defmacx\defmacheader} - -\def\defmacheader #1#2{\doind {fn}{\code{#1}}% Make entry in function index -\begingroup\defname {#1}{Macro}% -\defunargs {#2}\endgroup % -\catcode 61=\other % Turn off change made in \defparsebody -} - -% @defspec == @deffn Special Form - -\def\defspec{\defparsebody\Edefspec\defspecx\defspecheader} - -\def\defspecheader #1#2{\doind {fn}{\code{#1}}% Make entry in function index -\begingroup\defname {#1}{Special Form}% -\defunargs {#2}\endgroup % -\catcode 61=\other % Turn off change made in \defparsebody -} - -% This definition is run if you use @defunx -% anywhere other than immediately after a @defun or @defunx. - -\def\deffnx #1 {\errmessage{@deffnx in invalid context}} -\def\defunx #1 {\errmessage{@defunx in invalid context}} -\def\defmacx #1 {\errmessage{@defmacx in invalid context}} -\def\defspecx #1 {\errmessage{@defspecx in invalid context}} -\def\deftypefnx #1 {\errmessage{@deftypefnx in invalid context}} -\def\deftypemethodx #1 {\errmessage{@deftypemethodx in invalid context}} -\def\deftypeunx #1 {\errmessage{@deftypeunx in invalid context}} - -% @defmethod, and so on - -% @defop {Funny Method} foo-class frobnicate argument - -\def\defop #1 {\def\defoptype{#1}% -\defopparsebody\Edefop\defopx\defopheader\defoptype} - -\def\defopheader #1#2#3{% -\dosubind {fn}{\code{#2}}{on #1}% Make entry in function index -\begingroup\defname {#2}{\defoptype{} on #1}% -\defunargs {#3}\endgroup % -} - -% @deftypemethod foo-class return-type foo-method args -% -\def\deftypemethod{% - \defmethparsebody\Edeftypemethod\deftypemethodx\deftypemethodheader} -% -% #1 is the class name, #2 the data type, #3 the method name, #4 the args. -\def\deftypemethodheader#1#2#3#4{% - \deftypefnheaderx{Method on #1}{#2}#3 #4\relax -} - -% @defmethod == @defop Method - -\def\defmethod{\defmethparsebody\Edefmethod\defmethodx\defmethodheader} - -\def\defmethodheader #1#2#3{% -\dosubind {fn}{\code{#2}}{on #1}% entry in function index -\begingroup\defname {#2}{Method on #1}% -\defunargs {#3}\endgroup % -} - -% @defcv {Class Option} foo-class foo-flag - -\def\defcv #1 {\def\defcvtype{#1}% -\defopvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype} - -\def\defcvarheader #1#2#3{% -\dosubind {vr}{\code{#2}}{of #1}% Make entry in var index -\begingroup\defname {#2}{\defcvtype{} of #1}% -\defvarargs {#3}\endgroup % -} - -% @defivar == @defcv {Instance Variable} - -\def\defivar{\defvrparsebody\Edefivar\defivarx\defivarheader} - -\def\defivarheader #1#2#3{% -\dosubind {vr}{\code{#2}}{of #1}% Make entry in var index -\begingroup\defname {#2}{Instance Variable of #1}% -\defvarargs {#3}\endgroup % -} - -% These definitions are run if you use @defmethodx, etc., -% anywhere other than immediately after a @defmethod, etc. - -\def\defopx #1 {\errmessage{@defopx in invalid context}} -\def\defmethodx #1 {\errmessage{@defmethodx in invalid context}} -\def\defcvx #1 {\errmessage{@defcvx in invalid context}} -\def\defivarx #1 {\errmessage{@defivarx in invalid context}} - -% Now @defvar - -% First, define the processing that is wanted for arguments of @defvar. -% This is actually simple: just print them in roman. -% This must expand the args and terminate the paragraph they make up -\def\defvarargs #1{\normalparens #1% -\interlinepenalty=10000 -\endgraf\penalty 10000\vskip -\parskip\penalty 10000} - -% @defvr Counter foo-count - -\def\defvr{\defvrparsebody\Edefvr\defvrx\defvrheader} - -\def\defvrheader #1#2#3{\doind {vr}{\code{#2}}% -\begingroup\defname {#2}{#1}\defvarargs{#3}\endgroup} - -% @defvar == @defvr Variable - -\def\defvar{\defvarparsebody\Edefvar\defvarx\defvarheader} - -\def\defvarheader #1#2{\doind {vr}{\code{#1}}% Make entry in var index -\begingroup\defname {#1}{Variable}% -\defvarargs {#2}\endgroup % -} - -% @defopt == @defvr {User Option} - -\def\defopt{\defvarparsebody\Edefopt\defoptx\defoptheader} - -\def\defoptheader #1#2{\doind {vr}{\code{#1}}% Make entry in var index -\begingroup\defname {#1}{User Option}% -\defvarargs {#2}\endgroup % -} - -% @deftypevar int foobar - -\def\deftypevar{\defvarparsebody\Edeftypevar\deftypevarx\deftypevarheader} - -% #1 is the data type. #2 is the name, perhaps followed by text that -% is actually part of the data type, which should not be put into the index. -\def\deftypevarheader #1#2{% -\dovarind#2 \relax% Make entry in variables index -\begingroup\defname {\defheaderxcond#1\relax$$$#2}{Variable}% -\interlinepenalty=10000 -\endgraf\penalty 10000\vskip -\parskip\penalty 10000 -\endgroup} -\def\dovarind#1 #2\relax{\doind{vr}{\code{#1}}} - -% @deftypevr {Global Flag} int enable - -\def\deftypevr{\defvrparsebody\Edeftypevr\deftypevrx\deftypevrheader} - -\def\deftypevrheader #1#2#3{\dovarind#3 \relax% -\begingroup\defname {\defheaderxcond#2\relax$$$#3}{#1} -\interlinepenalty=10000 -\endgraf\penalty 10000\vskip -\parskip\penalty 10000 -\endgroup} - -% This definition is run if you use @defvarx -% anywhere other than immediately after a @defvar or @defvarx. - -\def\defvrx #1 {\errmessage{@defvrx in invalid context}} -\def\defvarx #1 {\errmessage{@defvarx in invalid context}} -\def\defoptx #1 {\errmessage{@defoptx in invalid context}} -\def\deftypevarx #1 {\errmessage{@deftypevarx in invalid context}} -\def\deftypevrx #1 {\errmessage{@deftypevrx in invalid context}} - -% Now define @deftp -% Args are printed in bold, a slight difference from @defvar. - -\def\deftpargs #1{\bf \defvarargs{#1}} - -% @deftp Class window height width ... - -\def\deftp{\deftpparsebody\Edeftp\deftpx\deftpheader} - -\def\deftpheader #1#2#3{\doind {tp}{\code{#2}}% -\begingroup\defname {#2}{#1}\deftpargs{#3}\endgroup} - -% This definition is run if you use @deftpx, etc -% anywhere other than immediately after a @deftp, etc. - -\def\deftpx #1 {\errmessage{@deftpx in invalid context}} - - -\message{cross reference,} -% Define cross-reference macros -\newwrite \auxfile - -\newif\ifhavexrefs % True if xref values are known. -\newif\ifwarnedxrefs % True if we warned once that they aren't known. - -% @inforef is simple. -\def\inforef #1{\inforefzzz #1,,,,**} -\def\inforefzzz #1,#2,#3,#4**{\putwordSee{} \putwordInfo{} \putwordfile{} \file{\ignorespaces #3{}}, - node \samp{\ignorespaces#1{}}} - -% \setref{foo} defines a cross-reference point named foo. - -\def\setref#1{% -\dosetq{#1-title}{Ytitle}% -\dosetq{#1-pg}{Ypagenumber}% -\dosetq{#1-snt}{Ysectionnumberandtype}} - -\def\unnumbsetref#1{% -\dosetq{#1-title}{Ytitle}% -\dosetq{#1-pg}{Ypagenumber}% -\dosetq{#1-snt}{Ynothing}} - -\def\appendixsetref#1{% -\dosetq{#1-title}{Ytitle}% -\dosetq{#1-pg}{Ypagenumber}% -\dosetq{#1-snt}{Yappendixletterandtype}} - -% \xref, \pxref, and \ref generate cross-references to specified points. -% For \xrefX, #1 is the node name, #2 the name of the Info -% cross-reference, #3 the printed node name, #4 the name of the Info -% file, #5 the name of the printed manual. All but the node name can be -% omitted. -% -\def\pxref#1{\putwordsee{} \xrefX[#1,,,,,,,]} -\def\xref#1{\putwordSee{} \xrefX[#1,,,,,,,]} -\def\ref#1{\xrefX[#1,,,,,,,]} -\def\xrefX[#1,#2,#3,#4,#5,#6]{\begingroup - \def\printedmanual{\ignorespaces #5}% - \def\printednodename{\ignorespaces #3}% - \setbox1=\hbox{\printedmanual}% - \setbox0=\hbox{\printednodename}% - \ifdim \wd0 = 0pt - % No printed node name was explicitly given. - \expandafter\ifx\csname SETxref-automatic-section-title\endcsname\relax - % Use the node name inside the square brackets. - \def\printednodename{\ignorespaces #1}% - \else - % Use the actual chapter/section title appear inside - % the square brackets. Use the real section title if we have it. - \ifdim \wd1>0pt% - % It is in another manual, so we don't have it. - \def\printednodename{\ignorespaces #1}% - \else - \ifhavexrefs - % We know the real title if we have the xref values. - \def\printednodename{\refx{#1-title}{}}% - \else - % Otherwise just copy the Info node name. - \def\printednodename{\ignorespaces #1}% - \fi% - \fi - \fi - \fi - % - % If we use \unhbox0 and \unhbox1 to print the node names, TeX does not - % insert empty discretionaries after hyphens, which means that it will - % not find a line break at a hyphen in a node names. Since some manuals - % are best written with fairly long node names, containing hyphens, this - % is a loss. Therefore, we give the text of the node name again, so it - % is as if TeX is seeing it for the first time. - \ifdim \wd1 > 0pt - \putwordsection{} ``\printednodename'' in \cite{\printedmanual}% - \else - % _ (for example) has to be the character _ for the purposes of the - % control sequence corresponding to the node, but it has to expand - % into the usual \leavevmode...\vrule stuff for purposes of - % printing. So we \turnoffactive for the \refx-snt, back on for the - % printing, back off for the \refx-pg. - {\turnoffactive \refx{#1-snt}{}}% - \space [\printednodename],\space - \turnoffactive \putwordpage\tie\refx{#1-pg}{}% - \fi -\endgroup} - -% \dosetq is the interface for calls from other macros - -% Use \turnoffactive so that punctuation chars such as underscore -% work in node names. -\def\dosetq #1#2{{\let\folio=0 \turnoffactive -\edef\next{\write\auxfile{\internalsetq {#1}{#2}}}% -\next}} - -% \internalsetq {foo}{page} expands into -% CHARACTERS 'xrdef {foo}{...expansion of \Ypage...} -% When the aux file is read, ' is the escape character - -\def\internalsetq #1#2{'xrdef {#1}{\csname #2\endcsname}} - -% Things to be expanded by \internalsetq - -\def\Ypagenumber{\folio} - -\def\Ytitle{\thissection} - -\def\Ynothing{} - -\def\Ysectionnumberandtype{% -\ifnum\secno=0 \putwordChapter\xreftie\the\chapno % -\else \ifnum \subsecno=0 \putwordSection\xreftie\the\chapno.\the\secno % -\else \ifnum \subsubsecno=0 % -\putwordSection\xreftie\the\chapno.\the\secno.\the\subsecno % -\else % -\putwordSection\xreftie\the\chapno.\the\secno.\the\subsecno.\the\subsubsecno % -\fi \fi \fi } - -\def\Yappendixletterandtype{% -\ifnum\secno=0 \putwordAppendix\xreftie'char\the\appendixno{}% -\else \ifnum \subsecno=0 \putwordSection\xreftie'char\the\appendixno.\the\secno % -\else \ifnum \subsubsecno=0 % -\putwordSection\xreftie'char\the\appendixno.\the\secno.\the\subsecno % -\else % -\putwordSection\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno % -\fi \fi \fi } - -\gdef\xreftie{'tie} - -% Use TeX 3.0's \inputlineno to get the line number, for better error -% messages, but if we're using an old version of TeX, don't do anything. -% -\ifx\inputlineno\thisisundefined - \let\linenumber = \empty % Non-3.0. -\else - \def\linenumber{\the\inputlineno:\space} -\fi - -% Define \refx{NAME}{SUFFIX} to reference a cross-reference string named NAME. -% If its value is nonempty, SUFFIX is output afterward. - -\def\refx#1#2{% - \expandafter\ifx\csname X#1\endcsname\relax - % If not defined, say something at least. - \angleleft un\-de\-fined\angleright - \ifhavexrefs - \message{\linenumber Undefined cross reference `#1'.}% - \else - \ifwarnedxrefs\else - \global\warnedxrefstrue - \message{Cross reference values unknown; you must run TeX again.}% - \fi - \fi - \else - % It's defined, so just use it. - \csname X#1\endcsname - \fi - #2% Output the suffix in any case. -} - -% This is the macro invoked by entries in the aux file. -% -\def\xrdef#1{\begingroup - % Reenable \ as an escape while reading the second argument. - \catcode`\\ = 0 - \afterassignment\endgroup - \expandafter\gdef\csname X#1\endcsname -} - -% Read the last existing aux file, if any. No error if none exists. -\def\readauxfile{\begingroup - \catcode`\^^@=\other - \catcode`\^^A=\other - \catcode`\^^B=\other - \catcode`\^^C=\other - \catcode`\^^D=\other - \catcode`\^^E=\other - \catcode`\^^F=\other - \catcode`\^^G=\other - \catcode`\^^H=\other - \catcode`\^^K=\other - \catcode`\^^L=\other - \catcode`\^^N=\other - \catcode`\^^P=\other - \catcode`\^^Q=\other - \catcode`\^^R=\other - \catcode`\^^S=\other - \catcode`\^^T=\other - \catcode`\^^U=\other - \catcode`\^^V=\other - \catcode`\^^W=\other - \catcode`\^^X=\other - \catcode`\^^Z=\other - \catcode`\^^[=\other - \catcode`\^^\=\other - \catcode`\^^]=\other - \catcode`\^^^=\other - \catcode`\^^_=\other - \catcode`\@=\other - \catcode`\^=\other - % It was suggested to define this as 7, which would allow ^^e4 etc. - % in xref tags, i.e., node names. But since ^^e4 notation isn't - % supported in the main text, it doesn't seem desirable. Furthermore, - % that is not enough: for node names that actually contain a ^ - % character, we would end up writing a line like this: 'xrdef {'hat - % b-title}{'hat b} and \xrdef does a \csname...\endcsname on the first - % argument, and \hat is not an expandable control sequence. It could - % all be worked out, but why? Either we support ^^ or we don't. - % - % The other change necessary for this was to define \auxhat: - % \def\auxhat{\def^{'hat }}% extra space so ok if followed by letter - % and then to call \auxhat in \setq. - % - \catcode`\~=\other - \catcode`\[=\other - \catcode`\]=\other - \catcode`\"=\other - \catcode`\_=\other - \catcode`\|=\other - \catcode`\<=\other - \catcode`\>=\other - \catcode`\$=\other - \catcode`\#=\other - \catcode`\&=\other - % `\+ does not work, so use 43. - \catcode43=\other - % Make the characters 128-255 be printing characters - {% - \count 1=128 - \def\loop{% - \catcode\count 1=\other - \advance\count 1 by 1 - \ifnum \count 1<256 \loop \fi - }% - }% - % The aux file uses ' as the escape (for now). - % Turn off \ as an escape so we do not lose on - % entries which were dumped with control sequences in their names. - % For example, 'xrdef {$\leq $-fun}{page ...} made by @defun ^^ - % Reference to such entries still does not work the way one would wish, - % but at least they do not bomb out when the aux file is read in. - \catcode`\{=1 - \catcode`\}=2 - \catcode`\%=\other - \catcode`\'=0 - \catcode`\\=\other - % - \openin 1 \jobname.aux - \ifeof 1 \else - \closein 1 - \input \jobname.aux - \global\havexrefstrue - \global\warnedobstrue - \fi - % Open the new aux file. TeX will close it automatically at exit. - \openout\auxfile=\jobname.aux -\endgroup} - - -% Footnotes. - -\newcount \footnoteno - -% The trailing space in the following definition for supereject is -% vital for proper filling; pages come out unaligned when you do a -% pagealignmacro call if that space before the closing brace is -% removed. (Generally, numeric constants should always be followed by a -% space to prevent strange expansion errors.) -\def\supereject{\par\penalty -20000\footnoteno =0 } - -% @footnotestyle is meaningful for info output only. -\let\footnotestyle=\comment - -\let\ptexfootnote=\footnote - -{\catcode `\@=11 -% -% Auto-number footnotes. Otherwise like plain. -\gdef\footnote{% - \global\advance\footnoteno by \@ne - \edef\thisfootno{$^{\the\footnoteno}$}% - % - % In case the footnote comes at the end of a sentence, preserve the - % extra spacing after we do the footnote number. - \let\@sf\empty - \ifhmode\edef\@sf{\spacefactor\the\spacefactor}\/\fi - % - % Remove inadvertent blank space before typesetting the footnote number. - \unskip - \thisfootno\@sf - \footnotezzz -}% - -% Don't bother with the trickery in plain.tex to not require the -% footnote text as a parameter. Our footnotes don't need to be so general. -% -% Oh yes, they do; otherwise, @ifset and anything else that uses -% \parseargline fail inside footnotes because the tokens are fixed when -% the footnote is read. --karl, 16nov96. -% -\long\gdef\footnotezzz{\insert\footins\bgroup - % We want to typeset this text as a normal paragraph, even if the - % footnote reference occurs in (for example) a display environment. - % So reset some parameters. - \interlinepenalty\interfootnotelinepenalty - \splittopskip\ht\strutbox % top baseline for broken footnotes - \splitmaxdepth\dp\strutbox - \floatingpenalty\@MM - \leftskip\z@skip - \rightskip\z@skip - \spaceskip\z@skip - \xspaceskip\z@skip - \parindent\defaultparindent - % - % Hang the footnote text off the number. - \hang - \textindent{\thisfootno}% - % - % Don't crash into the line above the footnote text. Since this - % expands into a box, it must come within the paragraph, lest it - % provide a place where TeX can split the footnote. - \footstrut - \futurelet\next\fo@t -} -\def\fo@t{\ifcat\bgroup\noexpand\next \let\next\f@@t - \else\let\next\f@t\fi \next} -\def\f@@t{\bgroup\aftergroup\@foot\let\next} -\def\f@t#1{#1\@foot} -\def\@foot{\strut\egroup} - -}%end \catcode `\@=11 - -% Set the baselineskip to #1, and the lineskip and strut size -% correspondingly. There is no deep meaning behind these magic numbers -% used as factors; they just match (closely enough) what Knuth defined. -% -\def\lineskipfactor{.08333} -\def\strutheightpercent{.70833} -\def\strutdepthpercent {.29167} -% -\def\setleading#1{% - \normalbaselineskip = #1\relax - \normallineskip = \lineskipfactor\normalbaselineskip - \normalbaselines - \setbox\strutbox =\hbox{% - \vrule width0pt height\strutheightpercent\baselineskip - depth \strutdepthpercent \baselineskip - }% -} - -% @| inserts a changebar to the left of the current line. It should -% surround any changed text. This approach does *not* work if the -% change spans more than two lines of output. To handle that, we would -% have adopt a much more difficult approach (putting marks into the main -% vertical list for the beginning and end of each change). -% -\def\|{% - % \vadjust can only be used in horizontal mode. - \leavevmode - % - % Append this vertical mode material after the current line in the output. - \vadjust{% - % We want to insert a rule with the height and depth of the current - % leading; that is exactly what \strutbox is supposed to record. - \vskip-\baselineskip - % - % \vadjust-items are inserted at the left edge of the type. So - % the \llap here moves out into the left-hand margin. - \llap{% - % - % For a thicker or thinner bar, change the `1pt'. - \vrule height\baselineskip width1pt - % - % This is the space between the bar and the text. - \hskip 12pt - }% - }% -} - -% For a final copy, take out the rectangles -% that mark overfull boxes (in case you have decided -% that the text looks ok even though it passes the margin). -% -\def\finalout{\overfullrule=0pt} - -% @image. We use the macros from epsf.tex to support this. -% If epsf.tex is not installed and @image is used, we complain. -% -% Check for and read epsf.tex up front. If we read it only at @image -% time, we might be inside a group, and then its definitions would get -% undone and the next image would fail. -\openin 1 = epsf.tex -\ifeof 1 \else - \closein 1 - \def\epsfannounce{\toks0 = }% do not bother showing banner - \input epsf.tex -\fi -% -\newif\ifwarnednoepsf -\newhelp\noepsfhelp{epsf.tex must be installed for images to - work. It is also included in the Texinfo distribution, or you can get - it from ftp://ftp.tug.org/tex/epsf.tex.} -% -% Only complain once about lack of epsf.tex. -\def\image#1{% - \ifx\epsfbox\undefined - \ifwarnednoepsf \else - \errhelp = \noepsfhelp - \errmessage{epsf.tex not found, images will be ignored}% - \global\warnednoepsftrue - \fi - \else - \imagexxx #1,,,\finish - \fi -} -% -% Arguments to @image: -% #1 is (mandatory) image filename; we tack on .eps extension. -% #2 is (optional) width, #3 is (optional) height. -% #4 is just the usual extra ignored arg for parsing this stuff. -\def\imagexxx#1,#2,#3,#4\finish{% - % \epsfbox itself resets \epsf?size at each figure. - \setbox0 = \hbox{\ignorespaces #2}\ifdim\wd0 > 0pt \epsfxsize=#2\relax \fi - \setbox0 = \hbox{\ignorespaces #3}\ifdim\wd0 > 0pt \epsfysize=#3\relax \fi - \epsfbox{#1.eps}% -} - -% End of control word definitions. - - -\message{and turning on texinfo input format.} - -\def\openindices{% - \newindex{cp}% - \newcodeindex{fn}% - \newcodeindex{vr}% - \newcodeindex{tp}% - \newcodeindex{ky}% - \newcodeindex{pg}% -} - -% Set some numeric style parameters, for 8.5 x 11 format. - -\hsize = 6in -\hoffset = .25in -\newdimen\defaultparindent \defaultparindent = 15pt -\parindent = \defaultparindent -\parskip 3pt plus 2pt minus 1pt -\setleading{13.2pt} -\advance\topskip by 1.2cm - -\chapheadingskip = 15pt plus 4pt minus 2pt -\secheadingskip = 12pt plus 3pt minus 2pt -\subsecheadingskip = 9pt plus 2pt minus 2pt - -% Prevent underfull vbox error messages. -\vbadness=10000 - -% Following George Bush, just get rid of widows and orphans. -\widowpenalty=10000 -\clubpenalty=10000 - -% Use TeX 3.0's \emergencystretch to help line breaking, but if we're -% using an old version of TeX, don't do anything. We want the amount of -% stretch added to depend on the line length, hence the dependence on -% \hsize. This makes it come to about 9pt for the 8.5x11 format. -% -\ifx\emergencystretch\thisisundefined - % Allow us to assign to \emergencystretch anyway. - \def\emergencystretch{\dimen0}% -\else - \emergencystretch = \hsize - \divide\emergencystretch by 45 -\fi - -% Use @smallbook to reset parameters for 7x9.5 format (or else 7x9.25) -\def\smallbook{ - \global\chapheadingskip = 15pt plus 4pt minus 2pt - \global\secheadingskip = 12pt plus 3pt minus 2pt - \global\subsecheadingskip = 9pt plus 2pt minus 2pt - % - \global\lispnarrowing = 0.3in - \setleading{12pt} - \advance\topskip by -1cm - \global\parskip 2pt plus 1pt - \global\hsize = 5in - \global\vsize=7.5in - \global\tolerance=700 - \global\hfuzz=1pt - \global\contentsrightmargin=0pt - \global\deftypemargin=0pt - \global\defbodyindent=.5cm - % - \global\pagewidth=\hsize - \global\pageheight=\vsize - % - \global\let\smalllisp=\smalllispx - \global\let\smallexample=\smalllispx - \global\def\Esmallexample{\Esmalllisp} -} - -% Use @afourpaper to print on European A4 paper. -\def\afourpaper{ -\global\tolerance=700 -\global\hfuzz=1pt -\setleading{12pt} -\global\parskip 15pt plus 1pt - -\global\vsize= 53\baselineskip -\advance\vsize by \topskip -%\global\hsize= 5.85in % A4 wide 10pt -\global\hsize= 6.5in -\global\outerhsize=\hsize -\global\advance\outerhsize by 0.5in -\global\outervsize=\vsize -\global\advance\outervsize by 0.6in - -\global\pagewidth=\hsize -\global\pageheight=\vsize -} - -\bindingoffset=0pt -\normaloffset=\hoffset -\pagewidth=\hsize -\pageheight=\vsize - -% Allow control of the text dimensions. Parameters in order: textheight; -% textwidth; voffset; hoffset; binding offset; topskip. -% All require a dimension; -% header is additional; added length extends the bottom of the page. - -\def\changepagesizes#1#2#3#4#5#6{ - \global\vsize= #1 - \global\topskip= #6 - \advance\vsize by \topskip - \global\voffset= #3 - \global\hsize= #2 - \global\outerhsize=\hsize - \global\advance\outerhsize by 0.5in - \global\outervsize=\vsize - \global\advance\outervsize by 0.6in - \global\pagewidth=\hsize - \global\pageheight=\vsize - \global\normaloffset= #4 - \global\bindingoffset= #5} - -% A specific text layout, 24x15cm overall, intended for A4 paper. Top margin -% 29mm, hence bottom margin 28mm, nominal side margin 3cm. -\def\afourlatex - {\global\tolerance=700 - \global\hfuzz=1pt - \setleading{12pt} - \global\parskip 15pt plus 1pt - \advance\baselineskip by 1.6pt - \changepagesizes{237mm}{150mm}{3.6mm}{3.6mm}{3mm}{7mm} - } - -% Use @afourwide to print on European A4 paper in wide format. -\def\afourwide{\afourpaper -\changepagesizes{9.5in}{6.5in}{\hoffset}{\normaloffset}{\bindingoffset}{7mm}} - -% Define macros to output various characters with catcode for normal text. -\catcode`\"=\other -\catcode`\~=\other -\catcode`\^=\other -\catcode`\_=\other -\catcode`\|=\other -\catcode`\<=\other -\catcode`\>=\other -\catcode`\+=\other -\def\normaldoublequote{"} -\def\normaltilde{~} -\def\normalcaret{^} -\def\normalunderscore{_} -\def\normalverticalbar{|} -\def\normalless{<} -\def\normalgreater{>} -\def\normalplus{+} - -% This macro is used to make a character print one way in ttfont -% where it can probably just be output, and another way in other fonts, -% where something hairier probably needs to be done. -% -% #1 is what to print if we are indeed using \tt; #2 is what to print -% otherwise. Since all the Computer Modern typewriter fonts have zero -% interword stretch (and shrink), and it is reasonable to expect all -% typewriter fonts to have this, we can check that font parameter. -% -\def\ifusingtt#1#2{\ifdim \fontdimen3\the\font=0pt #1\else #2\fi} - -% Turn off all special characters except @ -% (and those which the user can use as if they were ordinary). -% Most of these we simply print from the \tt font, but for some, we can -% use math or other variants that look better in normal text. - -\catcode`\"=\active -\def\activedoublequote{{\tt \char '042}} -\let"=\activedoublequote -\catcode`\~=\active -\def~{{\tt \char '176}} -\chardef\hat=`\^ -\catcode`\^=\active -\def^{{\tt \hat}} - -\catcode`\_=\active -\def_{\ifusingtt\normalunderscore\_} -% Subroutine for the previous macro. -\def\_{\leavevmode \kern.06em \vbox{\hrule width.3em height.1ex}} - -\catcode`\|=\active -\def|{{\tt \char '174}} -\chardef \less=`\< -\catcode`\<=\active -\def<{{\tt \less}} -\chardef \gtr=`\> -\catcode`\>=\active -\def>{{\tt \gtr}} -\catcode`\+=\active -\def+{{\tt \char 43}} -%\catcode 27=\active -%\def^^[{$\diamondsuit$} - -% Set up an active definition for =, but don't enable it most of the time. -{\catcode`\==\active -\global\def={{\tt \char 61}}} - -\catcode`+=\active -\catcode`\_=\active - -% If a .fmt file is being used, characters that might appear in a file -% name cannot be active until we have parsed the command line. -% So turn them off again, and have \everyjob (or @setfilename) turn them on. -% \otherifyactive is called near the end of this file. -\def\otherifyactive{\catcode`+=\other \catcode`\_=\other} - -\catcode`\@=0 - -% \rawbackslashxx output one backslash character in current font -\global\chardef\rawbackslashxx=`\\ -%{\catcode`\\=\other -%@gdef@rawbackslashxx{\}} - -% \rawbackslash redefines \ as input to do \rawbackslashxx. -{\catcode`\\=\active -@gdef@rawbackslash{@let\=@rawbackslashxx }} - -% \normalbackslash outputs one backslash in fixed width font. -\def\normalbackslash{{\tt\rawbackslashxx}} - -% Say @foo, not \foo, in error messages. -\escapechar=`\@ - -% \catcode 17=0 % Define control-q -\catcode`\\=\active - -% Used sometimes to turn off (effectively) the active characters -% even after parsing them. -@def@turnoffactive{@let"=@normaldoublequote -@let\=@realbackslash -@let~=@normaltilde -@let^=@normalcaret -@let_=@normalunderscore -@let|=@normalverticalbar -@let<=@normalless -@let>=@normalgreater -@let+=@normalplus} - -@def@normalturnoffactive{@let"=@normaldoublequote -@let\=@normalbackslash -@let~=@normaltilde -@let^=@normalcaret -@let_=@normalunderscore -@let|=@normalverticalbar -@let<=@normalless -@let>=@normalgreater -@let+=@normalplus} - -% Make _ and + \other characters, temporarily. -% This is canceled by @fixbackslash. -@otherifyactive - -% If a .fmt file is being used, we don't want the `\input texinfo' to show up. -% That is what \eatinput is for; after that, the `\' should revert to printing -% a backslash. -% -@gdef@eatinput input texinfo{@fixbackslash} -@global@let\ = @eatinput - -% On the other hand, perhaps the file did not have a `\input texinfo'. Then -% the first `\{ in the file would cause an error. This macro tries to fix -% that, assuming it is called before the first `\' could plausibly occur. -% Also back turn on active characters that might appear in the input -% file name, in case not using a pre-dumped format. -% -@gdef@fixbackslash{@ifx\@eatinput @let\ = @normalbackslash @fi - @catcode`+=@active @catcode`@_=@active} - -%% These look ok in all fonts, so just make them not special. The @rm below -%% makes sure that the current font starts out as the newly loaded cmr10 -@catcode`@$=@other @catcode`@%=@other @catcode`@&=@other @catcode`@#=@other - -@textfonts -@rm - -@c Local variables: -@c page-delimiter: "^\\\\message" -@c End: diff --git a/doc/version.texi b/doc/version.texi deleted file mode 100644 index 392ee12ad..000000000 --- a/doc/version.texi +++ /dev/null @@ -1,3 +0,0 @@ -@set UPDATED 7 October 1998 -@set EDITION 1.3a -@set VERSION 1.3a diff --git a/guile-config/.cvsignore b/guile-config/.cvsignore deleted file mode 100644 index d634abbfc..000000000 --- a/guile-config/.cvsignore +++ /dev/null @@ -1,2 +0,0 @@ -Makefile -guile-config diff --git a/guile-config/ChangeLog b/guile-config/ChangeLog deleted file mode 100644 index 4e56b063b..000000000 --- a/guile-config/ChangeLog +++ /dev/null @@ -1,74 +0,0 @@ -1998-10-09 Jim Blandy <jimb@zwingli.cygnus.com> - - * guile-config.in: Add copyright notice. - -1998-10-07 Jim Blandy <jimb@zwingli.cygnus.com> - - * guile-config.in (build-link): It isn't. Revert the change. - - * guile-config.in (build-link): Include a -R flag in the output - from link. Not sure if this is the right thing to do. - -1998-10-05 Jim Blandy <jimb@zwingli.cygnus.com> - - * guile-config.in (build-compile, help-compile, usage-compile): - New functions to implement new subcommand. - - * guile-config.in: Redo the help system, so that each subcommand - defines its own usage text, as well as its help text. - - * guile-config.in (build-link): Include a -L option in the output - from `guile-config link', indicating where libguile was installed. - (Thanks to Greg Troxel.) - -1998-10-03 Jim Blandy <jimb@zwingli.cygnus.com> - - * guile-config.in: Don't import ice-9 regex; that's not available - on all systems. Maybe someday we'll have our own... - (set-program-name!): Use basename. - (build-link): Use basename and stock string functions, instead of - string-match. - (Bug report from Greg Troxel --- thanks!) - - * Directory renamed to guile-config from build. - * guile-config.in: Renamed from build-guile.in, for consistency - with the analogous script for GTK, called gtk-config. - * Makefile.am, .cvsignore: References to `build-guile' replaced - with `guile-config'. - -1998-07-29 Jim Blandy <jimb@zwingli.cygnus.com> - - * Makefile.in: Regenerated using the last public version of - automake, not the hacked Cygnus version. - -1998-07-28 Jim Blandy <jimb@zwingli.cygnus.com> - - * Makefile.in: Regenerated, after removing Totoro kludge. - -1998-07-26 Jim Blandy <jimb@zwingli.cygnus.com> - - * Makefile.in: Rebuilt, for config changes in parent dir. - -1998-01-05 Tim Pierce <twp@skepsis.com> - - * .cvsignore: New file. - -Mon Oct 6 11:45:59 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * build-guile.in: Try to return an appropriate exit status. - - * build-guile.in: Rearranged to use a table of subcommands, and - include per-subcommand help. - - * build-guile.in: New "info" subcommand, for easy access to Guile - build variables. - -Mon Sep 29 23:53:14 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * Makefile.in: Regenerated with automake 1.2c. - -Sat Sep 27 23:15:26 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * New directory --- the build-guile command, intended to help - people build Guile-based applications. - * Makefile.am, Makefile.in, build-guile.in: New files. diff --git a/guile-config/Makefile.am b/guile-config/Makefile.am deleted file mode 100644 index 133cbb231..000000000 --- a/guile-config/Makefile.am +++ /dev/null @@ -1,22 +0,0 @@ -#### Makefile.in template for guile-core/guile-config. -#### Jim Blandy <jimb@red-bean.com> --- September 1997 - -bin_SCRIPTS=guile-config -CLEANFILES=guile-config -EXTRA_DIST=guile-config.in - -## We use @-...-@ as the substitution brackets here, instead of the -## usual @...@, so autoconf doesn't go and substitute the values -## directly into the left-hand sides of the sed substitutions. *sigh* -guile-config: guile-config.in - rm -f guile-config.tmp - sed < ${srcdir}/guile-config.in > guile-config.tmp \ - -e s:@-bindir-@:${bindir}: \ - -e s:@-GUILE_VERSION-@:${GUILE_VERSION}: - chmod +x guile-config.tmp - mv guile-config.tmp guile-config - -## Get rid of any copies of the configuration script under the old -## name, so people don't end up running ancient copies of it. -install-exec-local: - rm -f ${bindir}/build-guile diff --git a/guile-config/Makefile.in b/guile-config/Makefile.in deleted file mode 100644 index 1b3da0aef..000000000 --- a/guile-config/Makefile.in +++ /dev/null @@ -1,224 +0,0 @@ -# Makefile.in generated automatically by automake 1.3 from Makefile.am - -# Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc. -# This Makefile.in 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 program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - -#### Makefile.in template for guile-core/guile-config. -#### Jim Blandy <jimb@red-bean.com> --- September 1997 - - -SHELL = /bin/sh - -srcdir = @srcdir@ -top_srcdir = @top_srcdir@ -VPATH = @srcdir@ -prefix = @prefix@ -exec_prefix = @exec_prefix@ - -bindir = @bindir@ -sbindir = @sbindir@ -libexecdir = @libexecdir@ -datadir = @datadir@ -sysconfdir = @sysconfdir@ -sharedstatedir = @sharedstatedir@ -localstatedir = @localstatedir@ -libdir = @libdir@ -infodir = @infodir@ -mandir = @mandir@ -includedir = @includedir@ -oldincludedir = /usr/include - -DISTDIR = - -pkgdatadir = $(datadir)/@PACKAGE@ -pkglibdir = $(libdir)/@PACKAGE@ -pkgincludedir = $(includedir)/@PACKAGE@ - -top_builddir = .. - -ACLOCAL = @ACLOCAL@ -AUTOCONF = @AUTOCONF@ -AUTOMAKE = @AUTOMAKE@ -AUTOHEADER = @AUTOHEADER@ - -INSTALL = @INSTALL@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_DATA = @INSTALL_DATA@ -INSTALL_SCRIPT = @INSTALL_SCRIPT@ -transform = @program_transform_name@ - -NORMAL_INSTALL = : -PRE_INSTALL = : -POST_INSTALL = : -NORMAL_UNINSTALL = : -PRE_UNINSTALL = : -POST_UNINSTALL = : -host_alias = @host_alias@ -host_triplet = @host@ -AWK = @AWK@ -CC = @CC@ -CPP = @CPP@ -GUILE_LIBS = @GUILE_LIBS@ -GUILE_MAJOR_VERSION = @GUILE_MAJOR_VERSION@ -GUILE_MINOR_VERSION = @GUILE_MINOR_VERSION@ -GUILE_STAMP = @GUILE_STAMP@ -GUILE_VERSION = @GUILE_VERSION@ -LD = @LD@ -LIBLOBJS = @LIBLOBJS@ -LIBTOOL = @LIBTOOL@ -LN_S = @LN_S@ -MAINT = @MAINT@ -MAKEINFO = @MAKEINFO@ -NM = @NM@ -PACKAGE = @PACKAGE@ -QTHREAD_LTLIBS = @QTHREAD_LTLIBS@ -RANLIB = @RANLIB@ -THREAD_CPPFLAGS = @THREAD_CPPFLAGS@ -THREAD_LIBS_INSTALLED = @THREAD_LIBS_INSTALLED@ -THREAD_LIBS_LOCAL = @THREAD_LIBS_LOCAL@ -THREAD_PACKAGE = @THREAD_PACKAGE@ -VERSION = @VERSION@ -qtdmdb_s = @qtdmdb_s@ -qtmd_h = @qtmd_h@ -qtmdc_c = @qtmdc_c@ -qtmds_s = @qtmds_s@ - -bin_SCRIPTS=guile-config -CLEANFILES=guile-config -EXTRA_DIST=guile-config.in -mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs -CONFIG_HEADER = ../libguile/scmconfig.h -CONFIG_CLEAN_FILES = -SCRIPTS = $(bin_SCRIPTS) - -DIST_COMMON = ChangeLog Makefile.am Makefile.in - - -DISTFILES = $(DIST_COMMON) $(SOURCES) $(HEADERS) $(TEXINFOS) $(EXTRA_DIST) - -TAR = tar -GZIP = --best -all: Makefile $(SCRIPTS) - -.SUFFIXES: -$(srcdir)/Makefile.in: @MAINT@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) - cd $(top_srcdir) && $(AUTOMAKE) --gnu guile-config/Makefile - -Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status $(BUILT_SOURCES) - cd $(top_builddir) \ - && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status - - -install-binSCRIPTS: $(bin_SCRIPTS) - @$(NORMAL_INSTALL) - $(mkinstalldirs) $(DESTDIR)$(bindir) - @list='$(bin_SCRIPTS)'; for p in $$list; do \ - if test -f $$p; then \ - echo " $(INSTALL_SCRIPT) $$p $(DESTDIR)$(bindir)/`echo $$p|sed '$(transform)'`"; \ - $(INSTALL_SCRIPT) $$p $(DESTDIR)$(bindir)/`echo $$p|sed '$(transform)'`; \ - else if test -f $(srcdir)/$$p; then \ - echo " $(INSTALL_SCRIPT) $(srcdir)/$$p $(DESTDIR)$(bindir)/`echo $$p|sed '$(transform)'`"; \ - $(INSTALL_SCRIPT) $(srcdir)/$$p $(DESTDIR)$(bindir)/`echo $$p|sed '$(transform)'`; \ - else :; fi; fi; \ - done - -uninstall-binSCRIPTS: - @$(NORMAL_UNINSTALL) - list='$(bin_SCRIPTS)'; for p in $$list; do \ - rm -f $(DESTDIR)$(bindir)/`echo $$p|sed '$(transform)'`; \ - done -tags: TAGS -TAGS: - - -distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir) - -subdir = guile-config - -distdir: $(DISTFILES) - here=`cd $(top_builddir) && pwd`; \ - top_distdir=`cd $(top_distdir) && pwd`; \ - distdir=`cd $(distdir) && pwd`; \ - cd $(top_srcdir) \ - && $(AUTOMAKE) --include-deps --build-dir=$$here --srcdir-name=$(top_srcdir) --output-dir=$$top_distdir --gnu guile-config/Makefile - @for file in $(DISTFILES); do \ - d=$(srcdir); \ - test -f $(distdir)/$$file \ - || ln $$d/$$file $(distdir)/$$file 2> /dev/null \ - || cp -p $$d/$$file $(distdir)/$$file; \ - done -info: -dvi: -check: all - $(MAKE) -installcheck: -install-exec: install-binSCRIPTS install-exec-local - @$(NORMAL_INSTALL) - -install-data: - @$(NORMAL_INSTALL) - -install: install-exec install-data all - @: - -uninstall: uninstall-binSCRIPTS - -install-strip: - $(MAKE) INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' INSTALL_SCRIPT='$(INSTALL_PROGRAM)' install -installdirs: - $(mkinstalldirs) $(DATADIR)$(bindir) - - -mostlyclean-generic: - -test -z "$(MOSTLYCLEANFILES)" || rm -f $(MOSTLYCLEANFILES) - -clean-generic: - -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) - -distclean-generic: - -rm -f Makefile $(DISTCLEANFILES) - -rm -f config.cache config.log stamp-h stamp-h[0-9]* - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -maintainer-clean-generic: - -test -z "$(MAINTAINERCLEANFILES)" || rm -f $(MAINTAINERCLEANFILES) - -test -z "$(BUILT_SOURCES)" || rm -f $(BUILT_SOURCES) -mostlyclean: mostlyclean-generic - -clean: clean-generic mostlyclean - -distclean: distclean-generic clean - -rm -f config.status - -rm -f libtool - -maintainer-clean: maintainer-clean-generic distclean - @echo "This command is intended for maintainers to use;" - @echo "it deletes files that may require special tools to rebuild." - -.PHONY: uninstall-binSCRIPTS install-binSCRIPTS tags distdir info dvi \ -installcheck install-exec install-data install uninstall all \ -installdirs mostlyclean-generic distclean-generic clean-generic \ -maintainer-clean-generic clean mostlyclean distclean maintainer-clean - - -guile-config: guile-config.in - rm -f guile-config.tmp - sed < ${srcdir}/guile-config.in > guile-config.tmp \ - -e s:@-bindir-@:${bindir}: \ - -e s:@-GUILE_VERSION-@:${GUILE_VERSION}: - chmod +x guile-config.tmp - mv guile-config.tmp guile-config - -install-exec-local: - rm -f ${bindir}/build-guile - -# Tell versions [3.59,3.63) of GNU make to not export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: diff --git a/guile-config/guile-config.in b/guile-config/guile-config.in deleted file mode 100644 index e906cb2f2..000000000 --- a/guile-config/guile-config.in +++ /dev/null @@ -1,283 +0,0 @@ -#!@-bindir-@/guile \ --e main -s -!# -;;;; guile-config --- utility for linking programs with Guile -;;;; Jim Blandy <jim@red-bean.com> --- September 1997 -;;;; -;;;; Copyright (C) 1998 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., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 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. - -;;; TODO: -;;; * Add some plausible structure for returning the right exit status, -;;; just something that encourages people to do the correct thing. -;;; * Implement the static library support. This requires that -;;; some portion of the module system be done. - -(use-modules (ice-9 string-fun)) - - -;;;; main function, command-line processing - -;;; The script's entry point. -(define (main args) - (set-program-name! (car args)) - (let ((args (cdr args))) - (cond - ((null? args) (show-help '()) - (quit 1)) - ((assoc (car args) command-table) - => (lambda (row) - (set! subcommand-name (car args)) - ((cadr row) (cdr args)))) - (else (show-help '()) - (quit 1))))) - -(define program-name #f) -(define subcommand-name #f) -(define program-version "@-GUILE_VERSION-@") - -;;; Given an executable path PATH, set program-name to something -;;; appropriate f or use in error messages (i.e., with leading -;;; directory names stripped). -(define (set-program-name! path) - (set! program-name (basename path))) - -(define (show-help args) - (cond - ((null? args) (show-help-overview)) - ((assoc (car args) command-table) - => (lambda (row) ((caddr row)))) - (else - (show-help-overview)))) - -(define (show-help-overview) - (display-line-error "Usage: ") - (for-each (lambda (row) ((cadddr row))) - command-table)) - -(define (usage-help) - (let ((dle display-line-error) - (p program-name)) - (dle " " p " --help - show usage info (this message)") - (dle " " p " --help SUBCOMMAND - show help for SUBCOMMAND"))) - -(define (show-version args) - (display-line-error program-name " - Guile version " program-version)) - -(define (help-version) - (let ((dle display-line-error)) - (dle "Usage: " program-name " --version") - (dle "Show the version of this script. This is also the version of") - (dle "Guile this script was installed with."))) - -(define (usage-version) - (display-line-error - " " program-name " --version - show installed script and Guile version")) - - -;;;; the "link" subcommand - -;;; Write a set of linker flags to standard output to include the -;;; libraries that libguile needs to link against. -;;; -;;; In the long run, we want to derive these flags from Guile module -;;; declarations files that are installed along the load path. For -;;; now, we're just going to reach into Guile's configuration info and -;;; hack it out. -(define (build-link args) - (if (> (length args) 0) - (error - (string-append program-name - " link: arguments to subcommand not yet implemented"))) - - ;; If PATH has the form FOO/libBAR.a, return the substring - ;; BAR, otherwise return #f. - (define (match-lib path) - (let* ((base (basename path)) - (len (string-length base))) - (if (and (> len 5) - (string=? (make-shared-substring base 0 3) "lib") - (string=? (make-shared-substring base (- len 2)) ".a")) - (make-shared-substring base 3 (- len 2)) - #f))) - - (let* ((flags - (let loop ((libs - ;; Get the string of linker flags we used to build - ;; Guile, and break it up into a list. - (separate-fields-discarding-char #\space - (get-build-info 'LIBS) - list))) - - (cond - ((null? libs) '()) - - ;; Turn any "FOO/libBAR.a" elements into "-lBAR". - ((match-lib (car libs)) - => (lambda (bar) - (cons (string-append "-l" bar) - (loop (cdr libs))))) - - ;; Remove any empty strings that may have seeped in there. - ((string=? (car libs) "") (loop (cdr libs))) - - (else (cons (car libs) (loop (cdr libs))))))) - - ;; Include libguile itself in the list, along with the - ;; directory it was installed in. - (flags (cons (string-append "-L" (get-build-info 'libdir)) - (cons "-lguile" flags)))) - - ;; Display the flags, separated by spaces. - (display-separated flags) - (newline))) - -(define (help-link) - (let ((dle display-line-error)) - (dle "Usage: " program-name " link") - (dle "Print linker flags for building the `guile' executable.") - (dle "Print the linker command-line flags necessary to link against") - (dle "the Guile library, and any other libraries it requires."))) - -(define (usage-link) - (display-line-error - " " program-name " link - print libraries to link with")) - - - -;;;; The "compile" subcommand - -(define (build-compile args) - (if (> (length args) 0) - (error - (string-append program-name - " compile: no arguments expected"))) - (display-line "-I" (get-build-info 'includedir))) - -(define (help-compile) - (let ((dle display-line-error)) - (dle "Usage: " program-name " compile") - (dle "Print C compiler flags for compiling code that uses Guile.") - (dle "This includes any `-I' flags needed to find Guile's header files."))) - -(define (usage-compile) - (display-line-error - " " program-name " compile - print C compiler flags to compile with")) - - -;;;; The "info" subcommand - -(define (build-info args) - (cond - ((null? args) (show-all-vars)) - ((null? (cdr args)) (show-var (car args))) - (else (display-line-error "Usage: " program-name " info [VAR]") - (quit 2)))) - -(define (show-all-vars) - (for-each (lambda (binding) - (display-line (car binding) " = " (cdr binding))) - %guile-build-info)) - -(define (show-var var) - (display (get-build-info (string->symbol var))) - (newline)) - -(define (help-info) - (let ((d display-line-error)) - (d "Usage: " program-name " info [VAR]") - (d "Display the value of the Makefile variable VAR used when Guile") - (d "was built. If VAR is omitted, display all Makefile variables.") - (d "Use this command to find out where Guile was installed,") - (d "where it will look for Scheme code at run-time, and so on."))) - -(define (usage-info) - (display-line-error - " " program-name " info [VAR] - print Guile build directories")) - - -;;;; trivial utilities - -(define (get-build-info name) - (let ((val (assq name %guile-build-info))) - (if (not (pair? val)) - (begin - (display-line-error - program-name " " subcommand-name ": no such build-info: " name) - (quit 2))) - (cdr val))) - -(define (display-line . args) - (apply display-line-port (current-output-port) args)) - -(define (display-line-error . args) - (apply display-line-port (current-error-port) args)) - -(define (display-line-port port . args) - (for-each (lambda (arg) (display arg port)) - args) - (newline)) - -(define (display-separated args) - (let loop ((args args)) - (cond ((null? args)) - ((null? (cdr args)) (display (car args))) - (else (display (car args)) - (display " ") - (loop (cdr args)))))) - - -;;;; the command table - -;;; We define this down here, so Guile builds the list after all the -;;; functions have been defined. -(define command-table - (list - (list "--version" show-version help-version usage-version) - (list "--help" show-help show-help-overview usage-help) - (list "link" build-link help-link usage-link) - (list "compile" build-compile help-compile usage-compile) - (list "info" build-info help-info usage-info))) - - -;;; Local Variables: -;;; mode: scheme -;;; End: diff --git a/guile.m4 b/guile.m4 deleted file mode 100644 index e69de29bb..000000000 --- a/guile.m4 +++ /dev/null diff --git a/ice-9/.cvsignore b/ice-9/.cvsignore deleted file mode 100644 index c957c8fa3..000000000 --- a/ice-9/.cvsignore +++ /dev/null @@ -1,4 +0,0 @@ -Makefile -config.log -config.status -version.scm diff --git a/ice-9/COPYING b/ice-9/COPYING deleted file mode 100644 index eeb586b39..000000000 --- a/ice-9/COPYING +++ /dev/null @@ -1,340 +0,0 @@ - GNU GENERAL PUBLIC LICENSE - Version 2, June 1991 - - Copyright (C) 1989, 1991 Free Software Foundation, Inc. - 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -License is intended to guarantee your freedom to share and change free -software--to make sure the software is free for all its users. This -General Public License applies to most of the Free Software -Foundation's software and to any other program whose authors commit to -using it. (Some other Free Software Foundation software is covered by -the GNU Library General Public License instead.) You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, 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 or use pieces of it -in new free programs; and that you know you can do these things. - - To protect your rights, we need to make restrictions that forbid -anyone to deny you these rights or to ask you to surrender the rights. -These restrictions translate to certain responsibilities for you if you -distribute copies of the software, or if you modify it. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must give the recipients all the rights that -you have. You must make sure that they, too, receive or can get the -source code. And you must show them these terms so they know their -rights. - - We protect your rights with two steps: (1) copyright the software, and -(2) offer you this license which gives you legal permission to copy, -distribute and/or modify the software. - - Also, for each author's protection and ours, we want to make certain -that everyone understands that there is no warranty for this free -software. If the software is modified by someone else and passed on, we -want its recipients to know that what they have is not the original, so -that any problems introduced by others will not reflect on the original -authors' reputations. - - Finally, any free program is threatened constantly by software -patents. We wish to avoid the danger that redistributors of a free -program will individually obtain patent licenses, in effect making the -program proprietary. To prevent this, we have made it clear that any -patent must be licensed for everyone's free use or not licensed at all. - - The precise terms and conditions for copying, distribution and -modification follow. - - GNU GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License applies to any program or other work which contains -a notice placed by the copyright holder saying it may be distributed -under the terms of this General Public License. The "Program", below, -refers to any such program or work, and a "work based on the Program" -means either the Program or any derivative work under copyright law: -that is to say, a work containing the Program or a portion of it, -either verbatim or with modifications and/or translated into another -language. (Hereinafter, translation is included without limitation in -the term "modification".) Each licensee is addressed as "you". - -Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running the Program is not restricted, and the output from the Program -is covered only if its contents constitute a work based on the -Program (independent of having been made by running the Program). -Whether that is true depends on what the Program does. - - 1. You may copy and distribute verbatim copies of the Program's -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 give any other recipients of the Program a copy of this License -along with the Program. - -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 Program or any portion -of it, thus forming a work based on the Program, 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) You must cause the modified files to carry prominent notices - stating that you changed the files and the date of any change. - - b) You must cause any work that you distribute or publish, that in - whole or in part contains or is derived from the Program or any - part thereof, to be licensed as a whole at no charge to all third - parties under the terms of this License. - - c) If the modified program normally reads commands interactively - when run, you must cause it, when started running for such - interactive use in the most ordinary way, to print or display an - announcement including an appropriate copyright notice and a - notice that there is no warranty (or else, saying that you provide - a warranty) and that users may redistribute the program under - these conditions, and telling the user how to view a copy of this - License. (Exception: if the Program itself is interactive but - does not normally print such an announcement, your work based on - the Program is not required to print an announcement.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Program, -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 Program, 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 Program. - -In addition, mere aggregation of another work not based on the Program -with the Program (or with a work based on the Program) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may copy and distribute the Program (or a work based on it, -under Section 2) in object code or executable form under the terms of -Sections 1 and 2 above provided that you also do one of the following: - - a) 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; or, - - b) Accompany it with a written offer, valid for at least three - years, to give any third party, for a charge no more than your - cost of physically performing source distribution, a complete - machine-readable copy of the corresponding source code, to be - distributed under the terms of Sections 1 and 2 above on a medium - customarily used for software interchange; or, - - c) Accompany it with the information you received as to the offer - to distribute corresponding source code. (This alternative is - allowed only for noncommercial distribution and only if you - received the program in object code or executable form with such - an offer, in accord with Subsection b above.) - -The source code for a work means the preferred form of the work for -making modifications to it. For an executable work, 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 executable. However, as a -special exception, the source code 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. - -If distribution of executable or 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 counts as -distribution of the source code, even though third parties are not -compelled to copy the source along with the object code. - - 4. You may not copy, modify, sublicense, or distribute the Program -except as expressly provided under this License. Any attempt -otherwise to copy, modify, sublicense or distribute the Program 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. - - 5. 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 Program or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Program (or any work based on the -Program), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Program or works based on it. - - 6. Each time you redistribute the Program (or any work based on the -Program), the recipient automatically receives a license from the -original licensor to copy, distribute or modify the Program 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 to -this License. - - 7. 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 Program at all. For example, if a patent -license would not permit royalty-free redistribution of the Program 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 Program. - -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. - - 8. If the distribution and/or use of the Program is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Program 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. - - 9. The Free Software Foundation may publish revised and/or new versions -of the 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 Program -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 Program does not specify a version number of -this License, you may choose any version ever published by the Free Software -Foundation. - - 10. If you wish to incorporate parts of the Program into other free -programs whose distribution conditions are different, 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 - - 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY -FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN -OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES -PROVIDE THE PROGRAM "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 PROGRAM IS WITH YOU. SHOULD THE -PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, -REPAIR OR CORRECTION. - - 12. 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 PROGRAM 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 PROGRAM (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 PROGRAM TO OPERATE WITH ANY OTHER -PROGRAMS), 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 Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. 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 program's name and a brief idea of what it does.> - Copyright (C) 19yy <name of author> - - 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 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -Also add information on how to contact you by electronic and paper mail. - -If the program is interactive, make it output a short notice like this -when it starts in an interactive mode: - - Gnomovision version 69, Copyright (C) 19yy name of author - Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, the commands you use may -be called something other than `show w' and `show c'; they could even be -mouse-clicks or menu items--whatever suits your program. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the program, if -necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the program - `Gnomovision' (which makes passes at compilers) written by James Hacker. - - <signature of Ty Coon>, 1 April 1989 - Ty Coon, President of Vice - -This General Public License does not permit incorporating your program into -proprietary programs. If your program is a subroutine library, you may -consider it more useful to permit linking proprietary applications with the -library. If this is what you want to do, use the GNU Library General -Public License instead of this License. diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog deleted file mode 100644 index 123f1511b..000000000 --- a/ice-9/ChangeLog +++ /dev/null @@ -1,1538 +0,0 @@ -1998-10-14 Jim Blandy <jimb@zwingli.cygnus.com> - - * calling.scm (excursion-function-syntax): Use a sequence of - set!'s, not a single multi-variable set!; we removed support for - that syntax a long time ago. (Thanks to Shuji Narazaki.) - -1998-10-12 Jim Blandy <jimb@zwingli.cygnus.com> - - * r4rs.scm (OPEN_READ, OPEN_WRITE, OPEN_BOTH): Don't bother - testing software-type here. That's the least of our Windows - porting issues, and it's done wrong anyway. - -1998-10-09 Jim Blandy <jimb@zwingli.cygnus.com> - - * boot-9.scm (read-path-list-notation-warning): New function: - print a warning the first time we see `#/' notation. - - * q.scm (sync-q!, q?, q-remove!, q-push!, enq!): Lots of bugs, and - (eq? #f '()) assumptions. Make functions that aren't documented - to return anything else return the queue itself. (Bug report from - Michael Livshin --- thanks!) - -1998-08-21 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * debug.scm (trace-entry, trace-exit): Removed re-enabling of - trace flag. - - * boot-9.scm (make-options): Bugfix: Changed pair? --> list? in - order to allow the empty list as arg. - (error-catching-loop): Use `with-traps' to create a dynamic - context with traps enabled. - -1998-08-19 Mikael Djurfeldt <mdj@barbara.nada.kth.se> - - * boot-9.scm: Removed (ice-9 regex) from use-list of (guile) - module. - (try-using-libtool-name): Removed dependency on (ice-9 regex). - -1998-08-15 Mikael Djurfeldt <mdj@barbara.nada.kth.se> - - * boot-9.scm: Make the root module use (ice-9 regex) if - available. The dynamic linking facilities in boot-9.scm are - currently dependent upon regular expressions. My change of - 1998-07-14 removed (ice-9 regex) from the use-list of the root - module and thereby destroyed dynamic linking. - -1998-07-29 Jim Blandy <jimb@zwingli.cygnus.com> - - * Makefile.in: Regenerated using the last public version of - automake, not the hacked Cygnus version. - -1998-07-28 Jim Blandy <jimb@zwingli.cygnus.com> - - * Makefile.in: Regenerated, after removing Totoro kludge. - -1998-07-28 Jim Blandy <jimb@totoro.red-bean.com> - - * getopt-gnu-style.scm: New file. (Thanks to Russ McManus.) - -1998-07-26 Jim Blandy <jimb@zwingli.cygnus.com> - - * Makefile.in Rebuilt, for config changes in parent dir. - -1998-07-21 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * readline.scm (make-readline-port): Set prompt string to "... " - after first read line. (Thanks to Richard Polton.) - -1998-07-19 Jim Blandy <jimb@zwingli.cygnus.com> - - * lineio.scm (make-line-buffering-input-port): Don't use - ungetc-char-ready?, since we don't provide that function any - more. The unread-string function doesn't interact properly with - any of the standard I/O functions anyway. (Thanks to Andrew - Archibald.) - - * hcons.scm (hashq-cons-assoc): Don't assume the empty list is - false. Return false when we cannot find a matching entry in the - list. (Thanks to Andrew Archibald.) - -1998-07-16 Mikael Djurfeldt <mdj@barbara.nada.kth.se> - - * boot-9.scm (export, export-syntax): New special forms: Export - bindings from a module. `(export name1 name2 ...)' can be used at - the top of a module (after `define-module') to specify which names - should be exported. It can be used as an alternative to - `define-public'. `export-syntax' works equivalently to `export' - but is intended for export of syntactic keywords. - (Thanks to Thien-Thi Nguyen.) - -1998-07-15 Mikael Djurfeldt <mdj@barbara.nada.kth.se> - - * boot-9.scm: Renamed module `(guile-repl)' --> `(guile-user)'. - -1998-07-14 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * boot-9.scm: Let the user start in module `(guile-repl)' instead - of module `(guile)'. Also make sure that `(guile-repl)' uses - suitable modules. This change improves Guile stability - substantially since bindings will only be copied from the root - module: If the user redefines builtins in `(guile-repl)' it won't - affect the internal operation of Guile itself. - -1998-06-19 Mikael Djurfeldt <mdj@barbara.nada.kth.se> - - * boot-9.scm (load-module): When loading files from within files - themselves being loaded: Use the directory path of the file being - loaded as root for relative filenames. (After suggestion by - Steven G. Johnson.) - -1998-06-15 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * emacs.scm (emacs-load): New feature: Eval in specified module. - -1998-06-14 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * readline.scm: Typo in regex module name. - -1998-06-13 Mikael Djurfeldt <mdj@barbara.nada.kth.se> - - * readline.scm (apropos-completion-function): regexp-quote text to - be completed. - -1998-06-11 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * debug.scm, emacs.scm: Bugfix: Treat `the-last-stack' as a fluid. - -1998-06-09 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * boot-9.scm: Check that (current-input-port) is a tty before - enabling readline. (Thanks to Michael N. Livshin.) - -1998-06-07 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * boot-9.scm (use-syntax): Turned into a macro inorder to be - similar in use to `use-modules'. - Example: (use-syntax (ice-9 syncase)) will 1. load the module - (ice-9 syncase), and, 2. install the procedure `syncase' as eval - transformer. - (internal-use-syntax): New procedure. - (process-define-module): Use `internal-use-syntax'. - -1998-05-19 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * Makefile.am (ice9_sources): Add emacs.scm. - -1998-05-13 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * readline.scm: Use the new readline facilities: Add the - possibility to control input and output ports; Add apropos - completion. - - * boot-9.scm: Antirevert Jim's readline code which he reverted - 19971027 and adapt it to the current readline interface. - - * boot-9.scm (top-repl): Only enable readline if not using the - Emacs interface; Only use repl prompt when using the readline port - from repl-read. (We don't want to see it when calling `read'.) - - * boot-9.scm (remove-hook!): Parenthesis bug. - -1998-05-11 Mikael Djurfeldt <mdj@kenneth> - - * boot-9.scm: Load readline module if readline is present. - - * readline.scm (apropos-completion-function): New procedure: - Symbolic completion. (Thanks to Andrew Archibald!) - -1998-04-22 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * boot-9.scm (process-define-module): Added keyword use-syntax. - -1998-04-19 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * nonblocking.scm: Removed. libguile is now inherently - nonblocking through the use of scm_internal_select. - - * emacs.scm: Removed use of nonblocking.scm. - - * gwish.scm, gtcl.scm: Removed. tcltk.scm has made these - obsolete. - -1998-04-15 Mikael Djurfeldt <mdj@nada.kth.se> - - * runq.scm (runq-control): Corrected spelling of enqueue!. - (Thanks to Karl M. Hegbloom.) - -1998-03-30 Mikael Djurfeldt <mdj@nada.kth.se> - - * boot-9.scm: Added new run-time option interface eval-options. - -1998-03-28 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * boot-9.scm (remove-hook!): New macro. (Thanks to Maciej - Stachowiak.) - -1998-01-30 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * threads.scm: Added simple error and signal handler. - (make-thread, begin-handler): Use this handler. The most - important effect of this is that signals get unmasked. - Previously, when a signal was thrown signals remained masked - (signals get masked when a signal is taken) which influenced other - threads. - -1998-01-01 Tim Pierce <twp@skepsis.com> - - A better fix to the SLIB identity problem -- thanks to Marius Vollmer. - * slib.scm (identity): Unmake public. - (slib:eval): Evaluate inside `slib-module'. - -1997-12-24 Tim Pierce <twp@skepsis.com> - - * boot-9.scm: Doc fix. - - * slib.scm (identity): Made public. - (home-vicinity): New function (from SLIB/Template.scm). - -1997-12-13 Tim Pierce <twp@skepsis.com> - -* * boot-9.scm (read-line): Rewritten to call %read-line for - improved speed. Minor user-visible changes: the new functions are - hardwired to treat the LFD character as signifying end-of-line, so - changing `scm-line-incrementors' will no longer affect the - behavior of read-line. On platforms which do not represent - end-of-line with a LFD character, read-line should behave more - like native line-processing facilities, but there is still a ways - to go here. - -Sat Nov 29 01:24:46 1997 Mikael Djurfeldt <mdj@kenneth> - - * boot-9.scm (error-catching-loop, save-stack): `the-last-stack' - is now a fluid. - -1997-11-28 Tim Pierce <twp@skepsis.com> - - * boot-9.scm (find-and-link-dynamic-module): If a module directory - contains a .la file (a libtool support file), attempt to extract - the shared library name from that file. If the .la file does not - exist, try to link against a .so file. Libtool-generated compiled - modules should load more cleanly in Guile now. - (try-using-libtool-name, try-using-sharlib-name): New functions. - -Sun Nov 9 06:10:59 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (set-batch-mode?!, batch-mode?): initialize more - usefully so they will work from a script. - -1997-10-31 Marius Vollmer <mvo@zagadka.ping.de> - - * boot-9.scm (inherit-print-state): Moved definition to the - neighborhood of the record code. - -Mon Oct 27 02:05:49 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * boot-9.scm: Revert changes to this file from Oct 23. It turns - out to interact badly with the Emacs support and the Tcl/Tk - support. It's not a high enough priority at the moment to be - worth fixing. I'm leaving the other readline support in, though. - -Sat Oct 25 14:23:22 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * Makefile.am: Include readline.scm in the list of files to be - installed, so Guile can find it for interactive use. - * Makefile.in: Regenerated. - -Thu Oct 23 01:00:33 1997 Jim Blandy <jimb@totoro.red-bean.com> - - Add support for readline function. - * readline.scm: New module. - * boot-9.scm (repl-reader): New function. - (scm-style-repl): Call repl-reader, instead of doing the reading - ourselves. Remove repl-report-reset; it was never used for - anything. - (top-repl): If we've got the readline primitives, then redefine - repl-reader to use them. - If we've got the readline primitives, import the readline module. - - * ls.scm (ls, lls): Don't assume (eq? #f '()). - -Wed Oct 22 18:26:57 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * calling.scm, common-list.scm, ls.scm, q.scm, runq.scm, - string-fun.scm: Added copyright notices; reformatted. - -Thu Oct 9 05:44:00 1997 Gary Houston <ghouston@actrix.gen.nz> - - * expect.scm: (expect-regexec): new procedure, use it in - expect-strings to fix the => syntax under the new regex system. - (top): include regex module in define-module statement. - -Wed Oct 8 03:16:01 1997 Gary Houston <ghouston@actrix.gen.nz> - - * (error-catching-loop): new local variable "interactive". if - #f, abort terminates the process. - (set-batch-mode?!, batch-mode?): new closures, defined in - error-catching-loop. the names are from scsh. - -1997-10-06 Marius Vollmer <mvo@zagadka.ping.de> - - * boot-9.scm (inherit-print-state): If NEW-PORT contains a - print-state, throw it away. - -Fri Oct 3 12:00:00 Mikael Djurfeldt <mdj@nada.kth.se> - - * boot-9.scm (struct-layout): Use `vtable-index-layout' instead of - `0'. - -Thu Oct 2 12:00:00 Mikael Djurfeldt <mdj@nada.kth.se> - - * boot-9.scm (struct-printer, make-struct-printer, - set-struct-printer-in-vtable!, *struct-printer*): Removed. - (record-type-vtable, make-record-type): Don't use make-struct-printer. - (record-type-vtable): User fields "prpr" (printer is no longer a - user field). - (record-type-name, record-type-fields): Decreased slot index by - one; Use `vtable-offset-user'. - -Thu Oct 2 12:00:00 Marius Vollmer <mvo@zagadka.ping.de> - - * boot-9.scm (inherit-print-state): New experimental function. - -Tue Sep 30 13:12:48 1997 Jim Blandy <jimb@totoro.red-bean.com> - - Suggestion and script from Maciej Stachowiak: - * boot-9.scm: Split off modules into separate, autoloadable files. - This reduces startup time from 10.5s to 5.5s (user cpu). - * calling.scm, common-list.scm, ls.scm, q.scm, runq.scm, - string-fun.scm: New files, containing stuff that used to be in - boot-9.scm. - * Makefile.am (ice9_sources): List new files here, for - distribution and installation. - * Makefile.in: Regenerated. - -Mon Sep 29 23:53:55 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * Makefile.in: Regenerated with automake 1.2c. - -Mon Sep 29 03:21:24 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * slib.scm (slib:load): slib:load first tries to load the file - named NAME, then NAME.scm. On error, report the error occuring at - the first attempt (NAME) rather than the second (NAME.scm). - - * boot-9.scm: Bugfix: Hard-solder the print-option procedure into - the make-options macro so that we needn't refer to a global - symbol. - -Sun Sep 28 21:40:24 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * debug.scm: Moved options interface procedures to boot-9.scm. - - * boot-9.scm: Define options interface procedures here instead. - -Sat Sep 27 20:19:20 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * boot-9.scm (separate-fields-discarding-char, - separate-fields-after-char, separate-fields-before-char): Call - continuation function, RET, as advertised: with each separated - field a separate argument. - - * Makefile.in: Regenerated with automake 1.2a. - -Sat Sep 20 14:23:53 1997 Mikael Djurfeldt <mdj@kenneth> - - * slib.scm (slib:load): Export. - - * boot-9.scm (in-vicinity): Bugfix: Don't add "/" to an empty - vicinity; - Provide defmacro. - -Thu Sep 18 01:24:31 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * r4rs.scm (apply): Set name property to 'apply. - -Tue Sep 16 22:09:50 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * boot-9.scm (keyword->symbol, display-usage-report): Changed - length --> string-length. (Thanks to Aleksandar Bakic.) - (separate-fields-discarding-char, separate-fields-after-char, - separate-fields-before-char): Bugfix from Maciej Stachowiak - <mstachow@mit.edu>. Thanks! - (try-module-linked): Try to find module among those already - registered. - (try-module-dynamic-link): Removed the first test which - corresponds to a call to `try-module-linked'. - (resolve-module): Resolve modules in this order: 1. Already - registered modules (for example those which have been statically - linked), 2. Try to autoload an .scm-file, 3. Try to dynamically - link a .so-file. - -Mon Sep 15 23:39:54 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * boot-9.scm (iota): Renamed list-reverse! --> reverse! - -Thu Sep 11 02:31:38 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * session.scm (name): New procedure: Gives name of object. - (source): New procedure: Gives source of object. - -Wed Sep 10 20:12:45 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - -* * boot-9.scm (primitive-macro?): New procedure. - - * slib.scm: Added hack which transfers syntactic information from - the builtin variable `define' to the slib version if module (ice-9 - syncase) has been loaded. This is necessary to get correct - expansion inside the slib module. - - * psyntax.ss (build-let, build-named-let): New output - constructors. - (build-lexical-var): Seed gensym with symbolic name. - (self-evaluating?): Add keywords among self-evaluating types. - (let): New core form. - (if): Removed from core language. - (or, and, let, cond): Removed syntactic definitions. - (sc-expand3): New procedure: Expander which takes optional mode - and eval-syntactic-expanders-when arguments. - - * syncase.scm (psyncomp): New procedure: Recompiles psyntax.pp. - Should be used inside the (ice-9 syncase) module with (use-syntax - syncase) and with the current directory containing the psyntax.ss - source. - Added hack to transfer syntactic information from the builtin - variable `define' to the slib version if module (ice-9 slib) has - been loaded. - -Fri Sep 5 05:47:36 1997 Mikael Djurfeldt <mdj@faun.nada.kth.se> - - * syncase.scm (sc-interface, sc-expand): Removed hook setup. - (syncase): Publish syntax transformer to be used with - `use-syntax'. - (sc-macro): Use this as the value when publishing macros. - - * boot-9.scm (module-type): Added `transformer'. - (make-module): Modified initialization. - (module-transformer, set-module-transformer!): Selector and - mutator for module-associated transformer. - (set-current-module): Use module-transformer to set - `scm:eval-transformer'. - (module-use!): Previous change reverted. -* (use-syntax): New function: Install a transformer in current - module. - (sc-interface, sc-expand): Removed! :) - -Fri Sep 5 03:09:09 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * emacs.scm (emacs-load): Added new parameter `module'. - - * syncase.scm (putprop, getprop): Modified to use the object - properties of the variable object corresponding to the symbol; - This way we can ride on the mechanisms of the module system. - Changed `builtin-variable' calls to `define-public' calls. - Setup the hooks sc-expand and sc-interface. - - * boot-9.scm (sc-interface, sc-expand): New builtin variables. - (set-current-module): Switch to and from sc-expand as - scm:eval-transformer when going into and out of modules using - syncase macros. - (module-use!): Set scm:eval-transformer to sc-expand when adding - the syncase interface. - -Thu Sep 4 14:57:04 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * syncase.scm (putprop): Temporary fix which publishes new syntax - globally (the old behaviour was complex and connected to the inner - workings of the current module system). - -Wed Sep 3 21:29:13 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * psyntax.ss: Updated. - psyntax.pp: Bugfix: Previous version had some leading "t":s cut - off! - -Tue Sep 2 00:26:42 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * boot-9.scm (gensym): Removed (replaced by primitive). - (obarray-gensym): Rewritten to use `gensym'. - (gentemp): Rewritten to use `gensym'. - -Mon Sep 1 20:08:32 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * gtcl.scm (make-tcl-binder): Rewritten to choose bindings - according to the following priorities: - 1. tcl bindings which are present in override-scheme-list - 2. bindings from the-scm-module - 3. tcl bindings - This way the gtcl module can occur first in the use-list without - disabling the scheme interpreter. - (new-interpreter): New function. - - * gwish.scm: Moved initialization code for the-interpreter to - gtcl.scm; Moved name space cleaning code to gtcl.scm and rewrote - it; Call `new-interpreter'; Don't :use-module (guile). - -Thu Aug 28 23:48:53 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * Makefile.in: Regenerated. - -Wed Aug 27 11:35:09 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * Makefile.in: Regenerated, so it uses "tar", not "gtar". - -Mon Aug 25 22:00:44 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * emacs.scm (object->string, format, error-args->string): New - procedures. - (emacs-frame-eval): Reworked. - -Mon Aug 25 16:15:55 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * session.scm (apropos-internal): Musn't initialize symbol - accumulator with a constant pair. That led to mutation of the - source! - -Sun Aug 24 01:03:10 1997 Mikael Djurfeldt <mdj@kenneth> - - * session.scm (vector-for-each): Removed. - (apropos): vector-for-each --> array-for-each. - (apropos-internal): New function. Return list of accessible - symbols matching regexp. - - * debug.scm (frame-number->index): New function. Convert frame - number (as displayed in the backtrace) to frame index (to be used - in stack-ref). - - * emacs.scm (emacs-load): New arguments: interactivep: when - non-false, send back results to Emacs; colnum: Column number; - Use modules (ice-9 debug) and (ice-9 session); - (no-stack, no-source): New simple-actions; - (result-to-emacs): New procedure. Sends data to Emacs via the - result protocol; - (get-frame-source, emacs-select-frame, emacs-frame-eval, - emacs-symdoc): New procedures. - -Wed Aug 20 13:21:11 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * emacs.scm (emacs-load): Adjust stack narrowing. - (whitespace-chars): Include #\np. - - * syncase.scm: Also turn off debugging evaluator and recording of - procedure names during loading of psyntax.pp. - - * psyntax.pp: Removed leading blanks => 800K -> 100K. - -Tue Aug 19 02:39:41 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * syncase.scm: Don't tamper with debug mode setting when enabling - macros. Instead cut the stack with start-stack. - Load psyntax.pp with recording of positions turned off. - - * psyntax.pp, psyntax.ss (quasiquote): Changed fx= --> =. - -* * syncase.scm: New file: Guile-adaption for syntax-case macros. - psyntax.pp, psyntax.ss: Syntax-case macros, portable version 2 by - R. Kent Dybvig, Oscar Waddell, Bob Hieb and Carl Bruggeman - -Mon Aug 18 21:58:25 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - -* * session.scm: New file: Session support. - (apropos): New procedure: List bindings given regexp. - -Sat Aug 16 18:44:24 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm: define tms accessors: clock, utime, stime, cutime, - cstime. - -Thu Aug 14 19:55:37 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * emacs.scm (emacs-load): Something has changed in the reader so - that we now should set the port line count to the specified value - (linum) instead of (- linum 1). - - * slib.scm (slib:load): Use load-from-path instead of - primitive-load-path so that backtraces get narrowed properly at - the top. - - * boot-9.scm (top-repl): Save stack already in signal handler in - order to narrow it correctly. - (save-stack): Adjust narrowing tag for the top of load-stacks. - -Tue Jul 29 01:18:08 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (move->fdes, dup->port): use dup->fdes, not primitive-dup. - (dup->fdes): deleted, now done in C. - -Sat Jul 26 08:00:42 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (setenv): new procedure, scsh compatible. - -Sat Jul 26 21:30:10 1997 Marius Vollmer <mvo@zagadka.ping.de> - - * boot-9.scm (with-fluids): New macro to go with the - builtin `with-fluids*'. - -Thu Jul 24 04:28:11 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * slib.scm (install-require-module): In newer versions of slib - *catalog* is #f until the first access. Therefore we call - require:provided? for a random feature if *catalog* is #f. - -Wed Jul 23 20:13:04 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * boot-9.scm: If using emacs interface, enable backtraces - automatically. - -Mon Jul 21 06:45:45 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (dup->port, dup->inport, dup->outport, dup->fdes, - dup, fdes->inport, fdes->outport, port->fdes): new procedures. - (duplicate-port): was a C primitive, now it's here. - (move->fdes): allow the first argument to be a file descriptor. - Return the modified port or file descriptor (was unspecified.) - -Fri Jul 11 00:13:43 1997 Jim Blandy <jimb@floss.red-bean.com> - - Changes to compile under gnu-win32, from Marcus Daniels: - * boot-9.scm (load-user-init): If HOME is unset, provide - a default of /. - - * boot-9.scm (define-public): Changed to accomodate Hobbit. - -Tue Jun 24 00:31:47 1997 Jim Blandy <jimb@floss.red-bean.com> - - * boot-9.scm, debug.scm, hcons.scm, lineio.scm, mapping.scm, - poe.scm, slib.scm, tags.scm, threads.scm: Use normal list - notation, instead of #/ notation. - - * expect.scm (expect-strings): Pass regexp/newline flag to - make-regexp. - -Mon Jun 23 16:13:38 1997 Jim Blandy <jimb@floss.red-bean.com> - - Fix inconsistencies in parsing of #/ style lists. - * boot-9.scm (read-path-list-notation): New function. - (parse-path-symbol): Deleted. Replaced by above. - Plug in read-path-list-notation as the parser for #/ lists, - instead of the anonymous lambda form calling parse-path-symbol. - (Thanks to Maurizio Vitale.) - - * boot-9.scm (make-list): Remove the definition of this function - from the (ice-9 common-list) module; make the `init' argument - optional in the scm module's definition, to match the deleted - definition. Harmony reigneth? (Thanks to Bernard URBAN.) - -Sun Jun 22 18:33:17 1997 Jim Blandy <jimb@floss.red-bean.com> - - Try to detect when people are using one version of libguile and a - different version of ice-9. People have been skewing things and - sending in bug reports. - * version.scm.in: New file, which the configure script munges to - produce version.scm, which contains the ice-9 config stamp. - * boot-9.scm: Compare the libguile and ice-9 config stamps; - display a warning if the two are different. - * Makefile.am: Install version.scm, but don't distribute it. - Distribute version.scm.in, but don't install it. - * Makefile.in: Regenerated. - -Thu Jun 19 21:01:16 1997 Jim Blandy <jimb@floss.red-bean.com> - - * slib.scm (slib:warn): Alias for WARN function. - -Fri Jun 13 00:32:04 1997 Jim Blandy <jimb@floss.red-bean.com> - - * boot-9.scm (struct-printer): Fix off-by-one error in range - check. Correctly check for struct printer tag. - - * expect.scm: Turn this into a module, (ice-9 expect). - (expect-port, expect-timeout, expect-timeout-proc, - expect-eof-proc, expect-char-proc, expect, expect-strings, - expect-select): Make these public definitions. - (expect-strings): Use make-regexp and regexp-exec, instead of - regcomp and regexec. We've omitted the REG_NEWLINE flag; hope - that's okay. - - * boot-9.scm (with-regexp-parts): Comment this out. It has no - users in the core, and relies on mildly hairy details of the old - regexp interface. - - * test.scm: Re-enable tests asserting that '() is true, and not a - boolean. This stuff has been true for a while. - - * boot-9.scm (ipow-by-squaring, butlast): Fix uses of outdated - function names. - - * boot-9.scm (with-excursion-getter-and-setter, q-rear): Doc - fixes. - -Wed Jun 11 00:31:40 1997 Jim Blandy <jimb@floss.red-bean.com> - - * Makefile.in: Regenerated after xtra_PLUGIN_guile_libs change in - ../configure.in. - -Fri Jun 6 14:37:18 1997 Marius Vollmer <mvo@zagadka.ping.de> - - * boot-9.scm (struct-printer): Bugfix: Check the layout of the - vtable and not the one of the struct. - -Wed Jun 4 23:27:16 1997 Marius Vollmer <mvo@zagadka.ping.de> - - * boot-9.scm (struct-layout, %struct-printer-tag, struct-printer, - make-struct-printer, set-struct-printer-in-vtable!): New bindings - to support printing of structures. - (record-type-vtable, make-record-type): Add slot to hold printing - function and initialize it with something appropriate. Removed - commented out printing code. - (record-type-name, record-type-fields): Adjusted slot offsets. - (%print-module): Reduce argument list to "mod" and "port". - -Tue Jun 3 17:04:18 1997 Jim Blandy <jimb@totoro.cyclic.com> - - * slib.scm (identity): New function, used by SLIB. - -Sat May 31 18:57:12 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm: signal-handler, alarm-thunk: removed. - don't define ticks-interrupt etc. - top-repl: install signal handlers for SIGINT, SIGFPE, SIGSEGV, SIGBUS - during call to scm-style-repl. - -Fri May 30 18:08:10 1997 Jim Blandy <jimb@floss.cyclic.com> - - * slib.scm (slib:load): Use primitive-load-path instead of - basic-load. This is probably wrong, but hopefully the entire - source access system will be revised soon anyway, and this will - make require behave more like Emacs Lisp's require. If this - breaks something, please let me know. Maybe this is real dumb. - -Thu May 29 02:36:48 1997 Jim Blandy <jimb@floss.cyclic.com> - - * regex.scm: Add a module declaration. Use DEFINE-PUBLIC everywhere. - * boot-9.scm: If the `regex' feature is present, use the module - (ice-9 regex). - -Tue May 27 22:48:14 1997 Tim Pierce <twp@twp.tezcat.com> - - * regex.scm: New file. - * Makefile.am (subpkgdata_DATA): Add regex.scm. - * Makefile.in: Regenerated. - -Mon May 26 17:24:48 1997 Jim Blandy <jimb@totoro.cyclic.com> - - * COPYING, boot-9.scm, debug.scm, emacs.scm, expect.scm, gtcl.scm, - gwish.scm, hcons.scm, lineio.scm, mapping.scm, nonblocking.scm, - oldprint.scm, poe.scm, r4rs.scm, source.scm, tags.scm, test.scm, - threads.scm: New address for FSF. - -Fri May 16 04:09:45 1997 Jim Blandy <jimb@floss.cyclic.com> - - * debug.scm: Update copyright years; this file has been worked on - in 1997. - -Thu May 15 07:56:08 1997 Gary Houston <ghouston@actrix.gen.nz> - - * expect.scm: use gettimeofday instead of get-internal-real-time - and use a floating point timeout when calling select. Untested, - since the regex library is currently AWOL. - -Wed May 14 21:00:30 1997 Jim Blandy <jimb@floss.cyclic.com> - - * boot-9.scm (eval-string): Function deleted; it was already - implemented in C, so there's no point in making a divergable copy - here. - -Tue May 13 16:40:06 1997 Jim Blandy <jimb@floss.cyclic.com> - - * Makefile.in: Regenerated, using automake-1.1p. - -Tue May 13 16:40:06 1997 Jim Blandy <jimb@floss.cyclic.com> - - * Makefile.in: Regenerated, using automake-1.1p. - -Tue May 13 02:48:49 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (error-catching-loop): don't read a line from - current input when quit is encountered, the previous change - fixes this too. - -Mon May 12 19:00:21 1997 Jim Blandy <jimb@floss.cyclic.com> - - * boot-9.scm (scm-style-repl): After reading an expression, - consume any trailing newline (perhaps preceded by whitespace), to - avoid screwing up GDB. More detail in comments. - -Mon May 5 13:18:38 1997 Jim Blandy <jimb@floss.cyclic.com> - - * Makefile.am (ETAGS_ARGS): New variable, since we're not treating - the Scheme code like code yet. - * Makefile.in: Resrac,husrched. - -Wed Apr 30 15:25:15 1997 Marius Vollmer <mvo@zagadka.ping.de> - - * boot-9.scm (link-dynamic-module): Do not catch errors from - dynamic-link and dynamic-call. When the shared library exists it - is now assumed to be suitable for a dynamic C module. - -Fri Apr 25 21:21:35 1997 Marius Vollmer <mvo@zagadka.ping.de> - - * boot-9.scm (process-use-modules): New function to support the - use-modules macro - (use-modules): throw an error iff one of the requested modules - can't be found. - -Tue Apr 29 06:54:46 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm: don't define timer-thunk or gc-thunk. - -Sun Apr 27 17:56:09 1997 Jim Blandy <jimb@floss.cyclic.com> - - * aclocal.m4: Removed; unnecessary, given changes of Apr 24. - - * Makefile.am (subpkgdatadir): Use "ice-9" instead of "@module@"; - we're not using AM_INIT_GUILE_MODULE any more. - * Makefile.in: Regeneratitetedrerd. - -Thu Apr 24 01:33:33 1997 Jim Blandy <jimb@floss.cyclic.com> - - Get 'make dist' to work again. - * Makefile.am (EXTRA_DIST): Remove PLUGIN files. - * Makefile.in: Regenerated, like two tons of fleas. - - Changes for reduced Guile distribution: one configure script, - no plugins. - * configure.in, configure: Removed. - * Makefile.in: Regenerated. - -Sat Apr 19 08:03:50 1997 Jim Blandy <jimb@floss.cyclic.com> - - * boot-9.scm (eval-string, command-line, load-user-init): New - functions. - -Sat Apr 12 08:27:05 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (log10): defined. - -Tue Apr 1 17:46:49 1997 Gary Houston <ghouston@actrix.gen.nz> - - * expect.scm (expect-select): correct the millisecond timeout - arithmetic (from Marko.Kohtala@ntc.nokia.com). - -Mon Mar 31 03:23:19 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (open-input-pipe, open-output-pipe): defined here - instead of in libguile. - (tm:sec etc.) new accessors for broken-down time. - (set-tm:sec etc.) new setters for broken-down time. - -Thu Mar 27 05:06:00 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (netent:addrtype, servent:port): added missing - procedures. - (netent:net, servent:proto): repaired. - (utsname:sysname etc.): new accessors for uname. - -Tue Mar 25 03:04:03 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (sockaddr:fam, sockaddr:path, sockaddr:addr, - sockaddr:port): new functions. - -Wed Mar 19 04:50:34 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm: define accessor procedures for the objects returned - by getpw, getgr, gethost, getnet, getproto, getserv (e.g., - passwd:name, where the first component is the name of the C structure - and the second is the unprefixed C member name.) - -Tue Mar 18 18:39:31 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (setpwent, setgrent, sethostent, setnetent, setprotoent, - setservent): no longer take an argument, it was bogus. - -Thu Mar 13 00:13:41 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (scm-error): deleted, reimplemented in C. - -Mon Mar 10 15:48:31 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * boot-9.scm (process-define-module): Modified to handle both - keywords and symbols. - -Sat Mar 8 04:32:44 1997 Gary Houston <ghouston@actrix.gen.nz> - - * slib.scm: update read usage. - - * r4rs.scm: update primitive-load usage. - Don't define read-sharp. - - * boot-9.scm: use read-hash-extend to install extra read syntax. - (read-sharp): removed. - Adjust usage of primitive-load-path, read, which no longer take - case_i or read-sharp arguments. - -Sat Mar 8 00:07:54 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * boot-9.scm: Added loading of session support module. - - * debug.scm: Removed `display-application'. (Replaced by - primitive procedure.) - - * boot-9.scm (beautify-user-module!): Don't add the root module - interface to the end of the use-list of the root module. - -Thu Mar 6 07:26:34 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm: repl-quit, repl-abort: obsolete variables deleted. - -Wed Mar 5 20:30:24 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm: check use-emacs-interface for emacs support. - -Sun Mar 2 19:47:14 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (scm-style-repl): call repl-report-start-timing if - read gets EOF. - * (exit): alias for quit. - -Sun Mar 2 05:25:11 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (error-catching-loop thunk): use a status variable to - return the quit args. - (scm-style-repl): call -quit, passing return value from - error-catching-repl. Make -quit return its args. - stand-alone-repl: comment out, since it seems unused. - - (error-catching-loop thunk): discard trailing junk after a (quit). - -Sat Mar 1 15:24:39 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * boot-9.scm: Removed the old printer code. - - * r4rs.scm (apply, call-with-current-continuation): Added comment - explaining why apply and call/cc need to be closures. - - * boot-9.scm (apply, call-with-current-continuation): Bugfix: - Removed. These definitions are already present in r4rs.scm. - - * debug.scm (trace-entry, trace-exit): Check that we're on a repl - stack before printing traced frames; Re-enable trace flag at end - of handlers. - -Sat Mar 1 00:10:38 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * debug.scm: Add hook for reset of trace level at abort. - - * boot-9.scm (run-hooks): New procedure. - (add-hooks!): New macro. - Change hooks to use these functions. - - * debug.scm: *Warning* This feature is a bit premature. I add - it anyway because 1. it is very useful, and, 2. you can start - making it less premature by complaining to me and by modifying - the source! :-) - (trace): Given one or more procedure objects, trace each one. - Given no arguments, show all traced procedures. - (untrace): Given one or more procedure objects, untrace each one. - Given no arguments, untrace all traced procedures. The tracing in - Guile have an advantage to most other systems: We don't create new - procedure objects, but mark the procedure objects themselves. - This means that also anonymous and internal procedures can be - traced. - - * boot-9.scm (error-catching-loop): Added handling of apply-frame - and exit-frame exceptions. - - * boot-9.scm (assert-repl-prompt, the-prompt-string): Removed. - (set-repl-prompt!): Setter for repl prompt. - (scm-style-repl): If prompt is #f, don't prompt; if prompt is a - string, display it; if prompt is a thunk, call it and display its - result; otherwise display "> ". - (Change suggested by Roland Orre <orre@nada.kth.se>.) - - * r4rs.scm (%load-verbosely): Reverted change to - `module-defined?', since the module system isn't bootstrapped when - we load r4rs.scm. This is just a temporary fix to make the - repository version runnable. - -Thu Feb 27 23:25:47 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * boot-9.scm: Removed the enabling of debug evaluator and - recording of source code positions. This was placed there for our - convenience, but it has already sneaked into the distribution - once... so we'd better add this in our local copies instead when - we need it. (These options are normally enabled at the end of - boot-9.scm when loading the debug module.) - -Thu Feb 27 16:04:45 1997 Marius Vollmer <mvo@zagadka.ping.de> - - * boot-9.scm (module-defined?): New function. - (macroexpand-1, macroexpand): Use local-ref instead of defined? - and eval. - * r4rs.scm (%load-verbosely): Use "module-defined?" instead of - "defined?". - * slib.scm (defined?): New function to take the place of the - builtin "defined?". It allways examines the slib module. - -Mon Feb 24 21:46:15 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * configure.in: Added AM_MAINTAINER_MODE - -Sat Feb 15 04:51:20 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (read-sharp): define directly, don't go through a - %read-sharp layer. - -Tue Feb 11 08:45:48 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (uniform-vector-set!): use uniform-array-set1!, not - uniform-vector-set1! which doesn't exist. - -Mon Feb 10 03:01:48 1997 Mikael Djurfeldt <mdj@kenneth> - - * boot-9.scm (backtrace): Removed. (A C version now exists in - backtrace.c.) - -Fri Jan 24 06:05:36 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (read-line!, read-delimited!, read-delimited, - read-line): new procedures, see libguile/ChangeLog. - -Thu Jan 16 17:07:03 1997 Marius Vollmer <mvo@zagadka.ping.de> - - Added dynamic linking of modules. See libguile/DYNAMIC-LINKING. - - * boot-9.scm (split-c-module-name, convert-c-registered-modules, - init-dynamic-module, dynamic-maybe-call, - find-and-link-dynamic-module, link-dynamic-module, - try-module-dynamic-link, registered-modules): New definitions for - dynamic linking of modules. - (resolve-module): Try to dynamically link the requested module - after failing to load it as Scheme code. - -Wed Jan 8 05:50:14 1997 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (getservbyport, getservbyname): remove stray %. - -Tue Jan 7 20:02:24 1997 Jim Blandy <jimb@floss.cyclic.com> - - * boot-9.scm (and=>): Rename THUNK argument to PROCEDURE, 'cos - that's what it is. - - * lineio.scm (make-line-buffering-input-port): Properly test for - the case of an empty buffer list. The old code assumed that '() - was false. - -Mon Jan 6 01:13:53 1997 Mikael Djurfeldt <mdj@kenneth> - - * boot-9.scm (use-modules): New macro (from Marius Vollmer). - (use-modules <module name> ...) Put the the modules named by - <module name> ... on the use list of the current module. - -Sun Jan 5 15:52:59 1997 Jim Blandy <jimb@floss.cyclic.com> - - * boot-9.scm (error-catching-loop): Remove message saying that - typing "$" will put you in the debugger. This isn't implemented - yet. - -Sun Dec 22 23:27:25 1996 Jim Blandy <jimb@floss.cyclic.com> - - * boot-9.scm (delq-all!): Function deleted; delq!'s semantics have - been fixed, so this function is superfluous. - (transform-usage-lambda): Use delq!, not delq-all!. - -Tue Dec 17 20:36:45 1996 Marius Vollmer <mvo@zagadka.ping.de> - - * boot-9.scm (resolve-module): New optional parameter that - controls whether autoloading is attempted or not. Default is #t. - (process-define-module): Don't autoload the defined module. - (try-module-autoload): Don't autoload the directory modules. - - * boot-9.scm (process-define-module): Ensure that the-scm-module - is last in the `uses' list to allow shadowing builtin - bindings. All :use-module options are added in the order they - appear in the arguments but before anything already on the list - (such as the-scm-module). - -Wed Dec 11 21:06:05 1996 Gary Houston <ghouston@actrix.gen.nz> - - * slib.scm (slib-parent-dir): throw error if #f returned from - %search-load-path. - -Sat Nov 30 23:57:28 1996 Tom Tromey <tromey@cygnus.com> - - * PLUGIN/greet, PLUGIN/split.sed, PLUGIN/this.configure: Removed. - * Makefile.am, aclocal.m4: New files. - * configure.in: Updated for Automake. - -Wed Nov 27 14:16:14 1996 Marius Vollmer <mvo@zagadka.ping.de> - - * boot-9.scm (macroexpand-1, macroexpand), slib.scm - (slib:features), r4rs.scm (%load-verbosely): "defined?" is now a - function, use it accordingly. - -Thu Nov 21 11:12:10 1996 Jim Blandy <jimb@floss.cyclic.com> - - It's an "eval closure", not an "eval thunk." A thunk is a - function of no arguments. - * boot-9.scm (module-type): Rename module field. - (make-module, eval-in-module, make-root-module, - set-current-module): Uses changed. - (module-eval-closure, set-module-eval-closure!, - root-module-closure): Renamed from module-eval-thunk, - set-module-eval-thunk!, root-module-thunk. - (set-current-module): Change uses of *top-level-lookup-thunk* to - *top-level-eval-closure*. - -Wed Nov 20 14:45:27 1996 Jim Blandy <jimb@totoro.cyclic.com> - - * slib.scm (slib-parent-dir): Use string-length, not length. - (Thanks to Bernard Urban.) - -Sat Nov 2 20:00:42 1996 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * boot-9.scm: The debugging evaluator and recording of positions - aren't enabled by default any longer (they are switched on in - debug.scm). But during development we want to have them also - *inside* boot-9.scm. Therefore, two lines are added at the - beginning of boot-9.scm to enable these. - - Call `provide' so that `records' are included among the - `*features*'. - - The scheme for saving the stack has been adjusted: save-stack is - now commonly available for saving the stack. Calling `save-stack' - sets a flag `stack-saved?' which prevents overwriting the stack. - `stack-saved?' is reset at `abort'. - - Spelling correction: seperate --> separate. - - Removed `:'s that had creeped into some comments. - - The repl now doesn't print #<unspecified> results any longer - If the user wants to see this, he can do - (assert-repl-print-unspecified #t) in his startup file. - - The user now gets a friendly message instead of a backtrace at - error. - - Added `before-read-hook'. - - Load module (ice-9 emacs) if option `-e' was specified. - - (provide): New function. - - (error): Save stack at entry, so that Guile entrails won't show up - in backtraces. - - (backtrace): New function. - - (save-stack): Can now take arbitrary number of stack narrowing - specifier pairs. The first specifier in a pair controls inner - border, the second the outer border. A number means cut that - number of frames, a procedure object means cut until that object - is found in operator position in a frame. - - * debug.scm: Enable debugging evaluator and recording of positions - by default. - - * slib.scm (slib:load): Adapt to the new behavior of - primitive-load: It doesn't any longer try both with and without - ".scm" extension. (We don't want to use %search-load-path here.) - - (implementation-vicinity): New function. slib requires it - - (library-vicinity): Updated. - - Load "require.scm" in the library-vicinity. - - (install-require-vicinity, install-require-module): New functions. - -Mon Oct 28 17:56:29 1996 Jim Blandy <jimb@floss.cyclic.com> - - * boot-9.scm (load-from-path): New function. - - * boot-9.scm (try-load, basic-try-load, try-load-module, - try-load): Deleted. I don't think they're being used. - - * Makefile.in (scm_files): Add r4rs.scm and test.scm to this list, - so they'll get distributed. - - Get Guile to be a little less chatty by default. The new user - should see as little clutter as possible. - * r4rs.scm (%load-verbosely): Make this #f by default. - * boot-9.scm (scm-repl-verbose): Make this #f by default. - (scm-style-repl): Don't run 'pk' on the value passed to quit. - - * r4rs.scm: New file. - * boot-9.scm: Load r4rs.scm, first thing. - (OPEN_READ, OPEN_WRITE, OPEN_BOTH, *null-device*, open-input-file, - open-output-file, open-io-file, close-input-port, - close-output-port, close-io-port, call-with-input-file, - call-with-output-file, with-input-from-port, with-output-to-port, - with-error-to-port, with-input-from-file, with-output-to-file, - with-error-to-file, with-input-from-string, with-output-to-string, - with-error-to-string, the-eof-object): Definitions moved to - r4rs.scm. Not all of them are R4RS, but those that are use those - that are not. - (load, %load-verbosely, %load-announce): Moved, along with code to - set %load-hook, to r4rs.scm. - - * test.scm: New file. - - * boot-9.scm (integer?): Definition deleted, in favor of the one - present in libguile (which used to be called int?). I have no - idea why integer? didn't just call int? to begin with. - - * boot-9.scm (<, <=, =, >, >=): Definitions in terms of <?, <=?, - =?, >?, and >=? deleted; they're defined that way by libguile now. - - * boot-9.scm (load): Simplified; primitive-load does most of this - work now. - (%load-announce-win): Removed; no longer used. Set %load-hook to - call %load-announce. - -Sun Oct 27 07:47:03 1996 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (stat:dev, stat:ino, stat:mode, stat:nlink, stat:uid, - stat:gid, stat:rdev, stat:size, stat:atime, stat:mtime, - stat:ctime, stat:blksize, stat:blocks) accessor functions for stat - components. - (file-is-directory?): use stat:type. - -Fri Oct 25 03:34:47 1996 Jim Blandy <jimb@floss.cyclic.com> - - * boot-9.scm (%read-sharp): Don't recognize the `#!' syntax here; - that's now taken care of in libguile, and in a way compatible with - SCSH (which this isn't). - -Mon Oct 21 18:52:36 1996 Jim Blandy <jimb@totoro.cyclic.com> - - * boot-9.scm: Formatting tweaks. - -Fri Oct 18 01:03:08 1996 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * boot-9.scm (handle-system-error): Added hooks before-error-hook, - after-error-hook, before-backtrace-hook and after-backtrace-hook - to the error handler. E.g.: fancy emacs support could plug into - these. - (save-stack): New function. The stack is now made differently - depending on the stack id. (The motivation is to make a better - choice regarding what stack frames to present to the user.) - (error-catching-loop): Stack handling code moved outside into - save-stack. - -Thu Oct 17 20:33:08 1996 Gary Houston <ghouston@actrix.gen.nz> - - * Makefile.in (scm_files): add expect.scm. - - * expect.scm: new file ported from guile-iii. - - * boot-9.scm: remove handle-system-error, after moving the code into - error-catching-loop. - Don't set 'throw-handler-default property on error keys. - Just interpret (almost) any throw with 4 args as an error throw. - Delete some try-load stuff that was already commented out. - - Second thoughts, keep handle-system-error but call it from - error-catching-loop. - -Tue Oct 15 17:07:20 1996 Jim Blandy <jimb@floss.cyclic.com> - - * boot-9.scm: Doc fixes. - (make-module): Rework for readability. - (make-root-module, make-scm-module): USES argument to make-module - should be '(), not #f. - - * boot-9.scm (try-load): %sys-load-path has been renamed to - primitive-load-path; adjust call here. - -Tue Oct 15 14:25:01 1996 Mikael Djurfeldt <mdj@woody.nada.kth.se> - - * boot-9.scm (signal-handler): Bugfix: Moved the recording of - the stack to the correct place: when it is decided to generate an - error-signal. - -Mon Oct 14 22:20:30 1996 Mikael Djurfeldt <mdj@woody.nada.kth.se> - - * boot-9.scm (error-catching-loop, signal-handler, - handle-system-error): Backtracing now works for signals aswell; - Backtracing mechanism can now identify the stack root created by - start-stack so that the user isn't exposed to system stack frames. - -Mon Oct 14 06:05:42 1996 Mikael Djurfeldt <mdj@woody.nada.kth.se> - - * Makefile.in: Added threads.scm. - -Mon Oct 14 04:21:51 1996 Mikael Djurfeldt <mdj@woody.nada.kth.se> - - * debug.scm (make-enable, make-disable): Simplified. - - * boot-9.scm: Renamed %%throw-handler-default --> - throw-handler-default. - ((handle-system-error key . arg-list)): Changed the way errors are - reported. - ((scm-style-repl)): Wrap up the call to eval in a start-stack - acro. - ((error-catching-loop thunk)): Introduce a lazy-catch into - error-catching-loop so that the stack can be captured. - -Thu Oct 10 22:27:32 1996 Jim Blandy <jimb@totoro.cyclic.com> - - * mapping.scm (hash-table-mapping): Explicitly request that - make-vector fill new vectors with '(); this will make it easier to - port Guile Scheme code to other Schemes. - * boot-9.scm (make-print-style, make-print-table): Same. - -Sun Oct 6 03:54:59 1996 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (load): rewritten again. - Append "." to the default %load-path. - (feature?): new function: checks for a symbol in the features list. - (module-local-variable): remove apparently useless (caddr (list m v - ...)) - (%load-announce): minor formatting change. - (file-exists?): use access? if posix is featured. - (file-is-directory?): use stat if i/o-extensions is featured. - (try-module-autoload module-name): use file-exists? before - file-is-directory? - -Sat Oct 5 18:54:03 1996 Mikael Djurfeldt <mdj@kenneth> - - * boot-9.scm: Added conditional loading of threads.scm. - - * threads.scm: New file. Modified from the Cygnus-r0.3 - distribution. - - * boot-9.scm (error-catching-loop): Added handling of key - `switch-repl'. - - * boot-9.scm: Name change %%bad-throw --> bad-throw. - -Wed Oct 2 23:38:44 1996 Jim Blandy <jimb@totoro.cyclic.com> - - * boot-9.scm (make-record-type, record-constructor): Don't assume - the empty list is false when parsing the argument list. - -Mon Sep 30 22:15:50 1996 Jim Blandy <jimb@totoro.cyclic.com> - - * boot-9.scm (signal-handler): Clean up logic. - - * boot-9.scm (load): Assume %load-path is always bound. - -Sat Sep 28 00:15:37 1996 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (error): replace another throw with scm-error. Throw - to 'misc-error instead of 'error (no need to distinguish these.) - Don't set up 'error as a key. - Set up regex-error as a key, if regex is available. - (signal-handler): use scm-error, not throw. - - (%try-load, try-load-with-path, %load, load-with-path, - basic-try-load-with-path, basic-load-with-path, - try-load-module-with-path,load-module-with-path): deleted, since - they seem redundant. - (try-load): define using %try-load, not try-load-with-path. - (load): rewritten. load tries to open the file directly and - with a .scm extension before searching the library directories - (should "." be added to %load-path? then load could still open - directly files starting with "/"). - (try-module-autoload): use load, not load-with-path. - (%load-indent): deleted, -2 was causing errors. - - (%read-sharp): use port-line, not line-number. - -Fri Sep 27 16:23:51 1996 Jim Blandy <jimb@totoro.cyclic.com> - - * boot-9.scm (%%bad-throw): Delete definition. 1) It's very - straightforward to provide the equivalent functionality using - (catch #t ...), so there's no need for the extra complexity. 2) - Outside the context of a read-eval-print loop (which Guile should - not require) it's not clear we should do anything more complicated - than print an error and exit; the user or REPL can establish - something better if it wants. 3) In that case, it's much more - robust to just do it in the C code. - -Tue Sep 24 06:53:04 1996 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (%try-load): define using primitive-load. Previously - %try-load itself was the primitive. - (load-with-path): use scm-error instead of %load-announce-lossage. - Errors are thrown to 'misc-error instead of 'could-not-load. - (%load-announce-lossage): deleted. - -Mon Sep 23 00:16:31 1996 Mikael Djurfeldt <mdj@kenneth> - - * boot-9.scm (warn, scm-style-repl): Use C printer instead of `print'. - (make-record-type type-name fields): Temporarily remove support - for printing of records (not possible yet with C printer). - -Fri Sep 20 00:24:27 1996 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (file-exists?, file-is-directory): catch only - system-error, not every kind of error. - (scm-error): new procedure. - -Thu Sep 19 16:02:46 1996 Jim Blandy <jimb@totoro.cyclic.com> - - * boot-9.scm: Formatting tweaks. - -Wed Sep 18 09:07:37 1996 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (%%handle-system-error key): remove the code for - SCM-style errors. handle the case that an unexpected number - of args are supplied. - (%%system-errors): removed. - (error): redefine using a throw with key and 4 args. - ('error): associate 'error, 'error-signal keys with - %%handle-system-error. - (%%default-error-handler): removed. - (signal-handler): throw with 4 args and use the error-signal key. - Create an error message instead of using numerical codes. - (%%bad-throw): call error instead of throw if key not found. - -Tue Sep 17 04:11:28 1996 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm: initialize new error keys (see libguile/ChangeLog). - (%%handle-system-error key): check subr is not #f before printing. - Recognize %s (embed an argument using "display") and - %S (embed an argument using "write"). - -Sun Sep 15 03:55:35 1996 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (%%handle-system-error key): set args and rest to - the empty list if they are #f. - Initialize out-of-range as an error key. - -Sat Sep 14 03:41:15 1996 Gary Houston <ghouston@actrix.gen.nz> - - * PLUGIN/REQ: remove the "ice-9 lgh" line which causes a cycle. - - * boot-9.scm: remove leading %% from references to '%%system-error. - (%%handle-system-error): don't pass all the thrown arguments when - aborting, just the key and subr. - Remove the code to "Install default handlers for built-in errors." - Remove the definition of the syserror procedure. - Associate 'numerical-overflow with default handler. - -Fri Sep 13 04:58:11 1996 Mikael Djurfeldt <mdj@woody.nada.kth.se> - - * boot-9.scm: Name change: value-ref --> local-ref - resolved-ref --> nested-ref Motivation: conformance to the other - dictionary operators: list-ref operates on list, vector-ref - operates on vector, nested-ref operates on nested namespace, - local-ref operates on the local nested namespace. - -Sat Sep 7 06:44:47 1996 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (%%handle-system-error): recognise errors thrown - by lgh-error (fill-message etc.) - (fill-message): check first whether args is null. - (fill-message): bug fix and check that args is a list. - -Thu Sep 5 11:33:41 1996 Jim Blandy <jimb@floss.cyclic.com> - - * boot-9.scm: %load-path is initialized in C code now. - (implementation-vicinity, parse-path): Deleted, along with code to - initialize %load-path. - - * boot-9.scm (in-vicinity): If the vicinity doesn't end with a - "/", use one to separate it from the file. - -Thu Aug 29 23:05:11 1996 Thomas Morgan <tmorgan@gnu.ai.mit.edu> - - * boot-9.scm (%load-path): Add the site directory. - Add the directory named after the version number. - Prepend the version number to the other directories in the path. - Simplify by mapping the common prefix onto each item. - * Makefile.in (datadir, pkgdatadir, pkgverdatadir, subpkgdatadir, - sitedatadir): New definitions. - (libparent, libdir, install_path): Replaced by above. - (install): Create the above directories. - Put the source files into subpkgdatadir. - (uninstall): Remove the above directories. - -Thu Aug 29 21:48:47 1996 Jim Blandy <jimb@floss.cyclic.com> - - Don't use the PLUGIN system to gather information for the - Makefile's distribution and installation targets; just put it all - in the Makefile directly. - * PLUGIN/this.configure (scm_files, aux_files): Remove sections - for these. - * configure.in: Remove code that gets and substitutes scm_files and - aux_files. - * Makefile.in (scm_files, aux_files): Write out the list of files - here, where people expect to find them. - -Fri Aug 23 06:44:36 1996 Mikael Djurfeldt <mdj@woody.nada.kth.se> - - * boot-9.scm: Preliminary solution: optionally load the debug - module. Changed "gls" to "guile1.0b3". - - * debug.scm: New file: debug extensions. - -Wed Aug 21 13:06:56 1996 Mikael Djurfeldt <mdj@woody.nada.kth.se> - - * boot-9.scm (print-vector): Renamed weak-hash-table? --> - weak-key-hash-table?. (Again!) - -Tue Aug 20 07:31:39 1996 Mikael Djurfeldt <mdj@woody.nada.kth.se> - - * boot-9.scm (print-vector, macro-table, xformer-table): - Renamed weak-hash-table --> weak-key-hash-table. - - * poe.scm (funcq-memo): Renamed weak-hash-table --> - weak-key-hash-table. - -Sat Aug 3 06:16:35 1996 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (*null-device*): global constant from goonix. - (move->fdes): adjusted for boolean primitive-move->fdes. return - the modified port, always set revealed count to 1 (SCSH compatible). - (release-port-handle port): from goonix (SCSH compatible). - (%open-file): removed. - (open-input-file, open-output-file, file-exists?, file-is-directory?): - modified for open-file change (does not return #f). - -Thu Aug 1 02:52:42 1996 Jim Blandy <jimb@totoro.cyclic.com> - - * Makefile.in (dist-dir): New target for new dist system. - (manifest): Deleted. - * PLUGIN/this.configure (aux_files): Removed PLUGIN; it's a - directory, and needs special treatment in the dist-dir target. - -Thu Aug 1 09:00:21 1996 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm: remove the wrappers for '%' system primitives, - now that they throw errors directly. - remove make-simple-wrapper and similar functions. - protect a call to getenv which may now throw an exception. - -Wed Jul 31 23:44:42 1996 Gary Houston <ghouston@actrix.gen.nz> - - * boot-9.scm (false-if-exception): new macro. - -Fri Apr 19 13:53:08 1996 Tom Lord <lord@beehive> - - * The more things change... - - diff --git a/ice-9/Makefile.am b/ice-9/Makefile.am deleted file mode 100644 index 5400f97d0..000000000 --- a/ice-9/Makefile.am +++ /dev/null @@ -1,19 +0,0 @@ -## Process this file with automake to produce Makefile.in. - -AUTOMAKE_OPTIONS = foreign - -# These should be installed and distributed. -ice9_sources = boot-9.scm calling.scm common-list.scm debug.scm \ -emacs.scm expect.scm hcons.scm lineio.scm ls.scm mapping.scm poe.scm \ -q.scm readline.scm regex.scm runq.scm slib.scm string-fun.scm tags.scm \ -threads.scm r4rs.scm session.scm syncase.scm psyntax.pp psyntax.ss - -# These should be installed, but not distributed. -ice9_generated = version.scm - -subpkgdatadir = $(pkgdatadir)/$(VERSION)/ice-9 -subpkgdata_DATA = $(ice9_sources) $(ice9_generated) -ETAGS_ARGS = $(subpkgdata_DATA) - -## test.scm is not currently installed. -EXTRA_DIST = $(ice9_sources) test.scm version.scm.in diff --git a/ice-9/Makefile.in b/ice-9/Makefile.in deleted file mode 100644 index a13326970..000000000 --- a/ice-9/Makefile.in +++ /dev/null @@ -1,250 +0,0 @@ -# Makefile.in generated automatically by automake 1.3 from Makefile.am - -# Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc. -# This Makefile.in 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 program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - - -SHELL = /bin/sh - -srcdir = @srcdir@ -top_srcdir = @top_srcdir@ -VPATH = @srcdir@ -prefix = @prefix@ -exec_prefix = @exec_prefix@ - -bindir = @bindir@ -sbindir = @sbindir@ -libexecdir = @libexecdir@ -datadir = @datadir@ -sysconfdir = @sysconfdir@ -sharedstatedir = @sharedstatedir@ -localstatedir = @localstatedir@ -libdir = @libdir@ -infodir = @infodir@ -mandir = @mandir@ -includedir = @includedir@ -oldincludedir = /usr/include - -DISTDIR = - -pkgdatadir = $(datadir)/@PACKAGE@ -pkglibdir = $(libdir)/@PACKAGE@ -pkgincludedir = $(includedir)/@PACKAGE@ - -top_builddir = .. - -ACLOCAL = @ACLOCAL@ -AUTOCONF = @AUTOCONF@ -AUTOMAKE = @AUTOMAKE@ -AUTOHEADER = @AUTOHEADER@ - -INSTALL = @INSTALL@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_DATA = @INSTALL_DATA@ -INSTALL_SCRIPT = @INSTALL_SCRIPT@ -transform = @program_transform_name@ - -NORMAL_INSTALL = : -PRE_INSTALL = : -POST_INSTALL = : -NORMAL_UNINSTALL = : -PRE_UNINSTALL = : -POST_UNINSTALL = : -host_alias = @host_alias@ -host_triplet = @host@ -AWK = @AWK@ -CC = @CC@ -CPP = @CPP@ -GUILE_LIBS = @GUILE_LIBS@ -GUILE_MAJOR_VERSION = @GUILE_MAJOR_VERSION@ -GUILE_MINOR_VERSION = @GUILE_MINOR_VERSION@ -GUILE_STAMP = @GUILE_STAMP@ -GUILE_VERSION = @GUILE_VERSION@ -LD = @LD@ -LIBLOBJS = @LIBLOBJS@ -LIBTOOL = @LIBTOOL@ -LN_S = @LN_S@ -MAINT = @MAINT@ -MAKEINFO = @MAKEINFO@ -NM = @NM@ -PACKAGE = @PACKAGE@ -QTHREAD_LTLIBS = @QTHREAD_LTLIBS@ -RANLIB = @RANLIB@ -THREAD_CPPFLAGS = @THREAD_CPPFLAGS@ -THREAD_LIBS_INSTALLED = @THREAD_LIBS_INSTALLED@ -THREAD_LIBS_LOCAL = @THREAD_LIBS_LOCAL@ -THREAD_PACKAGE = @THREAD_PACKAGE@ -VERSION = @VERSION@ -qtdmdb_s = @qtdmdb_s@ -qtmd_h = @qtmd_h@ -qtmdc_c = @qtmdc_c@ -qtmds_s = @qtmds_s@ - -AUTOMAKE_OPTIONS = foreign - -# These should be installed and distributed. -ice9_sources = boot-9.scm calling.scm common-list.scm debug.scm \ -emacs.scm expect.scm hcons.scm lineio.scm ls.scm mapping.scm poe.scm \ -q.scm readline.scm regex.scm runq.scm slib.scm string-fun.scm tags.scm \ -threads.scm r4rs.scm session.scm syncase.scm psyntax.pp psyntax.ss - -# These should be installed, but not distributed. -ice9_generated = version.scm - -subpkgdatadir = $(pkgdatadir)/$(VERSION)/ice-9 -subpkgdata_DATA = $(ice9_sources) $(ice9_generated) -ETAGS_ARGS = $(subpkgdata_DATA) - -EXTRA_DIST = $(ice9_sources) test.scm version.scm.in -mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs -CONFIG_HEADER = ../libguile/scmconfig.h -CONFIG_CLEAN_FILES = version.scm -DATA = $(subpkgdata_DATA) - -DIST_COMMON = COPYING ChangeLog Makefile.am Makefile.in version.scm.in - - -DISTFILES = $(DIST_COMMON) $(SOURCES) $(HEADERS) $(TEXINFOS) $(EXTRA_DIST) - -TAR = tar -GZIP = --best -all: Makefile $(DATA) - -.SUFFIXES: -$(srcdir)/Makefile.in: @MAINT@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) - cd $(top_srcdir) && $(AUTOMAKE) --foreign ice-9/Makefile - -Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status $(BUILT_SOURCES) - cd $(top_builddir) \ - && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status - -version.scm: $(top_builddir)/config.status version.scm.in - cd $(top_builddir) && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= ./config.status - -install-subpkgdataDATA: $(subpkgdata_DATA) - @$(NORMAL_INSTALL) - $(mkinstalldirs) $(DESTDIR)$(subpkgdatadir) - @list='$(subpkgdata_DATA)'; for p in $$list; do \ - if test -f $(srcdir)/$$p; then \ - echo " $(INSTALL_DATA) $(srcdir)/$$p $(DESTDIR)$(subpkgdatadir)/$$p"; \ - $(INSTALL_DATA) $(srcdir)/$$p $(DESTDIR)$(subpkgdatadir)/$$p; \ - else if test -f $$p; then \ - echo " $(INSTALL_DATA) $$p $(DESTDIR)$(subpkgdatadir)/$$p"; \ - $(INSTALL_DATA) $$p $(DESTDIR)$(subpkgdatadir)/$$p; \ - fi; fi; \ - done - -uninstall-subpkgdataDATA: - @$(NORMAL_UNINSTALL) - list='$(subpkgdata_DATA)'; for p in $$list; do \ - rm -f $(DESTDIR)$(subpkgdatadir)/$$p; \ - done - -tags: TAGS - -ID: $(HEADERS) $(SOURCES) $(LISP) - here=`pwd` && cd $(srcdir) \ - && mkid -f$$here/ID $(SOURCES) $(HEADERS) $(LISP) - -TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) $(LISP) - tags=; \ - here=`pwd`; \ - list='$(SOURCES) $(HEADERS)'; \ - unique=`for i in $$list; do echo $$i; done | \ - awk ' { files[$$0] = 1; } \ - END { for (i in files) print i; }'`; \ - test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \ - || (cd $(srcdir) && etags $(ETAGS_ARGS) $$tags $$unique $(LISP) -o $$here/TAGS) - -mostlyclean-tags: - -clean-tags: - -distclean-tags: - -rm -f TAGS ID - -maintainer-clean-tags: - -distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir) - -subdir = ice-9 - -distdir: $(DISTFILES) - here=`cd $(top_builddir) && pwd`; \ - top_distdir=`cd $(top_distdir) && pwd`; \ - distdir=`cd $(distdir) && pwd`; \ - cd $(top_srcdir) \ - && $(AUTOMAKE) --include-deps --build-dir=$$here --srcdir-name=$(top_srcdir) --output-dir=$$top_distdir --foreign ice-9/Makefile - @for file in $(DISTFILES); do \ - d=$(srcdir); \ - test -f $(distdir)/$$file \ - || ln $$d/$$file $(distdir)/$$file 2> /dev/null \ - || cp -p $$d/$$file $(distdir)/$$file; \ - done -info: -dvi: -check: all - $(MAKE) -installcheck: -install-exec: - @$(NORMAL_INSTALL) - -install-data: install-subpkgdataDATA - @$(NORMAL_INSTALL) - -install: install-exec install-data all - @: - -uninstall: uninstall-subpkgdataDATA - -install-strip: - $(MAKE) INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' INSTALL_SCRIPT='$(INSTALL_PROGRAM)' install -installdirs: - $(mkinstalldirs) $(DATADIR)$(subpkgdatadir) - - -mostlyclean-generic: - -test -z "$(MOSTLYCLEANFILES)" || rm -f $(MOSTLYCLEANFILES) - -clean-generic: - -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) - -distclean-generic: - -rm -f Makefile $(DISTCLEANFILES) - -rm -f config.cache config.log stamp-h stamp-h[0-9]* - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -maintainer-clean-generic: - -test -z "$(MAINTAINERCLEANFILES)" || rm -f $(MAINTAINERCLEANFILES) - -test -z "$(BUILT_SOURCES)" || rm -f $(BUILT_SOURCES) -mostlyclean: mostlyclean-tags mostlyclean-generic - -clean: clean-tags clean-generic mostlyclean - -distclean: distclean-tags distclean-generic clean - -rm -f config.status - -rm -f libtool - -maintainer-clean: maintainer-clean-tags maintainer-clean-generic \ - distclean - @echo "This command is intended for maintainers to use;" - @echo "it deletes files that may require special tools to rebuild." - -.PHONY: uninstall-subpkgdataDATA install-subpkgdataDATA tags \ -mostlyclean-tags distclean-tags clean-tags maintainer-clean-tags \ -distdir info dvi installcheck install-exec install-data install \ -uninstall all installdirs mostlyclean-generic distclean-generic \ -clean-generic maintainer-clean-generic clean mostlyclean distclean \ -maintainer-clean - - -# Tell versions [3.59,3.63) of GNU make to not export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm deleted file mode 100644 index 5dc81a917..000000000 --- a/ice-9/boot-9.scm +++ /dev/null @@ -1,3028 +0,0 @@ -;;; installed-scm-file - -;;;; Copyright (C) 1995, 1996, 1997 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., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA -;;;; - - -;;; This file is the first thing loaded into Guile. It adds many mundane -;;; definitions and a few that are interesting. -;;; -;;; The module system (hence the hierarchical namespace) are defined in this -;;; file. -;;; - - -;;; {Features} -;; - -(define (provide sym) - (if (not (memq sym *features*)) - (set! *features* (cons sym *features*)))) - - -;;; {R4RS compliance} - -(primitive-load-path "ice-9/r4rs.scm") - - -;;; {Simple Debugging Tools} -;; - - -;; peek takes any number of arguments, writes them to the -;; current ouput port, and returns the last argument. -;; It is handy to wrap around an expression to look at -;; a value each time is evaluated, e.g.: -;; -;; (+ 10 (troublesome-fn)) -;; => (+ 10 (pk 'troublesome-fn-returned (troublesome-fn))) -;; - -(define (peek . stuff) - (newline) - (display ";;; ") - (write stuff) - (newline) - (car (last-pair stuff))) - -(define pk peek) - -(define (warn . stuff) - (with-output-to-port (current-error-port) - (lambda () - (newline) - (display ";;; WARNING ") - (display stuff) - (newline) - (car (last-pair stuff))))) - - -;;; {Trivial Functions} -;;; - -(define (id x) x) -(define (1+ n) (+ n 1)) -(define (-1+ n) (+ n -1)) -(define 1- -1+) -(define return-it noop) -(define (and=> value procedure) (and value (procedure value))) -(define (make-hash-table k) (make-vector k '())) - -;;; apply-to-args is functionally redunant with apply and, worse, -;;; is less general than apply since it only takes two arguments. -;;; -;;; On the other hand, apply-to-args is a syntacticly convenient way to -;;; perform binding in many circumstances when the "let" family of -;;; of forms don't cut it. E.g.: -;;; -;;; (apply-to-args (return-3d-mouse-coords) -;;; (lambda (x y z) -;;; ...)) -;;; - -(define (apply-to-args args fn) (apply fn args)) - - -;;; {Integer Math} -;;; - -(define (ipow-by-squaring x k acc proc) - (cond ((zero? k) acc) - ((= 1 k) (proc acc x)) - (else (ipow-by-squaring (proc x x) - (quotient k 2) - (if (even? k) acc (proc acc x)) - proc)))) - -(define string-character-length string-length) - - - -;; A convenience function for combining flag bits. Like logior, but -;; handles the cases of 0 and 1 arguments. -;; -(define (flags . args) - (cond - ((null? args) 0) - ((null? (cdr args)) (car args)) - (else (apply logior args)))) - - -;;; {Symbol Properties} -;;; - -(define (symbol-property sym prop) - (let ((pair (assoc prop (symbol-pref sym)))) - (and pair (cdr pair)))) - -(define (set-symbol-property! sym prop val) - (let ((pair (assoc prop (symbol-pref sym)))) - (if pair - (set-cdr! pair val) - (symbol-pset! sym (acons prop val (symbol-pref sym)))))) - -(define (symbol-property-remove! sym prop) - (let ((pair (assoc prop (symbol-pref sym)))) - (if pair - (symbol-pset! sym (delq! pair (symbol-pref sym)))))) - - - -;;; {Line and Delimited I/O} - -;;; corresponds to SCM_LINE_INCREMENTORS in libguile. -(define scm-line-incrementors "\n") - -(define (read-line! string . maybe-port) - (let* ((port (if (pair? maybe-port) - (car maybe-port) - (current-input-port)))) - (let* ((rv (%read-delimited! scm-line-incrementors - string - #t - port)) - (terminator (car rv)) - (nchars (cdr rv))) - (cond ((and (= nchars 0) - (eof-object? terminator)) - terminator) - ((not terminator) #f) - (else nchars))))) - -(define (read-delimited! delims buf . args) - (let* ((num-args (length args)) - (port (if (> num-args 0) - (car args) - (current-input-port))) - (handle-delim (if (> num-args 1) - (cadr args) - 'trim)) - (start (if (> num-args 2) - (caddr args) - 0)) - (end (if (> num-args 3) - (cadddr args) - (string-length buf)))) - (let* ((rv (%read-delimited! delims - buf - (not (eq? handle-delim 'peek)) - port - start - end)) - (terminator (car rv)) - (nchars (cdr rv))) - (cond ((or (not terminator) ; buffer filled - (eof-object? terminator)) - (if (zero? nchars) - (if (eq? handle-delim 'split) - (cons terminator terminator) - terminator) - (if (eq? handle-delim 'split) - (cons nchars terminator) - nchars))) - (else - (case handle-delim - ((trim peek) nchars) - ((concat) (string-set! buf nchars terminator) - (+ nchars 1)) - ((split) (cons nchars terminator)) - (else (error "unexpected handle-delim value: " - handle-delim)))))))) - -(define (read-delimited delims . args) - (let* ((port (if (pair? args) - (let ((pt (car args))) - (set! args (cdr args)) - pt) - (current-input-port))) - (handle-delim (if (pair? args) - (car args) - 'trim))) - (let loop ((substrings ()) - (total-chars 0) - (buf-size 100)) ; doubled each time through. - (let* ((buf (make-string buf-size)) - (rv (%read-delimited! delims - buf - (not (eq? handle-delim 'peek)) - port)) - (terminator (car rv)) - (nchars (cdr rv)) - (join-substrings - (lambda () - (apply string-append - (reverse - (cons (if (and (eq? handle-delim 'concat) - (not (eof-object? terminator))) - (string terminator) - "") - (cons (make-shared-substring buf 0 nchars) - substrings)))))) - (new-total (+ total-chars nchars))) - (cond ((not terminator) - ;; buffer filled. - (loop (cons (substring buf 0 nchars) substrings) - new-total - (* buf-size 2))) - ((eof-object? terminator) - (if (zero? new-total) - (if (eq? handle-delim 'split) - (cons terminator terminator) - terminator) - (if (eq? handle-delim 'split) - (cons (join-substrings) terminator) - (join-substrings)))) - (else - (case handle-delim - ((trim peek concat) (join-substrings)) - ((split) (cons (join-substrings) terminator)) - - - (else (error "unexpected handle-delim value: " - handle-delim))))))))) - -;;; read-line [PORT [HANDLE-DELIM]] reads a newline-terminated string -;;; from PORT. The return value depends on the value of HANDLE-DELIM, -;;; which may be one of the symbols `trim', `concat', `peek' and -;;; `split'. If it is `trim' (the default), the trailing newline is -;;; removed and the string is returned. If `concat', the string is -;;; returned with the trailing newline intact. If `peek', the newline -;;; is left in the input port buffer and the string is returned. If -;;; `split', the newline is split from the string and read-line -;;; returns a pair consisting of the truncated string and the newline. - -(define (read-line . args) - (let* ((port (if (null? args) - (current-input-port) - (car args))) - (handle-delim (if (> (length args) 1) - (cadr args) - 'trim)) - (line/delim (%read-line port)) - (line (car line/delim)) - (delim (cdr line/delim))) - (case handle-delim - ((trim) line) - ((split) line/delim) - ((concat) (if (and (string? line) (char? delim)) - (string-append line (string delim)) - line)) - ((peek) (if (char? delim) - (unread-char delim port)) - line) - (else - (error "unexpected handle-delim value: " handle-delim))))) - - -;;; {Arrays} -;;; - -(begin - (define uniform-vector? array?) - (define make-uniform-vector dimensions->uniform-array) - ; (define uniform-vector-ref array-ref) - (define (uniform-vector-set! u i o) - (uniform-array-set1! u o i)) - (define uniform-vector-fill! array-fill!) - (define uniform-vector-read! uniform-array-read!) - (define uniform-vector-write uniform-array-write) - - (define (make-array fill . args) - (dimensions->uniform-array args () fill)) - (define (make-uniform-array prot . args) - (dimensions->uniform-array args prot)) - (define (list->array ndim lst) - (list->uniform-array ndim '() lst)) - (define (list->uniform-vector prot lst) - (list->uniform-array 1 prot lst)) - (define (array-shape a) - (map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind)) - (array-dimensions a)))) - - -;;; {Keywords} -;;; - -(define (symbol->keyword symbol) - (make-keyword-from-dash-symbol (symbol-append '- symbol))) - -(define (keyword->symbol kw) - (let ((sym (keyword-dash-symbol kw))) - (string->symbol (substring sym 1 (string-length sym))))) - -(define (kw-arg-ref args kw) - (let ((rem (member kw args))) - (and rem (pair? (cdr rem)) (cadr rem)))) - - - -;;; {Structs} - -(define (struct-layout s) - (struct-ref (struct-vtable s) vtable-index-layout)) - - -;;; {Records} -;;; - -;; Printing records: by default, records are printed as -;; -;; #<type-name field1: val1 field2: val2 ...> -;; -;; You can change that by giving a custom printing function to -;; MAKE-RECORD-TYPE (after the list of field symbols). This function -;; will be called like -;; -;; (<printer> object port) -;; -;; It should print OBJECT to PORT. - -(define (inherit-print-state old-port new-port) - (if (pair? old-port) - (cons (if (pair? new-port) (car new-port) new-port) - (cdr old-port)) - new-port)) - -;; 0: type-name, 1: fields -(define record-type-vtable - (make-vtable-vtable "prpr" 0 - (lambda (s p) - (cond ((eq? s record-type-vtable) - (display "#<record-type-vtable>" p)) - (else - (display "#<record-type " p) - (display (record-type-name s) p) - (display ">" p)))))) - -(define (record-type? obj) - (and (struct? obj) (eq? record-type-vtable (struct-vtable obj)))) - -(define (make-record-type type-name fields . opt) - (let ((printer-fn (and (pair? opt) (car opt)))) - (let ((struct (make-struct record-type-vtable 0 - (make-struct-layout - (apply symbol-append - (map (lambda (f) "pw") fields))) - (or printer-fn - (lambda (s p) - (display "#<" p) - (display type-name p) - (let loop ((fields fields) - (off 0)) - (cond - ((not (null? fields)) - (display " " p) - (display (car fields) p) - (display ": " p) - (display (struct-ref s off) p) - (loop (cdr fields) (+ 1 off))))) - (display ">" p))) - type-name - (copy-tree fields)))) - struct))) - -(define (record-type-name obj) - (if (record-type? obj) - (struct-ref obj vtable-offset-user) - (error 'not-a-record-type obj))) - -(define (record-type-fields obj) - (if (record-type? obj) - (struct-ref obj (+ 1 vtable-offset-user)) - (error 'not-a-record-type obj))) - -(define (record-constructor rtd . opt) - (let ((field-names (if (pair? opt) (car opt) (record-type-fields rtd)))) - (eval `(lambda ,field-names - (make-struct ',rtd 0 ,@(map (lambda (f) - (if (memq f field-names) - f - #f)) - (record-type-fields rtd))))))) - -(define (record-predicate rtd) - (lambda (obj) (and (struct? obj) (eq? rtd (struct-vtable obj))))) - -(define (record-accessor rtd field-name) - (let* ((pos (list-index (record-type-fields rtd) field-name))) - (if (not pos) - (error 'no-such-field field-name)) - (eval `(lambda (obj) - (and (eq? ',rtd (record-type-descriptor obj)) - (struct-ref obj ,pos)))))) - -(define (record-modifier rtd field-name) - (let* ((pos (list-index (record-type-fields rtd) field-name))) - (if (not pos) - (error 'no-such-field field-name)) - (eval `(lambda (obj val) - (and (eq? ',rtd (record-type-descriptor obj)) - (struct-set! obj ,pos val)))))) - - -(define (record? obj) - (and (struct? obj) (record-type? (struct-vtable obj)))) - -(define (record-type-descriptor obj) - (if (struct? obj) - (struct-vtable obj) - (error 'not-a-record obj))) - -(provide 'record) - - -;;; {Booleans} -;;; - -(define (->bool x) (not (not x))) - - -;;; {Symbols} -;;; - -(define (symbol-append . args) - (string->symbol (apply string-append args))) - -(define (list->symbol . args) - (string->symbol (apply list->string args))) - -(define (symbol . args) - (string->symbol (apply string args))) - -(define (obarray-symbol-append ob . args) - (string->obarray-symbol (apply string-append ob args))) - -(define (obarray-gensym obarray . opt) - (if (null? opt) - (gensym "%%gensym" obarray) - (gensym (car opt) obarray))) - - -;;; {Lists} -;;; - -(define (list-index l k) - (let loop ((n 0) - (l l)) - (and (not (null? l)) - (if (eq? (car l) k) - n - (loop (+ n 1) (cdr l)))))) - -(define (make-list n . init) - (if (pair? init) (set! init (car init))) - (let loop ((answer '()) - (n n)) - (if (<= n 0) - answer - (loop (cons init answer) (- n 1))))) - - - -;;; {and-map, or-map, and map-in-order} -;;; -;;; (and-map fn lst) is like (and (fn (car lst)) (fn (cadr lst)) (fn...) ...) -;;; (or-map fn lst) is like (or (fn (car lst)) (fn (cadr lst)) (fn...) ...) -;;; (map-in-order fn lst) is like (map fn lst) but definately in order of lst. -;;; - -;; and-map f l -;; -;; Apply f to successive elements of l until exhaustion or f returns #f. -;; If returning early, return #f. Otherwise, return the last value returned -;; by f. If f has never been called because l is empty, return #t. -;; -(define (and-map f lst) - (let loop ((result #t) - (l lst)) - (and result - (or (and (null? l) - result) - (loop (f (car l)) (cdr l)))))) - -;; or-map f l -;; -;; Apply f to successive elements of l until exhaustion or while f returns #f. -;; If returning early, return the return value of f. -;; -(define (or-map f lst) - (let loop ((result #f) - (l lst)) - (or result - (and (not (null? l)) - (loop (f (car l)) (cdr l)))))) - -;; map-in-order -;; -;; Like map, but guaranteed to process the list in order. -;; -(define (map-in-order fn l) - (if (null? l) - '() - (cons (fn (car l)) - (map-in-order fn (cdr l))))) - - -;;; {Hooks} -(define (run-hooks hook) - (for-each (lambda (thunk) (thunk)) hook)) - -(define add-hook! - (procedure->macro - (lambda (exp env) - `(let ((thunk ,(caddr exp))) - (if (not (memq thunk ,(cadr exp))) - (set! ,(cadr exp) - (cons thunk ,(cadr exp)))))))) - -(define remove-hook! - (procedure->macro - (lambda (exp env) - `(let ((thunk ,(caddr exp))) - (if (memq thunk ,(cadr exp)) - (set! ,(cadr exp) - (delq! thunk ,(cadr exp)))))))) - - -;;; {Files} -;;; -;;; If no one can explain this comment to me by 31 Jan 1998, I will -;;; assume it is meaningless and remove it. -twp -;;; !!!! these should be implemented using Tcl commands, not fports. - -(define (feature? feature) - (and (memq feature *features*) #t)) - -;; Using the vector returned by stat directly is probably not a good -;; idea (it could just as well be a record). Hence some accessors. -(define (stat:dev f) (vector-ref f 0)) -(define (stat:ino f) (vector-ref f 1)) -(define (stat:mode f) (vector-ref f 2)) -(define (stat:nlink f) (vector-ref f 3)) -(define (stat:uid f) (vector-ref f 4)) -(define (stat:gid f) (vector-ref f 5)) -(define (stat:rdev f) (vector-ref f 6)) -(define (stat:size f) (vector-ref f 7)) -(define (stat:atime f) (vector-ref f 8)) -(define (stat:mtime f) (vector-ref f 9)) -(define (stat:ctime f) (vector-ref f 10)) -(define (stat:blksize f) (vector-ref f 11)) -(define (stat:blocks f) (vector-ref f 12)) - -;; derived from stat mode. -(define (stat:type f) (vector-ref f 13)) -(define (stat:perms f) (vector-ref f 14)) - -(define file-exists? - (if (feature? 'posix) - (lambda (str) - (access? str F_OK)) - (lambda (str) - (let ((port (catch 'system-error (lambda () (open-file str OPEN_READ)) - (lambda args #f)))) - (if port (begin (close-port port) #t) - #f))))) - -(define file-is-directory? - (if (feature? 'i/o-extensions) - (lambda (str) - (eq? (stat:type (stat str)) 'directory)) - (lambda (str) - (display str) - (newline) - (let ((port (catch 'system-error - (lambda () (open-file (string-append str "/.") - OPEN_READ)) - (lambda args #f)))) - (if port (begin (close-port port) #t) - #f))))) - -(define (has-suffix? str suffix) - (let ((sufl (string-length suffix)) - (sl (string-length str))) - (and (> sl sufl) - (string=? (substring str (- sl sufl) sl) suffix)))) - - -;;; {Error Handling} -;;; - -(define (error . args) - (save-stack) - (if (null? args) - (scm-error 'misc-error #f "?" #f #f) - (let loop ((msg "%s") - (rest (cdr args))) - (if (not (null? rest)) - (loop (string-append msg " %S") - (cdr rest)) - (scm-error 'misc-error #f msg args #f))))) - -;; bad-throw is the hook that is called upon a throw to a an unhandled -;; key (unless the throw has four arguments, in which case -;; it's usually interpreted as an error throw.) -;; If the key has a default handler (a throw-handler-default property), -;; it is applied to the throw. -;; -(define (bad-throw key . args) - (let ((default (symbol-property key 'throw-handler-default))) - (or (and default (apply default key args)) - (apply error "unhandled-exception:" key args)))) - - -;;; {Non-polymorphic versions of POSIX functions} - -(define (getgrnam name) (getgr name)) -(define (getgrgid id) (getgr id)) -(define (gethostbyaddr addr) (gethost addr)) -(define (gethostbyname name) (gethost name)) -(define (getnetbyaddr addr) (getnet addr)) -(define (getnetbyname name) (getnet name)) -(define (getprotobyname name) (getproto name)) -(define (getprotobynumber addr) (getproto addr)) -(define (getpwnam name) (getpw name)) -(define (getpwuid uid) (getpw uid)) -(define (getservbyname name proto) (getserv name proto)) -(define (getservbyport port proto) (getserv port proto)) -(define (endgrent) (setgr)) -(define (endhostent) (sethost)) -(define (endnetent) (setnet)) -(define (endprotoent) (setproto)) -(define (endpwent) (setpw)) -(define (endservent) (setserv)) -(define (getgrent) (getgr)) -(define (gethostent) (gethost)) -(define (getnetent) (getnet)) -(define (getprotoent) (getproto)) -(define (getpwent) (getpw)) -(define (getservent) (getserv)) -(define (reopen-file . args) (apply freopen args)) -(define (setgrent) (setgr #f)) -(define (sethostent) (sethost #t)) -(define (setnetent) (setnet #t)) -(define (setprotoent) (setproto #t)) -(define (setpwent) (setpw #t)) -(define (setservent) (setserv #t)) - -(define (passwd:name obj) (vector-ref obj 0)) -(define (passwd:passwd obj) (vector-ref obj 1)) -(define (passwd:uid obj) (vector-ref obj 2)) -(define (passwd:gid obj) (vector-ref obj 3)) -(define (passwd:gecos obj) (vector-ref obj 4)) -(define (passwd:dir obj) (vector-ref obj 5)) -(define (passwd:shell obj) (vector-ref obj 6)) - -(define (group:name obj) (vector-ref obj 0)) -(define (group:passwd obj) (vector-ref obj 1)) -(define (group:gid obj) (vector-ref obj 2)) -(define (group:mem obj) (vector-ref obj 3)) - -(define (hostent:name obj) (vector-ref obj 0)) -(define (hostent:aliases obj) (vector-ref obj 1)) -(define (hostent:addrtype obj) (vector-ref obj 2)) -(define (hostent:length obj) (vector-ref obj 3)) -(define (hostent:addr-list obj) (vector-ref obj 4)) - -(define (netent:name obj) (vector-ref obj 0)) -(define (netent:aliases obj) (vector-ref obj 1)) -(define (netent:addrtype obj) (vector-ref obj 2)) -(define (netent:net obj) (vector-ref obj 3)) - -(define (protoent:name obj) (vector-ref obj 0)) -(define (protoent:aliases obj) (vector-ref obj 1)) -(define (protoent:proto obj) (vector-ref obj 2)) - -(define (servent:name obj) (vector-ref obj 0)) -(define (servent:aliases obj) (vector-ref obj 1)) -(define (servent:port obj) (vector-ref obj 2)) -(define (servent:proto obj) (vector-ref obj 3)) - -(define (sockaddr:fam obj) (vector-ref obj 0)) -(define (sockaddr:path obj) (vector-ref obj 1)) -(define (sockaddr:addr obj) (vector-ref obj 1)) -(define (sockaddr:port obj) (vector-ref obj 2)) - -(define (utsname:sysname obj) (vector-ref obj 0)) -(define (utsname:nodename obj) (vector-ref obj 1)) -(define (utsname:release obj) (vector-ref obj 2)) -(define (utsname:version obj) (vector-ref obj 3)) -(define (utsname:machine obj) (vector-ref obj 4)) - -(define (tm:sec obj) (vector-ref obj 0)) -(define (tm:min obj) (vector-ref obj 1)) -(define (tm:hour obj) (vector-ref obj 2)) -(define (tm:mday obj) (vector-ref obj 3)) -(define (tm:mon obj) (vector-ref obj 4)) -(define (tm:year obj) (vector-ref obj 5)) -(define (tm:wday obj) (vector-ref obj 6)) -(define (tm:yday obj) (vector-ref obj 7)) -(define (tm:isdst obj) (vector-ref obj 8)) -(define (tm:gmtoff obj) (vector-ref obj 9)) -(define (tm:zone obj) (vector-ref obj 10)) - -(define (set-tm:sec obj val) (vector-set! obj 0 val)) -(define (set-tm:min obj val) (vector-set! obj 1 val)) -(define (set-tm:hour obj val) (vector-set! obj 2 val)) -(define (set-tm:mday obj val) (vector-set! obj 3 val)) -(define (set-tm:mon obj val) (vector-set! obj 4 val)) -(define (set-tm:year obj val) (vector-set! obj 5 val)) -(define (set-tm:wday obj val) (vector-set! obj 6 val)) -(define (set-tm:yday obj val) (vector-set! obj 7 val)) -(define (set-tm:isdst obj val) (vector-set! obj 8 val)) -(define (set-tm:gmtoff obj val) (vector-set! obj 9 val)) -(define (set-tm:zone obj val) (vector-set! obj 10 val)) - -(define (tms:clock obj) (vector-ref obj 0)) -(define (tms:utime obj) (vector-ref obj 1)) -(define (tms:stime obj) (vector-ref obj 2)) -(define (tms:cutime obj) (vector-ref obj 3)) -(define (tms:cstime obj) (vector-ref obj 4)) - -(define (file-position . args) (apply ftell args)) -(define (file-set-position . args) (apply fseek args)) - -(define (open-input-pipe command) (open-pipe command OPEN_READ)) -(define (open-output-pipe command) (open-pipe command OPEN_WRITE)) - -(define (move->fdes fd/port fd) - (cond ((integer? fd/port) - (dup->fdes fd/port fd) - (close fd/port) - fd) - (else - (primitive-move->fdes fd/port fd) - (set-port-revealed! fd/port 1) - fd/port))) - -(define (release-port-handle port) - (let ((revealed (port-revealed port))) - (if (> revealed 0) - (set-port-revealed! port (- revealed 1))))) - -(define (dup->port port/fd mode . maybe-fd) - (let ((port (fdopen (apply dup->fdes port/fd maybe-fd) - mode))) - (if (pair? maybe-fd) - (set-port-revealed! port 1)) - port)) - -(define (dup->inport port/fd . maybe-fd) - (apply dup->port port/fd "r" maybe-fd)) - -(define (dup->outport port/fd . maybe-fd) - (apply dup->port port/fd "w" maybe-fd)) - -(define (dup port/fd . maybe-fd) - (if (integer? port/fd) - (apply dup->fdes port/fd maybe-fd) - (apply dup->port port/fd (port-mode port/fd) maybe-fd))) - -(define (duplicate-port port modes) - (dup->port port modes)) - -(define (fdes->inport fdes) - (let loop ((rest-ports (fdes->ports fdes))) - (cond ((null? rest-ports) - (let ((result (fdopen fdes "r"))) - (set-port-revealed! result 1) - result)) - ((input-port? (car rest-ports)) - (set-port-revealed! (car rest-ports) - (+ (port-revealed (car rest-ports)) 1)) - (car rest-ports)) - (else - (loop (cdr rest-ports)))))) - -(define (fdes->outport fdes) - (let loop ((rest-ports (fdes->ports fdes))) - (cond ((null? rest-ports) - (let ((result (fdopen fdes "w"))) - (set-port-revealed! result 1) - result)) - ((output-port? (car rest-ports)) - (set-port-revealed! (car rest-ports) - (+ (port-revealed (car rest-ports)) 1)) - (car rest-ports)) - (else - (loop (cdr rest-ports)))))) - -(define (port->fdes port) - (set-port-revealed! port (+ (port-revealed port) 1)) - (fileno port)) - -(define (setenv name value) - (if value - (putenv (string-append name "=" value)) - (putenv name))) - - -;;; {Load Paths} -;;; - -;;; Here for backward compatability -;; -(define scheme-file-suffix (lambda () ".scm")) - -(define (in-vicinity vicinity file) - (let ((tail (let ((len (string-length vicinity))) - (if (zero? len) - #f - (string-ref vicinity (- len 1)))))) - (string-append vicinity - (if (or (not tail) - (eq? tail #\/)) - "" - "/") - file))) - - -;;; {Help for scm_shell} -;;; The argument-processing code used by Guile-based shells generates -;;; Scheme code based on the argument list. This page contains help -;;; functions for the code it generates. - -(define (command-line) (program-arguments)) - -;; This is mostly for the internal use of the code generated by -;; scm_compile_shell_switches. -(define (load-user-init) - (define (has-init? dir) - (let ((path (in-vicinity dir ".guile"))) - (catch 'system-error - (lambda () - (let ((stats (stat path))) - (if (not (eq? (stat:type stats) 'directory)) - path))) - (lambda dummy #f)))) - (let ((path (or (has-init? (or (getenv "HOME") "/")) - (has-init? (passwd:dir (getpw (getuid))))))) - (if path (primitive-load path)))) - - -;;; {Loading by paths} - -;;; Load a Scheme source file named NAME, searching for it in the -;;; directories listed in %load-path, and applying each of the file -;;; name extensions listed in %load-extensions. -(define (load-from-path name) - (start-stack 'load-stack - (primitive-load-path name))) - - - -;;; {Transcendental Functions} -;;; -;;; Derived from "Transcen.scm", Complex trancendental functions for SCM. -;;; Written by Jerry D. Hedden, (C) FSF. -;;; See the file `COPYING' for terms applying to this program. -;;; - -(define (exp z) - (if (real? z) ($exp z) - (make-polar ($exp (real-part z)) (imag-part z)))) - -(define (log z) - (if (and (real? z) (>= z 0)) - ($log z) - (make-rectangular ($log (magnitude z)) (angle z)))) - -(define (sqrt z) - (if (real? z) - (if (negative? z) (make-rectangular 0 ($sqrt (- z))) - ($sqrt z)) - (make-polar ($sqrt (magnitude z)) (/ (angle z) 2)))) - -(define expt - (let ((integer-expt integer-expt)) - (lambda (z1 z2) - (cond ((exact? z2) - (integer-expt z1 z2)) - ((and (real? z2) (real? z1) (>= z1 0)) - ($expt z1 z2)) - (else - (exp (* z2 (log z1)))))))) - -(define (sinh z) - (if (real? z) ($sinh z) - (let ((x (real-part z)) (y (imag-part z))) - (make-rectangular (* ($sinh x) ($cos y)) - (* ($cosh x) ($sin y)))))) -(define (cosh z) - (if (real? z) ($cosh z) - (let ((x (real-part z)) (y (imag-part z))) - (make-rectangular (* ($cosh x) ($cos y)) - (* ($sinh x) ($sin y)))))) -(define (tanh z) - (if (real? z) ($tanh z) - (let* ((x (* 2 (real-part z))) - (y (* 2 (imag-part z))) - (w (+ ($cosh x) ($cos y)))) - (make-rectangular (/ ($sinh x) w) (/ ($sin y) w))))) - -(define (asinh z) - (if (real? z) ($asinh z) - (log (+ z (sqrt (+ (* z z) 1)))))) - -(define (acosh z) - (if (and (real? z) (>= z 1)) - ($acosh z) - (log (+ z (sqrt (- (* z z) 1)))))) - -(define (atanh z) - (if (and (real? z) (> z -1) (< z 1)) - ($atanh z) - (/ (log (/ (+ 1 z) (- 1 z))) 2))) - -(define (sin z) - (if (real? z) ($sin z) - (let ((x (real-part z)) (y (imag-part z))) - (make-rectangular (* ($sin x) ($cosh y)) - (* ($cos x) ($sinh y)))))) -(define (cos z) - (if (real? z) ($cos z) - (let ((x (real-part z)) (y (imag-part z))) - (make-rectangular (* ($cos x) ($cosh y)) - (- (* ($sin x) ($sinh y))))))) -(define (tan z) - (if (real? z) ($tan z) - (let* ((x (* 2 (real-part z))) - (y (* 2 (imag-part z))) - (w (+ ($cos x) ($cosh y)))) - (make-rectangular (/ ($sin x) w) (/ ($sinh y) w))))) - -(define (asin z) - (if (and (real? z) (>= z -1) (<= z 1)) - ($asin z) - (* -i (asinh (* +i z))))) - -(define (acos z) - (if (and (real? z) (>= z -1) (<= z 1)) - ($acos z) - (+ (/ (angle -1) 2) (* +i (asinh (* +i z)))))) - -(define (atan z . y) - (if (null? y) - (if (real? z) ($atan z) - (/ (log (/ (- +i z) (+ +i z))) +2i)) - ($atan2 z (car y)))) - -(set! abs magnitude) - -(define (log10 arg) - (/ (log arg) (log 10))) - - - -;;; {Reader Extensions} -;;; - -;;; Reader code for various "#c" forms. -;;; - -;;; Parse the portion of a #/ list that comes after the first slash. -(define (read-path-list-notation slash port) - (letrec - - ;; Is C a delimiter? - ((delimiter? (lambda (c) (or (eof-object? c) - (char-whitespace? c) - (string-index "()\";" c)))) - - ;; Read and return one component of a path list. - (read-component - (lambda () - (let loop ((reversed-chars '())) - (let ((c (peek-char port))) - (if (or (delimiter? c) - (char=? c #\/)) - (string->symbol (list->string (reverse reversed-chars))) - (loop (cons (read-char port) reversed-chars)))))))) - - ;; Read and return a path list. - (let loop ((reversed-path (list (read-component)))) - (let ((c (peek-char port))) - (if (and (char? c) (char=? c #\/)) - (begin - (read-char port) - (loop (cons (read-component) reversed-path))) - (reverse reversed-path)))))) - -(define (read-path-list-notation-warning slash port) - (if (not (getenv "GUILE_HUSH")) - (begin - (display "warning: obsolete `#/' list notation read from " - (current-error-port)) - (display (port-filename port) (current-error-port)) - (display "; see guile-core/NEWS." (current-error-port)) - (newline (current-error-port)) - (display " Set the GUILE_HUSH environment variable to disable this warning." - (current-error-port)) - (newline (current-error-port)))) - (read-hash-extend #\/ read-path-list-notation) - (read-path-list-notation slash port)) - - -(read-hash-extend #\' (lambda (c port) - (read port))) -(read-hash-extend #\. (lambda (c port) - (eval (read port)))) - -(if (feature? 'array) - (begin - (let ((make-array-proc (lambda (template) - (lambda (c port) - (read:uniform-vector template port))))) - (for-each (lambda (char template) - (read-hash-extend char - (make-array-proc template))) - '(#\b #\a #\u #\e #\s #\i #\c) - '(#t #\a 1 -1 1.0 1/3 0+i))) - (let ((array-proc (lambda (c port) - (read:array c port)))) - (for-each (lambda (char) (read-hash-extend char array-proc)) - '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))))) - -;; pushed to the beginning of the alist since it's used more than the -;; others at present. -(read-hash-extend #\/ read-path-list-notation-warning) - -(define (read:array digit port) - (define chr0 (char->integer #\0)) - (let ((rank (let readnum ((val (- (char->integer digit) chr0))) - (if (char-numeric? (peek-char port)) - (readnum (+ (* 10 val) - (- (char->integer (read-char port)) chr0))) - val))) - (prot (if (eq? #\( (peek-char port)) - '() - (let ((c (read-char port))) - (case c ((#\b) #t) - ((#\a) #\a) - ((#\u) 1) - ((#\e) -1) - ((#\s) 1.0) - ((#\i) 1/3) - ((#\c) 0+i) - (else (error "read:array unknown option " c))))))) - (if (eq? (peek-char port) #\() - (list->uniform-array rank prot (read port)) - (error "read:array list not found")))) - -(define (read:uniform-vector proto port) - (if (eq? #\( (peek-char port)) - (list->uniform-array 1 proto (read port)) - (error "read:uniform-vector list not found"))) - - -;;; {Command Line Options} -;;; - -(define (get-option argv kw-opts kw-args return) - (cond - ((null? argv) - (return #f #f argv)) - - ((or (not (eq? #\- (string-ref (car argv) 0))) - (eq? (string-length (car argv)) 1)) - (return 'normal-arg (car argv) (cdr argv))) - - ((eq? #\- (string-ref (car argv) 1)) - (let* ((kw-arg-pos (or (string-index (car argv) #\=) - (string-length (car argv)))) - (kw (symbol->keyword (substring (car argv) 2 kw-arg-pos))) - (kw-opt? (member kw kw-opts)) - (kw-arg? (member kw kw-args)) - (arg (or (and (not (eq? kw-arg-pos (string-length (car argv)))) - (substring (car argv) - (+ kw-arg-pos 1) - (string-length (car argv)))) - (and kw-arg? - (begin (set! argv (cdr argv)) (car argv)))))) - (if (or kw-opt? kw-arg?) - (return kw arg (cdr argv)) - (return 'usage-error kw (cdr argv))))) - - (else - (let* ((char (substring (car argv) 1 2)) - (kw (symbol->keyword char))) - (cond - - ((member kw kw-opts) - (let* ((rest-car (substring (car argv) 2 (string-length (car argv)))) - (new-argv (if (= 0 (string-length rest-car)) - (cdr argv) - (cons (string-append "-" rest-car) (cdr argv))))) - (return kw #f new-argv))) - - ((member kw kw-args) - (let* ((rest-car (substring (car argv) 2 (string-length (car argv)))) - (arg (if (= 0 (string-length rest-car)) - (cadr argv) - rest-car)) - (new-argv (if (= 0 (string-length rest-car)) - (cddr argv) - (cdr argv)))) - (return kw arg new-argv))) - - (else (return 'usage-error kw argv))))))) - -(define (for-next-option proc argv kw-opts kw-args) - (let loop ((argv argv)) - (get-option argv kw-opts kw-args - (lambda (opt opt-arg argv) - (and opt (proc opt opt-arg argv loop)))))) - -(define (display-usage-report kw-desc) - (for-each - (lambda (kw) - (or (eq? (car kw) #t) - (eq? (car kw) 'else) - (let* ((opt-desc kw) - (help (cadr opt-desc)) - (opts (car opt-desc)) - (opts-proper (if (string? (car opts)) (cdr opts) opts)) - (arg-name (if (string? (car opts)) - (string-append "<" (car opts) ">") - "")) - (left-part (string-append - (with-output-to-string - (lambda () - (map (lambda (x) (display (keyword-symbol x)) (display " ")) - opts-proper))) - arg-name)) - (middle-part (if (and (< (string-length left-part) 30) - (< (string-length help) 40)) - (make-string (- 30 (string-length left-part)) #\ ) - "\n\t"))) - (display left-part) - (display middle-part) - (display help) - (newline)))) - kw-desc)) - - - -(define (transform-usage-lambda cases) - (let* ((raw-usage (delq! 'else (map car cases))) - (usage-sans-specials (map (lambda (x) - (or (and (not (list? x)) x) - (and (symbol? (car x)) #t) - (and (boolean? (car x)) #t) - x)) - raw-usage)) - (usage-desc (delq! #t usage-sans-specials)) - (kw-desc (map car usage-desc)) - (kw-opts (apply append (map (lambda (x) (and (not (string? (car x))) x)) kw-desc))) - (kw-args (apply append (map (lambda (x) (and (string? (car x)) (cdr x))) kw-desc))) - (transmogrified-cases (map (lambda (case) - (cons (let ((opts (car case))) - (if (or (boolean? opts) (eq? 'else opts)) - opts - (cond - ((symbol? (car opts)) opts) - ((boolean? (car opts)) opts) - ((string? (caar opts)) (cdar opts)) - (else (car opts))))) - (cdr case))) - cases))) - `(let ((%display-usage (lambda () (display-usage-report ',usage-desc)))) - (lambda (%argv) - (let %next-arg ((%argv %argv)) - (get-option %argv - ',kw-opts - ',kw-args - (lambda (%opt %arg %new-argv) - (case %opt - ,@ transmogrified-cases)))))))) - - - - -;;; {Low Level Modules} -;;; -;;; These are the low level data structures for modules. -;;; -;;; !!! warning: The interface to lazy binder procedures is going -;;; to be changed in an incompatible way to permit all the basic -;;; module ops to be virtualized. -;;; -;;; (make-module size use-list lazy-binding-proc) => module -;;; module-{obarray,uses,binder}[|-set!] -;;; (module? obj) => [#t|#f] -;;; (module-locally-bound? module symbol) => [#t|#f] -;;; (module-bound? module symbol) => [#t|#f] -;;; (module-symbol-locally-interned? module symbol) => [#t|#f] -;;; (module-symbol-interned? module symbol) => [#t|#f] -;;; (module-local-variable module symbol) => [#<variable ...> | #f] -;;; (module-variable module symbol) => [#<variable ...> | #f] -;;; (module-symbol-binding module symbol opt-value) -;;; => [ <obj> | opt-value | an error occurs ] -;;; (module-make-local-var! module symbol) => #<variable...> -;;; (module-add! module symbol var) => unspecified -;;; (module-remove! module symbol) => unspecified -;;; (module-for-each proc module) => unspecified -;;; (make-scm-module) => module ; a lazy copy of the symhash module -;;; (set-current-module module) => unspecified -;;; (current-module) => #<module...> -;;; -;;; - - -;;; {Printing Modules} -;; This is how modules are printed. You can re-define it. -;; (Redefining is actually more complicated than simply redefining -;; %print-module because that would only change the binding and not -;; the value stored in the vtable that determines how record are -;; printed. Sigh.) - -(define (%print-module mod port) ; unused args: depth length style table) - (display "#<" port) - (display (or (module-kind mod) "module") port) - (let ((name (module-name mod))) - (if name - (begin - (display " " port) - (display name port)))) - (display " " port) - (display (number->string (object-address mod) 16) port) - (display ">" port)) - -;; module-type -;; -;; A module is characterized by an obarray in which local symbols -;; are interned, a list of modules, "uses", from which non-local -;; bindings can be inherited, and an optional lazy-binder which -;; is a (CLOSURE module symbol) which, as a last resort, can provide -;; bindings that would otherwise not be found locally in the module. -;; -(define module-type - (make-record-type 'module - '(obarray uses binder eval-closure transformer name kind) - %print-module)) - -;; make-module &opt size uses binder -;; -;; Create a new module, perhaps with a particular size of obarray, -;; initial uses list, or binding procedure. -;; -(define make-module - (lambda args - - (define (parse-arg index default) - (if (> (length args) index) - (list-ref args index) - default)) - - (if (> (length args) 3) - (error "Too many args to make-module." args)) - - (let ((size (parse-arg 0 1021)) - (uses (parse-arg 1 '())) - (binder (parse-arg 2 #f))) - - (if (not (integer? size)) - (error "Illegal size to make-module." size)) - (if (not (and (list? uses) - (and-map module? uses))) - (error "Incorrect use list." uses)) - (if (and binder (not (procedure? binder))) - (error - "Lazy-binder expected to be a procedure or #f." binder)) - - (let ((module (module-constructor (make-vector size '()) - uses binder #f #f #f #f))) - - ;; We can't pass this as an argument to module-constructor, - ;; because we need it to close over a pointer to the module - ;; itself. - (set-module-eval-closure! module - (lambda (symbol define?) - (if define? - (module-make-local-var! module symbol) - (module-variable module symbol)))) - - module)))) - -(define module-constructor (record-constructor module-type)) -(define module-obarray (record-accessor module-type 'obarray)) -(define set-module-obarray! (record-modifier module-type 'obarray)) -(define module-uses (record-accessor module-type 'uses)) -(define set-module-uses! (record-modifier module-type 'uses)) -(define module-binder (record-accessor module-type 'binder)) -(define set-module-binder! (record-modifier module-type 'binder)) -(define module-eval-closure (record-accessor module-type 'eval-closure)) -(define set-module-eval-closure! (record-modifier module-type 'eval-closure)) -(define module-transformer (record-accessor module-type 'transformer)) -(define set-module-transformer! (record-modifier module-type 'transformer)) -(define module-name (record-accessor module-type 'name)) -(define set-module-name! (record-modifier module-type 'name)) -(define module-kind (record-accessor module-type 'kind)) -(define set-module-kind! (record-modifier module-type 'kind)) -(define module? (record-predicate module-type)) - - -(define (eval-in-module exp module) - (eval2 exp (module-eval-closure module))) - - -;;; {Module Searching in General} -;;; -;;; We sometimes want to look for properties of a symbol -;;; just within the obarray of one module. If the property -;;; holds, then it is said to hold ``locally'' as in, ``The symbol -;;; DISPLAY is locally rebound in the module `safe-guile'.'' -;;; -;;; -;;; Other times, we want to test for a symbol property in the obarray -;;; of M and, if it is not found there, try each of the modules in the -;;; uses list of M. This is the normal way of testing for some -;;; property, so we state these properties without qualification as -;;; in: ``The symbol 'fnord is interned in module M because it is -;;; interned locally in module M2 which is a member of the uses list -;;; of M.'' -;;; - -;; module-search fn m -;; -;; return the first non-#f result of FN applied to M and then to -;; the modules in the uses of m, and so on recursively. If all applications -;; return #f, then so does this function. -;; -(define (module-search fn m v) - (define (loop pos) - (and (pair? pos) - (or (module-search fn (car pos) v) - (loop (cdr pos))))) - (or (fn m v) - (loop (module-uses m)))) - - -;;; {Is a symbol bound in a module?} -;;; -;;; Symbol S in Module M is bound if S is interned in M and if the binding -;;; of S in M has been set to some well-defined value. -;;; - -;; module-locally-bound? module symbol -;; -;; Is a symbol bound (interned and defined) locally in a given module? -;; -(define (module-locally-bound? m v) - (let ((var (module-local-variable m v))) - (and var - (variable-bound? var)))) - -;; module-bound? module symbol -;; -;; Is a symbol bound (interned and defined) anywhere in a given module -;; or its uses? -;; -(define (module-bound? m v) - (module-search module-locally-bound? m v)) - -;;; {Is a symbol interned in a module?} -;;; -;;; Symbol S in Module M is interned if S occurs in -;;; of S in M has been set to some well-defined value. -;;; -;;; It is possible to intern a symbol in a module without providing -;;; an initial binding for the corresponding variable. This is done -;;; with: -;;; (module-add! module symbol (make-undefined-variable)) -;;; -;;; In that case, the symbol is interned in the module, but not -;;; bound there. The unbound symbol shadows any binding for that -;;; symbol that might otherwise be inherited from a member of the uses list. -;;; - -(define (module-obarray-get-handle ob key) - ((if (symbol? key) hashq-get-handle hash-get-handle) ob key)) - -(define (module-obarray-ref ob key) - ((if (symbol? key) hashq-ref hash-ref) ob key)) - -(define (module-obarray-set! ob key val) - ((if (symbol? key) hashq-set! hash-set!) ob key val)) - -(define (module-obarray-remove! ob key) - ((if (symbol? key) hashq-remove! hash-remove!) ob key)) - -;; module-symbol-locally-interned? module symbol -;; -;; is a symbol interned (not neccessarily defined) locally in a given module -;; or its uses? Interned symbols shadow inherited bindings even if -;; they are not themselves bound to a defined value. -;; -(define (module-symbol-locally-interned? m v) - (not (not (module-obarray-get-handle (module-obarray m) v)))) - -;; module-symbol-interned? module symbol -;; -;; is a symbol interned (not neccessarily defined) anywhere in a given module -;; or its uses? Interned symbols shadow inherited bindings even if -;; they are not themselves bound to a defined value. -;; -(define (module-symbol-interned? m v) - (module-search module-symbol-locally-interned? m v)) - - -;;; {Mapping modules x symbols --> variables} -;;; - -;; module-local-variable module symbol -;; return the local variable associated with a MODULE and SYMBOL. -;; -;;; This function is very important. It is the only function that can -;;; return a variable from a module other than the mutators that store -;;; new variables in modules. Therefore, this function is the location -;;; of the "lazy binder" hack. -;;; -;;; If symbol is defined in MODULE, and if the definition binds symbol -;;; to a variable, return that variable object. -;;; -;;; If the symbols is not found at first, but the module has a lazy binder, -;;; then try the binder. -;;; -;;; If the symbol is not found at all, return #f. -;;; -(define (module-local-variable m v) -; (caddr -; (list m v - (let ((b (module-obarray-ref (module-obarray m) v))) - (or (and (variable? b) b) - (and (module-binder m) - ((module-binder m) m v #f))))) -;)) - -;; module-variable module symbol -;; -;; like module-local-variable, except search the uses in the -;; case V is not found in M. -;; -(define (module-variable m v) - (module-search module-local-variable m v)) - - -;;; {Mapping modules x symbols --> bindings} -;;; -;;; These are similar to the mapping to variables, except that the -;;; variable is dereferenced. -;;; - -;; module-symbol-binding module symbol opt-value -;; -;; return the binding of a variable specified by name within -;; a given module, signalling an error if the variable is unbound. -;; If the OPT-VALUE is passed, then instead of signalling an error, -;; return OPT-VALUE. -;; -(define (module-symbol-local-binding m v . opt-val) - (let ((var (module-local-variable m v))) - (if var - (variable-ref var) - (if (not (null? opt-val)) - (car opt-val) - (error "Locally unbound variable." v))))) - -;; module-symbol-binding module symbol opt-value -;; -;; return the binding of a variable specified by name within -;; a given module, signalling an error if the variable is unbound. -;; If the OPT-VALUE is passed, then instead of signalling an error, -;; return OPT-VALUE. -;; -(define (module-symbol-binding m v . opt-val) - (let ((var (module-variable m v))) - (if var - (variable-ref var) - (if (not (null? opt-val)) - (car opt-val) - (error "Unbound variable." v))))) - - - -;;; {Adding Variables to Modules} -;;; -;;; - - -;; module-make-local-var! module symbol -;; -;; ensure a variable for V in the local namespace of M. -;; If no variable was already there, then create a new and uninitialzied -;; variable. -;; -(define (module-make-local-var! m v) - (or (let ((b (module-obarray-ref (module-obarray m) v))) - (and (variable? b) b)) - (and (module-binder m) - ((module-binder m) m v #t)) - (begin - (let ((answer (make-undefined-variable v))) - (module-obarray-set! (module-obarray m) v answer) - answer)))) - -;; module-add! module symbol var -;; -;; ensure a particular variable for V in the local namespace of M. -;; -(define (module-add! m v var) - (if (not (variable? var)) - (error "Bad variable to module-add!" var)) - (module-obarray-set! (module-obarray m) v var)) - -;; module-remove! -;; -;; make sure that a symbol is undefined in the local namespace of M. -;; -(define (module-remove! m v) - (module-obarray-remove! (module-obarray m) v)) - -(define (module-clear! m) - (vector-fill! (module-obarray m) '())) - -;; MODULE-FOR-EACH -- exported -;; -;; Call PROC on each symbol in MODULE, with arguments of (SYMBOL VARIABLE). -;; -(define (module-for-each proc module) - (let ((obarray (module-obarray module))) - (do ((index 0 (+ index 1)) - (end (vector-length obarray))) - ((= index end)) - (for-each - (lambda (bucket) - (proc (car bucket) (cdr bucket))) - (vector-ref obarray index))))) - - -(define (module-map proc module) - (let* ((obarray (module-obarray module)) - (end (vector-length obarray))) - - (let loop ((i 0) - (answer '())) - (if (= i end) - answer - (loop (+ 1 i) - (append! - (map (lambda (bucket) - (proc (car bucket) (cdr bucket))) - (vector-ref obarray i)) - answer)))))) - - -;;; {Low Level Bootstrapping} -;;; - -;; make-root-module - -;; A root module uses the symhash table (the system's privileged -;; obarray). Being inside a root module is like using SCM without -;; any module system. -;; - - -(define (root-module-closure m s define?) - (let ((bi (and (symbol-interned? #f s) - (builtin-variable s)))) - (and bi - (or define? (variable-bound? bi)) - (begin - (module-add! m s bi) - bi)))) - -(define (make-root-module) - (make-module 1019 '() root-module-closure)) - - -;; make-scm-module - -;; An scm module is a module into which the lazy binder copies -;; variable bindings from the system symhash table. The mapping is -;; one way only; newly introduced bindings in an scm module are not -;; copied back into the system symhash table (and can be used to override -;; bindings from the symhash table). -;; - -(define (make-scm-module) - (make-module 1019 '() - (lambda (m s define?) - (let ((bi (and (symbol-interned? #f s) - (builtin-variable s)))) - (and bi - (variable-bound? bi) - (begin - (module-add! m s bi) - bi)))))) - - - - -;; the-module -;; -(define the-module #f) - -;; scm:eval-transformer -;; -(define scm:eval-transformer #f) - -;; set-current-module module -;; -;; set the current module as viewed by the normalizer. -;; -(define (set-current-module m) - (set! the-module m) - (if m - (begin - (set! *top-level-lookup-closure* (module-eval-closure the-module)) - (set! scm:eval-transformer (module-transformer the-module))) - (set! *top-level-lookup-closure* #f))) - - -;; current-module -;; -;; return the current module as viewed by the normalizer. -;; -(define (current-module) the-module) - -;;; {Module-based Loading} -;;; - -(define (save-module-excursion thunk) - (let ((inner-module (current-module)) - (outer-module #f)) - (dynamic-wind (lambda () - (set! outer-module (current-module)) - (set-current-module inner-module) - (set! inner-module #f)) - thunk - (lambda () - (set! inner-module (current-module)) - (set-current-module outer-module) - (set! outer-module #f))))) - -(define basic-load load) - -(define (load-module filename) - (save-module-excursion - (lambda () - (let ((oldname (and (current-load-port) - (port-filename (current-load-port))))) - (basic-load (if (and oldname - (> (string-length filename) 0) - (not (char=? (string-ref filename 0) #\/)) - (not (string=? (dirname oldname) "."))) - (string-append (dirname oldname) "/" filename) - filename)))))) - - - -;;; {MODULE-REF -- exported} -;; -;; Returns the value of a variable called NAME in MODULE or any of its -;; used modules. If there is no such variable, then if the optional third -;; argument DEFAULT is present, it is returned; otherwise an error is signaled. -;; -(define (module-ref module name . rest) - (let ((variable (module-variable module name))) - (if (and variable (variable-bound? variable)) - (variable-ref variable) - (if (null? rest) - (error "No variable named" name 'in module) - (car rest) ; default value - )))) - -;; MODULE-SET! -- exported -;; -;; Sets the variable called NAME in MODULE (or in a module that MODULE uses) -;; to VALUE; if there is no such variable, an error is signaled. -;; -(define (module-set! module name value) - (let ((variable (module-variable module name))) - (if variable - (variable-set! variable value) - (error "No variable named" name 'in module)))) - -;; MODULE-DEFINE! -- exported -;; -;; Sets the variable called NAME in MODULE to VALUE; if there is no such -;; variable, it is added first. -;; -(define (module-define! module name value) - (let ((variable (module-local-variable module name))) - (if variable - (variable-set! variable value) - (module-add! module name (make-variable value name))))) - -;; MODULE-DEFINED? -- exported -;; -;; Return #t iff NAME is defined in MODULE (or in a module that MODULE -;; uses) -;; -(define (module-defined? module name) - (let ((variable (module-variable module name))) - (and variable (variable-bound? variable)))) - -;; MODULE-USE! module interface -;; -;; Add INTERFACE to the list of interfaces used by MODULE. -;; -(define (module-use! module interface) - (set-module-uses! module - (cons interface (delq! interface (module-uses module))))) - - -;;; {Recursive Namespaces} -;;; -;;; -;;; A hierarchical namespace emerges if we consider some module to be -;;; root, and variables bound to modules as nested namespaces. -;;; -;;; The routines in this file manage variable names in hierarchical namespace. -;;; Each variable name is a list of elements, looked up in successively nested -;;; modules. -;;; -;;; (nested-ref some-root-module '(foo bar baz)) -;;; => <value of a variable named baz in the module bound to bar in -;;; the module bound to foo in some-root-module> -;;; -;;; -;;; There are: -;;; -;;; ;; a-root is a module -;;; ;; name is a list of symbols -;;; -;;; nested-ref a-root name -;;; nested-set! a-root name val -;;; nested-define! a-root name val -;;; nested-remove! a-root name -;;; -;;; -;;; (current-module) is a natural choice for a-root so for convenience there are -;;; also: -;;; -;;; local-ref name == nested-ref (current-module) name -;;; local-set! name val == nested-set! (current-module) name val -;;; local-define! name val == nested-define! (current-module) name val -;;; local-remove! name == nested-remove! (current-module) name -;;; - - -(define (nested-ref root names) - (let loop ((cur root) - (elts names)) - (cond - ((null? elts) cur) - ((not (module? cur)) #f) - (else (loop (module-ref cur (car elts) #f) (cdr elts)))))) - -(define (nested-set! root names val) - (let loop ((cur root) - (elts names)) - (if (null? (cdr elts)) - (module-set! cur (car elts) val) - (loop (module-ref cur (car elts)) (cdr elts))))) - -(define (nested-define! root names val) - (let loop ((cur root) - (elts names)) - (if (null? (cdr elts)) - (module-define! cur (car elts) val) - (loop (module-ref cur (car elts)) (cdr elts))))) - -(define (nested-remove! root names) - (let loop ((cur root) - (elts names)) - (if (null? (cdr elts)) - (module-remove! cur (car elts)) - (loop (module-ref cur (car elts)) (cdr elts))))) - -(define (local-ref names) (nested-ref (current-module) names)) -(define (local-set! names val) (nested-set! (current-module) names val)) -(define (local-define names val) (nested-define! (current-module) names val)) -(define (local-remove names) (nested-remove! (current-module) names)) - - - -;;; {The (app) module} -;;; -;;; The root of conventionally named objects not directly in the top level. -;;; -;;; (app modules) -;;; (app modules guile) -;;; -;;; The directory of all modules and the standard root module. -;;; - -(define (module-public-interface m) (module-ref m '%module-public-interface #f)) -(define (set-module-public-interface! m i) (module-define! m '%module-public-interface i)) -(define the-root-module (make-root-module)) -(define the-scm-module (make-scm-module)) -(set-module-public-interface! the-root-module the-scm-module) -(set-module-name! the-root-module 'the-root-module) -(set-module-name! the-scm-module 'the-scm-module) - -(set-current-module the-root-module) - -(define app (make-module 31)) -(local-define '(app modules) (make-module 31)) -(local-define '(app modules guile) the-root-module) - -;; (define-special-value '(app modules new-ws) (lambda () (make-scm-module))) - -(define (resolve-module name . maybe-autoload) - (let ((full-name (append '(app modules) name))) - (let ((already (local-ref full-name))) - (or already - (begin - (if (or (null? maybe-autoload) (car maybe-autoload)) - (or (try-module-linked name) - (try-module-autoload name) - (try-module-dynamic-link name))) - (make-modules-in (current-module) full-name)))))) - -(define (beautify-user-module! module) - (if (not (module-public-interface module)) - (let ((interface (make-module 31))) - (set-module-name! interface (module-name module)) - (set-module-kind! interface 'interface) - (set-module-public-interface! module interface))) - (if (and (not (memq the-scm-module (module-uses module))) - (not (eq? module the-root-module))) - (set-module-uses! module (append (module-uses module) (list the-scm-module))))) - -(define (make-modules-in module name) - (if (null? name) - module - (cond - ((module-ref module (car name) #f) => (lambda (m) (make-modules-in m (cdr name)))) - (else (let ((m (make-module 31))) - (set-module-kind! m 'directory) - (set-module-name! m (car name)) - (module-define! module (car name) m) - (make-modules-in m (cdr name))))))) - -(define (resolve-interface name) - (let ((module (resolve-module name))) - (and module (module-public-interface module)))) - - -(define %autoloader-developer-mode #t) - -(define (internal-use-syntax transformer) - (set-module-transformer! (current-module) transformer) - (set! scm:eval-transformer transformer)) - -(define (process-define-module args) - (let* ((module-id (car args)) - (module (resolve-module module-id #f)) - (kws (cdr args))) - (beautify-user-module! module) - (let loop ((kws kws) - (reversed-interfaces '())) - (if (null? kws) - (for-each (lambda (interface) - (module-use! module interface)) - reversed-interfaces) - (let ((keyword (cond ((keyword? (car kws)) - (keyword->symbol (car kws))) - ((and (symbol? (car kws)) - (eq? (string-ref (car kws) 0) #\:)) - (string->symbol (substring (car kws) 1))) - (else #f)))) - (case keyword - ((use-module use-syntax) - (if (not (pair? (cdr kws))) - (error "unrecognized defmodule argument" kws)) - (let* ((used-name (cadr kws)) - (used-module (resolve-module used-name))) - (if (not (module-ref used-module '%module-public-interface #f)) - (begin - ((if %autoloader-developer-mode warn error) - "no code for module" (module-name used-module)) - (beautify-user-module! used-module))) - (let ((interface (module-public-interface used-module))) - (if (not interface) - (error "missing interface for use-module" used-module)) - (if (eq? keyword 'use-syntax) - (internal-use-syntax - (module-ref interface (car (last-pair used-name)) - #f))) - (loop (cddr kws) (cons interface reversed-interfaces))))) - (else - (error "unrecognized defmodule argument" kws)))))) - module)) - -;;; {Autoloading modules} - -(define autoloads-in-progress '()) - -(define (try-module-autoload module-name) - - (define (sfx name) (string-append name (scheme-file-suffix))) - (let* ((reverse-name (reverse module-name)) - (name (car reverse-name)) - (dir-hint-module-name (reverse (cdr reverse-name))) - (dir-hint (apply symbol-append (map (lambda (elt) (symbol-append elt "/")) dir-hint-module-name)))) - (resolve-module dir-hint-module-name #f) - (and (not (autoload-done-or-in-progress? dir-hint name)) - (let ((didit #f)) - (dynamic-wind - (lambda () (autoload-in-progress! dir-hint name)) - (lambda () - (let loop ((dirs %load-path)) - (and (not (null? dirs)) - (or - (let ((d (car dirs)) - (trys (list - dir-hint - (sfx dir-hint) - (in-vicinity dir-hint name) - (in-vicinity dir-hint (sfx name))))) - (and (or-map (lambda (f) - (let ((full (in-vicinity d f))) - full - (and (file-exists? full) - (not (file-is-directory? full)) - (begin - (save-module-excursion - (lambda () - (load (string-append - d "/" f)))) - #t)))) - trys) - (begin - (set! didit #t) - #t))) - (loop (cdr dirs)))))) - (lambda () (set-autoloaded! dir-hint name didit))) - didit)))) - -;;; Dynamic linking of modules - -;; Initializing a module that is written in C is a two step process. -;; First the module's `module init' function is called. This function -;; is expected to call `scm_register_module_xxx' to register the `real -;; init' function. Later, when the module is referenced for the first -;; time, this real init function is called in the right context. See -;; gtcltk-lib/gtcltk-module.c for an example. -;; -;; The code for the module can be in a regular shared library (so that -;; the `module init' function will be called when libguile is -;; initialized). Or it can be dynamically linked. -;; -;; You can safely call `scm_register_module_xxx' before libguile -;; itself is initialized. You could call it from an C++ constructor -;; of a static object, for example. -;; -;; To make your Guile extension into a dynamic linkable module, follow -;; these easy steps: -;; -;; - Find a name for your module, like (ice-9 gtcltk) -;; - Write a function with a name like -;; -;; scm_init_ice_9_gtcltk_module -;; -;; This is your `module init' function. It should call -;; -;; scm_register_module_xxx ("ice-9 gtcltk", scm_init_gtcltk); -;; -;; "ice-9 gtcltk" is the C version of the module name. Slashes are -;; replaced by spaces, the rest is untouched. `scm_init_gtcltk' is -;; the real init function that executes the usual initializations -;; like making new smobs, etc. -;; -;; - Make a shared library with your code and a name like -;; -;; ice-9/libgtcltk.so -;; -;; and put it somewhere in %load-path. -;; -;; - Then you can simply write `:use-module (ice-9 gtcltk)' and it -;; will be linked automatically. -;; -;; This is all very experimental. - -(define (split-c-module-name str) - (let loop ((rev '()) - (start 0) - (pos 0) - (end (string-length str))) - (cond - ((= pos end) - (reverse (cons (string->symbol (substring str start pos)) rev))) - ((eq? (string-ref str pos) #\space) - (loop (cons (string->symbol (substring str start pos)) rev) - (+ pos 1) - (+ pos 1) - end)) - (else - (loop rev start (+ pos 1) end))))) - -(define (convert-c-registered-modules dynobj) - (let ((res (map (lambda (c) - (list (split-c-module-name (car c)) (cdr c) dynobj)) - (c-registered-modules)))) - (c-clear-registered-modules) - res)) - -(define registered-modules (convert-c-registered-modules #f)) - -(define (init-dynamic-module modname) - (or-map (lambda (modinfo) - (if (equal? (car modinfo) modname) - (let ((mod (resolve-module modname #f))) - (save-module-excursion - (lambda () - (set-current-module mod) - (dynamic-call (cadr modinfo) (caddr modinfo)) - (set-module-public-interface! mod mod))) - (set! registered-modules (delq! modinfo registered-modules)) - #t) - #f)) - registered-modules)) - -(define (dynamic-maybe-call name dynobj) - (catch #t ; could use false-if-exception here - (lambda () - (dynamic-call name dynobj)) - (lambda args - #f))) - -(define (dynamic-maybe-link filename) - (catch #t ; could use false-if-exception here - (lambda () - (dynamic-link filename)) - (lambda args - #f))) - -(define (find-and-link-dynamic-module module-name) - (define (make-init-name mod-name) - (string-append 'scm_init - (list->string (map (lambda (c) - (if (or (char-alphabetic? c) - (char-numeric? c)) - c - #\_)) - (string->list mod-name))) - '_module)) - - ;; Put the subdirectory for this module in the car of SUBDIR-AND-LIBNAME, - ;; and the `libname' (the name of the module prepended by `lib') in the cdr - ;; field. For example, if MODULE-NAME is the list (inet tcp-ip udp), then - ;; SUBDIR-AND-LIBNAME will be the pair ("inet/tcp-ip" . "libudp"). - (let ((subdir-and-libname - (let loop ((dirs "") - (syms module-name)) - (if (null? (cdr syms)) - (cons dirs (string-append "lib" (car syms))) - (loop (string-append dirs (car syms) "/") (cdr syms))))) - (init (make-init-name (apply string-append - (map (lambda (s) - (string-append "_" s)) - module-name))))) - (let ((subdir (car subdir-and-libname)) - (libname (cdr subdir-and-libname))) - - ;; Now look in each dir in %LOAD-PATH for `subdir/libfoo.la'. If that - ;; file exists, fetch the dlname from that file and attempt to link - ;; against it. If `subdir/libfoo.la' does not exist, or does not seem - ;; to name any shared library, look for `subdir/libfoo.so' instead and - ;; link against that. - (let check-dirs ((dir-list %load-path)) - (if (null? dir-list) - #f - (let* ((dir (in-vicinity (car dir-list) subdir)) - (sharlib-full - (or (try-using-libtool-name dir libname) - (try-using-sharlib-name dir libname)))) - (if (and sharlib-full (file-exists? sharlib-full)) - (link-dynamic-module sharlib-full init) - (check-dirs (cdr dir-list))))))))) - -(define (try-using-libtool-name libdir libname) - (let ((libtool-filename (in-vicinity libdir - (string-append libname ".la")))) - (and (file-exists? libtool-filename) - (with-input-from-file libtool-filename - (lambda () - (let loop ((ln (read-line))) - (cond ((eof-object? ln) #f) - ((and (>= (string-length ln) 8) - (string=? "dlname='" (substring ln 0 8)) - (string-index ln #\' 8)) - => - (lambda (end) - (in-vicinity libdir (substring ln 8 end)))) - (else (loop (read-line)))))))))) - -(define (try-using-sharlib-name libdir libname) - (in-vicinity libdir (string-append libname ".so"))) - -(define (link-dynamic-module filename initname) - (let ((dynobj (dynamic-link filename))) - (dynamic-call initname dynobj) - (set! registered-modules - (append! (convert-c-registered-modules dynobj) - registered-modules)))) - -(define (try-module-linked module-name) - (init-dynamic-module module-name)) - -(define (try-module-dynamic-link module-name) - (and (find-and-link-dynamic-module module-name) - (init-dynamic-module module-name))) - - - -(define autoloads-done '((guile . guile))) - -(define (autoload-done-or-in-progress? p m) - (let ((n (cons p m))) - (->bool (or (member n autoloads-done) - (member n autoloads-in-progress))))) - -(define (autoload-done! p m) - (let ((n (cons p m))) - (set! autoloads-in-progress - (delete! n autoloads-in-progress)) - (or (member n autoloads-done) - (set! autoloads-done (cons n autoloads-done))))) - -(define (autoload-in-progress! p m) - (let ((n (cons p m))) - (set! autoloads-done - (delete! n autoloads-done)) - (set! autoloads-in-progress (cons n autoloads-in-progress)))) - -(define (set-autoloaded! p m done?) - (if done? - (autoload-done! p m) - (let ((n (cons p m))) - (set! autoloads-done (delete! n autoloads-done)) - (set! autoloads-in-progress (delete! n autoloads-in-progress))))) - - - - - -;;; {Macros} -;;; - -(define (primitive-macro? m) - (and (macro? m) - (not (macro-transformer m)))) - -;;; {Defmacros} -;;; -(define macro-table (make-weak-key-hash-table 523)) -(define xformer-table (make-weak-key-hash-table 523)) - -(define (defmacro? m) (hashq-ref macro-table m)) -(define (assert-defmacro?! m) (hashq-set! macro-table m #t)) -(define (defmacro-transformer m) (hashq-ref xformer-table m)) -(define (set-defmacro-transformer! m t) (hashq-set! xformer-table m t)) - -(define defmacro:transformer - (lambda (f) - (let* ((xform (lambda (exp env) - (copy-tree (apply f (cdr exp))))) - (a (procedure->memoizing-macro xform))) - (assert-defmacro?! a) - (set-defmacro-transformer! a f) - a))) - - -(define defmacro - (let ((defmacro-transformer - (lambda (name parms . body) - (let ((transformer `(lambda ,parms ,@body))) - `(define ,name - (,(lambda (transformer) - (defmacro:transformer transformer)) - ,transformer)))))) - (defmacro:transformer defmacro-transformer))) - -(define defmacro:syntax-transformer - (lambda (f) - (procedure->syntax - (lambda (exp env) - (copy-tree (apply f (cdr exp))))))) - - -;; XXX - should the definition of the car really be looked up in the -;; current module? - -(define (macroexpand-1 e) - (cond - ((pair? e) (let* ((a (car e)) - (val (and (symbol? a) (local-ref (list a))))) - (if (defmacro? val) - (apply (defmacro-transformer val) (cdr e)) - e))) - (#t e))) - -(define (macroexpand e) - (cond - ((pair? e) (let* ((a (car e)) - (val (and (symbol? a) (local-ref (list a))))) - (if (defmacro? val) - (macroexpand (apply (defmacro-transformer val) (cdr e))) - e))) - (#t e))) - -(define (gentemp) - (gensym "scm:G")) - -(provide 'defmacro) - - - -;;; {Run-time options} - -((let* ((names '((eval-options-interface - (eval-options eval-enable eval-disable) - (eval-set!)) - - (debug-options-interface - (debug-options debug-enable debug-disable) - (debug-set!)) - - (evaluator-traps-interface - (traps trap-enable trap-disable) - (trap-set!)) - - (read-options-interface - (read-options read-enable read-disable) - (read-set!)) - - (print-options-interface - (print-options print-enable print-disable) - (print-set!)) - )) - (option-name car) - (option-value cadr) - (option-documentation caddr) - - (print-option (lambda (option) - (display (option-name option)) - (if (< (string-length - (symbol->string (option-name option))) - 8) - (display #\tab)) - (display #\tab) - (display (option-value option)) - (display #\tab) - (display (option-documentation option)) - (newline))) - - ;; Below follows the macros defining the run-time option interfaces. - - (make-options (lambda (interface) - `(lambda args - (cond ((null? args) (,interface)) - ((list? (car args)) - (,interface (car args)) (,interface)) - (else (for-each ,print-option - (,interface #t))))))) - - (make-enable (lambda (interface) - `(lambda flags - (,interface (append flags (,interface))) - (,interface)))) - - (make-disable (lambda (interface) - `(lambda flags - (let ((options (,interface))) - (for-each (lambda (flag) - (set! options (delq! flag options))) - flags) - (,interface options) - (,interface))))) - - (make-set! (lambda (interface) - `((name exp) - (,'quasiquote - (begin (,interface (append (,interface) - (list '(,'unquote name) - (,'unquote exp)))) - (,interface)))))) - ) - (procedure->macro - (lambda (exp env) - (cons 'begin - (apply append - (map (lambda (group) - (let ((interface (car group))) - (append (map (lambda (name constructor) - `(define ,name - ,(constructor interface))) - (cadr group) - (list make-options - make-enable - make-disable)) - (map (lambda (name constructor) - `(defmacro ,name - ,@(constructor interface))) - (caddr group) - (list make-set!))))) - names))))))) - - - -;;; {Running Repls} -;;; - -(define (repl read evaler print) - (let loop ((source (read (current-input-port)))) - (print (evaler source)) - (loop (read (current-input-port))))) - -;; A provisional repl that acts like the SCM repl: -;; -(define scm-repl-silent #f) -(define (assert-repl-silence v) (set! scm-repl-silent v)) - -(define *unspecified* (if #f #f)) -(define (unspecified? v) (eq? v *unspecified*)) - -(define scm-repl-print-unspecified #f) -(define (assert-repl-print-unspecified v) (set! scm-repl-print-unspecified v)) - -(define scm-repl-verbose #f) -(define (assert-repl-verbosity v) (set! scm-repl-verbose v)) - -(define scm-repl-prompt "guile> ") - -(define (set-repl-prompt! v) (set! scm-repl-prompt v)) - -(define (default-lazy-handler key . args) - (save-stack lazy-handler-dispatch) - (apply throw key args)) - -(define enter-frame-handler default-lazy-handler) -(define apply-frame-handler default-lazy-handler) -(define exit-frame-handler default-lazy-handler) - -(define (lazy-handler-dispatch key . args) - (case key - ((apply-frame) - (apply apply-frame-handler key args)) - ((exit-frame) - (apply exit-frame-handler key args)) - ((enter-frame) - (apply enter-frame-handler key args)) - (else - (apply default-lazy-handler key args)))) - -(define abort-hook '()) - -;; these definitions are used if running a script. -;; otherwise redefined in error-catching-loop. -(define (set-batch-mode?! arg) #t) -(define (batch-mode?) #t) - -(define (error-catching-loop thunk) - (let ((status #f) - (interactive #t)) - (set! set-batch-mode?! (lambda (arg) - (cond (arg - (set! interactive #f) - (restore-signals)) - (#t - (error "sorry, not implemented"))))) - (set! batch-mode? (lambda () (not interactive))) - (define (loop first) - (let ((next - (catch #t - - (lambda () - (lazy-catch #t - (lambda () - (dynamic-wind - (lambda () (unmask-signals)) - (lambda () - (with-traps - (lambda () - (first) - - ;; This line is needed because mark - ;; doesn't do closures quite right. - ;; Unreferenced locals should be - ;; collected. - ;; - (set! first #f) - (let loop ((v (thunk))) - (loop (thunk))) - #f))) - (lambda () (mask-signals)))) - - lazy-handler-dispatch)) - - (lambda (key . args) - (case key - ((quit) - (force-output) - (set! status args) - #f) - - ((switch-repl) - (apply throw 'switch-repl args)) - - ((abort) - ;; This is one of the closures that require - ;; (set! first #f) above - ;; - (lambda () - (run-hooks abort-hook) - (force-output) - (display "ABORT: " (current-error-port)) - (write args (current-error-port)) - (newline (current-error-port)) - (if interactive - (if (and (not has-shown-debugger-hint?) - (not (memq 'backtrace - (debug-options-interface))) - (stack? (fluid-ref the-last-stack))) - (begin - (newline (current-error-port)) - (display - "Type \"(backtrace)\" to get more information.\n" - (current-error-port)) - (set! has-shown-debugger-hint? #t))) - (primitive-exit 1)) - (set! stack-saved? #f))) - - (else - ;; This is the other cons-leak closure... - (lambda () - (cond ((= (length args) 4) - (apply handle-system-error key args)) - (else - (apply bad-throw key args)))))))))) - (if next (loop next) status))) - (loop (lambda () #t)))) - -;;(define the-last-stack (make-fluid)) Defined by scm_init_backtrace () -(define stack-saved? #f) - -(define (save-stack . narrowing) - (cond (stack-saved?) - ((not (memq 'debug (debug-options-interface))) - (fluid-set! the-last-stack #f) - (set! stack-saved? #t)) - (else - (fluid-set! - the-last-stack - (case (stack-id #t) - ((repl-stack) - (apply make-stack #t save-stack eval narrowing)) - ((load-stack) - (apply make-stack #t save-stack 0 narrowing)) - ((tk-stack) - (apply make-stack #t save-stack tk-stack-mark narrowing)) - ((#t) - (apply make-stack #t save-stack 0 1 narrowing)) - (else (let ((id (stack-id #t))) - (and (procedure? id) - (apply make-stack #t save-stack id narrowing)))))) - (set! stack-saved? #t)))) - -(define before-error-hook '()) -(define after-error-hook '()) -(define before-backtrace-hook '()) -(define after-backtrace-hook '()) - -(define has-shown-debugger-hint? #f) - -(define (handle-system-error key . args) - (let ((cep (current-error-port))) - (cond ((not (stack? (fluid-ref the-last-stack)))) - ((memq 'backtrace (debug-options-interface)) - (run-hooks before-backtrace-hook) - (newline cep) - (display-backtrace (fluid-ref the-last-stack) cep) - (newline cep) - (run-hooks after-backtrace-hook))) - (run-hooks before-error-hook) - (apply display-error (fluid-ref the-last-stack) cep args) - (run-hooks after-error-hook) - (force-output cep) - (throw 'abort key))) - -(define (quit . args) - (apply throw 'quit args)) - -(define exit quit) - -;;(define has-shown-backtrace-hint? #f) Defined by scm_init_backtrace () - -;; Replaced by C code: -;;(define (backtrace) -;; (if (fluid-ref the-last-stack) -;; (begin -;; (newline) -;; (display-backtrace (fluid-ref the-last-stack) (current-output-port)) -;; (newline) -;; (if (and (not has-shown-backtrace-hint?) -;; (not (memq 'backtrace (debug-options-interface)))) -;; (begin -;; (display -;;"Type \"(debug-enable 'backtrace)\" if you would like a backtrace -;;automatically if an error occurs in the future.\n") -;; (set! has-shown-backtrace-hint? #t)))) -;; (display "No backtrace available.\n"))) - -(define (error-catching-repl r e p) - (error-catching-loop (lambda () (p (e (r)))))) - -(define (gc-run-time) - (cdr (assq 'gc-time-taken (gc-stats)))) - -(define before-read-hook '()) -(define after-read-hook '()) - -;;; The default repl-reader function. We may override this if we've -;;; the readline library. -(define repl-reader - (lambda (prompt) - (display prompt) - (force-output) - (run-hooks before-read-hook) - (read (current-input-port)))) - -(define (scm-style-repl) - (letrec ( - (start-gc-rt #f) - (start-rt #f) - (repl-report-start-timing (lambda () - (set! start-gc-rt (gc-run-time)) - (set! start-rt (get-internal-run-time)))) - (repl-report (lambda () - (display ";;; ") - (display (inexact->exact - (* 1000 (/ (- (get-internal-run-time) start-rt) - internal-time-units-per-second)))) - (display " msec (") - (display (inexact->exact - (* 1000 (/ (- (gc-run-time) start-gc-rt) - internal-time-units-per-second)))) - (display " msec in gc)\n"))) - - (consume-trailing-whitespace - (lambda () - (let ((ch (peek-char))) - (cond - ((eof-object? ch)) - ((or (char=? ch #\space) (char=? ch #\tab)) - (read-char) - (consume-trailing-whitespace)) - ((char=? ch #\newline) - (read-char)))))) - (-read (lambda () - (let ((val - (let ((prompt (cond ((string? scm-repl-prompt) - scm-repl-prompt) - ((thunk? scm-repl-prompt) - (scm-repl-prompt)) - (scm-repl-prompt "> ") - (else "")))) - (repl-reader prompt)))) - - ;; As described in R4RS, the READ procedure updates the - ;; port to point to the first characetr past the end of - ;; the external representation of the object. This - ;; means that it doesn't consume the newline typically - ;; found after an expression. This means that, when - ;; debugging Guile with GDB, GDB gets the newline, which - ;; it often interprets as a "continue" command, making - ;; breakpoints kind of useless. So, consume any - ;; trailing newline here, as well as any whitespace - ;; before it. - (consume-trailing-whitespace) - (run-hooks after-read-hook) - (if (eof-object? val) - (begin - (repl-report-start-timing) - (if scm-repl-verbose - (begin - (newline) - (display ";;; EOF -- quitting") - (newline))) - (quit 0))) - val))) - - (-eval (lambda (sourc) - (repl-report-start-timing) - (start-stack 'repl-stack (eval sourc)))) - - (-print (lambda (result) - (if (not scm-repl-silent) - (begin - (if (or scm-repl-print-unspecified - (not (unspecified? result))) - (begin - (write result) - (newline))) - (if scm-repl-verbose - (repl-report)) - (force-output))))) - - (-quit (lambda (args) - (if scm-repl-verbose - (begin - (display ";;; QUIT executed, repl exitting") - (newline) - (repl-report))) - args)) - - (-abort (lambda () - (if scm-repl-verbose - (begin - (display ";;; ABORT executed.") - (newline) - (repl-report))) - (repl -read -eval -print)))) - - (let ((status (error-catching-repl -read - -eval - -print))) - (-quit status)))) - - - -;;; {IOTA functions: generating lists of numbers} - -(define (reverse-iota n) (if (> n 0) (cons (1- n) (reverse-iota (1- n))) '())) -(define (iota n) (reverse! (reverse-iota n))) - - -;;; {While} -;;; -;;; with `continue' and `break'. -;;; - -(defmacro while (cond . body) - `(letrec ((continue (lambda () (or (not ,cond) (begin (begin ,@ body) (continue))))) - (break (lambda val (apply throw 'break val)))) - (catch 'break - (lambda () (continue)) - (lambda v (cadr v))))) - - -;;; {with-fluids} - -;; with-fluids is a convenience wrapper for the builtin procedure -;; `with-fluids*'. The syntax is just like `let': -;; -;; (with-fluids ((fluid val) -;; ...) -;; body) - -(defmacro with-fluids (bindings . body) - `(with-fluids* (list ,@(map car bindings)) (list ,@(map cadr bindings)) - (lambda () ,@body))) - - - -;;; {Macros} -;;; - -;; actually....hobbit might be able to hack these with a little -;; coaxing -;; - -(defmacro define-macro (first . rest) - (let ((name (if (symbol? first) first (car first))) - (transformer - (if (symbol? first) - (car rest) - `(lambda ,(cdr first) ,@rest)))) - `(define ,name (defmacro:transformer ,transformer)))) - - -(defmacro define-syntax-macro (first . rest) - (let ((name (if (symbol? first) first (car first))) - (transformer - (if (symbol? first) - (car rest) - `(lambda ,(cdr first) ,@rest)))) - `(define ,name (defmacro:syntax-transformer ,transformer)))) - -;;; {Module System Macros} -;;; - -(defmacro define-module args - `(let* ((process-define-module process-define-module) - (set-current-module set-current-module) - (module (process-define-module ',args))) - (set-current-module module) - module)) - -;; the guts of the use-modules macro. add the interfaces of the named -;; modules to the use-list of the current module, in order -(define (process-use-modules module-names) - (for-each (lambda (module-name) - (let ((mod-iface (resolve-interface module-name))) - (or mod-iface - (error "no such module" module-name)) - (module-use! (current-module) mod-iface))) - (reverse module-names))) - -(defmacro use-modules modules - `(process-use-modules ',modules)) - -(defmacro use-syntax (spec) - (if (pair? spec) - `(begin - (process-use-modules ',(list spec)) - (internal-use-syntax ,(car (last-pair spec)))) - `(internal-use-syntax ,spec))) - -(define define-private define) - -(defmacro define-public args - (define (syntax) - (error "bad syntax" (list 'define-public args))) - (define (defined-name n) - (cond - ((symbol? n) n) - ((pair? n) (defined-name (car n))) - (else (syntax)))) - (cond - ((null? args) (syntax)) - - (#t (let ((name (defined-name (car args)))) - `(begin - (let ((public-i (module-public-interface (current-module)))) - ;; Make sure there is a local variable: - ;; - (module-define! (current-module) - ',name - (module-ref (current-module) ',name #f)) - - ;; Make sure that local is exported: - ;; - (module-add! public-i ',name - (module-variable (current-module) ',name))) - - ;; Now (re)define the var normally. Bernard URBAN - ;; suggests we use eval here to accomodate Hobbit; it lets - ;; the interpreter handle the define-private form, which - ;; Hobbit can't digest. - (eval '(define-private ,@ args))))))) - - - -(defmacro defmacro-public args - (define (syntax) - (error "bad syntax" (list 'defmacro-public args))) - (define (defined-name n) - (cond - ((symbol? n) n) - (else (syntax)))) - (cond - ((null? args) (syntax)) - - (#t (let ((name (defined-name (car args)))) - `(begin - (let ((public-i (module-public-interface (current-module)))) - ;; Make sure there is a local variable: - ;; - (module-define! (current-module) - ',name - (module-ref (current-module) ',name #f)) - - ;; Make sure that local is exported: - ;; - (module-add! public-i ',name (module-variable (current-module) ',name))) - - ;; Now (re)define the var normally. - ;; - (defmacro ,@ args)))))) - - -(defmacro export names - `(let* ((m (current-module)) - (public-i (module-public-interface m))) - (for-each (lambda (name) - ;; Make sure there is a local variable: - (module-define! m name (module-ref m name #f)) - ;; Make sure that local is exported: - (module-add! public-i name (module-variable m name))) - ',names))) - -(define export-syntax export) - - - - -(define load load-module) - - - -;;; {I/O functions for Tcl channels (disabled)} - -;; (define in-ch (get-standard-channel TCL_STDIN)) -;; (define out-ch (get-standard-channel TCL_STDOUT)) -;; (define err-ch (get-standard-channel TCL_STDERR)) -;; -;; (define inp (%make-channel-port in-ch "r")) -;; (define outp (%make-channel-port out-ch "w")) -;; (define errp (%make-channel-port err-ch "w")) -;; -;; (define %system-char-ready? char-ready?) -;; -;; (define (char-ready? p) -;; (if (not (channel-port? p)) -;; (%system-char-ready? p) -;; (let* ((channel (%channel-port-channel p)) -;; (old-blocking (channel-option-ref channel :blocking))) -;; (dynamic-wind -;; (lambda () (set-channel-option the-root-tcl-interpreter channel :blocking "0")) -;; (lambda () (not (eof-object? (peek-char p)))) -;; (lambda () (set-channel-option the-root-tcl-interpreter channel :blocking old-blocking)))))) -;; -;; (define (top-repl) -;; (with-input-from-port inp -;; (lambda () -;; (with-output-to-port outp -;; (lambda () -;; (with-error-to-port errp -;; (lambda () -;; (scm-style-repl)))))))) -;; -;; (set-current-input-port inp) -;; (set-current-output-port outp) -;; (set-current-error-port errp) - -;; this is just (scm-style-repl) with a wrapper to install and remove -;; signal handlers. -(define (top-repl) - (let ((old-handlers #f) - (signals `((,SIGINT . "User interrupt") - (,SIGFPE . "Arithmetic error") - (,SIGBUS . "Bad memory access (bus error)") - (,SIGSEGV . "Bad memory access (Segmentation violation)")))) - - (dynamic-wind - - ;; call at entry - (lambda () - (let ((make-handler (lambda (msg) - (lambda (sig) - (save-stack %deliver-signals) - (scm-error 'signal - #f - msg - #f - (list sig)))))) - (set! old-handlers - (map (lambda (sig-msg) - (sigaction (car sig-msg) - (make-handler (cdr sig-msg)))) - signals)))) - - ;; the protected thunk. - (lambda () - - ;; If we've got readline, use it to prompt the user. This is a - ;; kludge, but we'll fix it soon. At least we only get - ;; readline involved when we're actually running the repl. - (if (and (memq 'readline *features*) - (isatty? (current-input-port)) - (not (and (module-defined? the-root-module - 'use-emacs-interface) - use-emacs-interface))) - (let ((read-hook (lambda () (run-hooks before-read-hook)))) - (set-current-input-port (readline-port)) - (set! repl-reader - (lambda (prompt) - (dynamic-wind - (lambda () - (set-readline-prompt! prompt) - (set-readline-read-hook! read-hook)) - (lambda () (read)) - (lambda () - (set-readline-prompt! "") - (set-readline-read-hook! #f))))))) - (scm-style-repl)) - - ;; call at exit. - (lambda () - (map (lambda (sig-msg old-handler) - (if (not (car old-handler)) - ;; restore original C handler. - (sigaction (car sig-msg) #f) - ;; restore Scheme handler, SIG_IGN or SIG_DFL. - (sigaction (car sig-msg) - (car old-handler) - (cdr old-handler)))) - signals old-handlers))))) - -(defmacro false-if-exception (expr) - `(catch #t (lambda () ,expr) - (lambda args #f))) - -;;; Load readline code into root module if readline primitives are available. -;;; -;;; Ideally, we wouldn't do this until we were sure we were actually -;;; going to enter the repl, but autoloading individual functions is -;;; clumsy at the moment. -(if (and (memq 'readline *features*) - (isatty? (current-input-port))) - (begin - (define-module (guile) :use-module (ice-9 readline)) - (define-module (guile-user) :use-module (ice-9 readline)))) - - -;;; {Load debug extension code into user module if debug extensions present.} -;;; -;;; *fixme* This is a temporary solution. -;;; - -(if (memq 'debug-extensions *features*) - (define-module (guile-user) :use-module (ice-9 debug))) - - -;;; {Load session support into user module if present.} -;;; -;;; *fixme* This is a temporary solution. -;;; - -(if (%search-load-path "ice-9/session.scm") - (define-module (guile-user) :use-module (ice-9 session))) - -;;; {Load thread code into user module if threads are present.} -;;; -;;; *fixme* This is a temporary solution. -;;; - -(if (memq 'threads *features*) - (define-module (guile-user) :use-module (ice-9 threads))) - - -;;; {Load emacs interface support if emacs option is given.} -;;; -;;; *fixme* This is a temporary solution. -;;; - -(if (and (module-defined? the-root-module 'use-emacs-interface) - use-emacs-interface) - (begin - (if (memq 'debug-extensions *features*) - (debug-enable 'backtrace)) - (define-module (guile-user) :use-module (ice-9 emacs)))) - - -;;; {Load regexp code if regexp primitives are available.} - -(if (memq 'regex *features*) - (define-module (guile-user) :use-module (ice-9 regex))) - - -(define-module (guile)) - -;;; {Check that the interpreter and scheme code match up.} - -(let ((show-line - (lambda args - (with-output-to-port (current-error-port) - (lambda () - (display (car (command-line))) - (display ": ") - (for-each (lambda (string) (display string)) - args) - (newline)))))) - - (load-from-path "ice-9/version.scm") - - (if (not (string=? - (libguile-config-stamp) ; from the interprpreter - (ice-9-config-stamp))) ; from the Scheme code - (begin - (show-line "warning: different versions of libguile and ice-9:") - (show-line "libguile: configured on " (libguile-config-stamp)) - (show-line "ice-9: configured on " (ice-9-config-stamp))))) - -(append! %load-path (cons "." ())) - - - -(define-module (guile-user)) diff --git a/ice-9/calling.scm b/ice-9/calling.scm deleted file mode 100644 index 2e3aa9c3f..000000000 --- a/ice-9/calling.scm +++ /dev/null @@ -1,322 +0,0 @@ -;;;; calling.scm --- Calling Conventions -;;;; -;;;; Copyright (C) 1995, 1996, 1997 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., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA -;;;; - -(define-module (ice-9 calling)) - -;;;; -;;; -;;; This file contains a number of macros that support -;;; common calling conventions. - -;;; -;;; with-excursion-function <vars> proc -;;; <vars> is an unevaluated list of names that are bound in the caller. -;;; proc is a procedure, called: -;;; (proc excursion) -;;; -;;; excursion is a procedure isolates all changes to <vars> -;;; in the dynamic scope of the call to proc. In other words, -;;; the values of <vars> are saved when proc is entered, and when -;;; proc returns, those values are restored. Values are also restored -;;; entering and leaving the call to proc non-locally, such as using -;;; call-with-current-continuation, error, or throw. -;;; -(defmacro-public with-excursion-function (vars proc) - `(,proc ,(excursion-function-syntax vars))) - - - -;;; with-getter-and-setter <vars> proc -;;; <vars> is an unevaluated list of names that are bound in the caller. -;;; proc is a procedure, called: -;;; (proc getter setter) -;;; -;;; getter and setter are procedures used to access -;;; or modify <vars>. -;;; -;;; setter, called with keywords arguments, modifies the named -;;; values. If "foo" and "bar" are among <vars>, then: -;;; -;;; (setter :foo 1 :bar 2) -;;; == (set! foo 1 bar 2) -;;; -;;; getter, called with just keywords, returns -;;; a list of the corresponding values. For example, -;;; if "foo" and "bar" are among the <vars>, then -;;; -;;; (getter :foo :bar) -;;; => (<value-of-foo> <value-of-bar>) -;;; -;;; getter, called with no arguments, returns a list of all accepted -;;; keywords and the corresponding values. If "foo" and "bar" are -;;; the *only* <vars>, then: -;;; -;;; (getter) -;;; => (:foo <value-of-bar> :bar <value-of-foo>) -;;; -;;; The unusual calling sequence of a getter supports too handy -;;; idioms: -;;; -;;; (apply setter (getter)) ;; save and restore -;;; -;;; (apply-to-args (getter :foo :bar) ;; fetch and bind -;;; (lambda (foo bar) ....)) -;;; -;;; ;; [ "apply-to-args" is just like two-argument "apply" except that it -;;; ;; takes its arguments in a different order. -;;; -;;; -(defmacro-public with-getter-and-setter (vars proc) - `(,proc ,@ (getter-and-setter-syntax vars))) - -;;; with-getter vars proc -;;; A short-hand for a call to with-getter-and-setter. -;;; The procedure is called: -;;; (proc getter) -;;; -(defmacro-public with-getter (vars proc) - `(,proc ,(car (getter-and-setter-syntax vars)))) - - -;;; with-delegating-getter-and-setter <vars> get-delegate set-delegate proc -;;; Compose getters and setters. -;;; -;;; <vars> is an unevaluated list of names that are bound in the caller. -;;; -;;; get-delegate is called by the new getter to extend the set of -;;; gettable variables beyond just <vars> -;;; set-delegate is called by the new setter to extend the set of -;;; gettable variables beyond just <vars> -;;; -;;; proc is a procedure that is called -;;; (proc getter setter) -;;; -(defmacro-public with-delegating-getter-and-setter (vars get-delegate set-delegate proc) - `(,proc ,@ (delegating-getter-and-setter-syntax vars get-delegate set-delegate))) - - -;;; with-excursion-getter-and-setter <vars> proc -;;; <vars> is an unevaluated list of names that are bound in the caller. -;;; proc is called: -;;; -;;; (proc excursion getter setter) -;;; -;;; See also: -;;; with-getter-and-setter -;;; with-excursion-function -;;; -(defmacro-public with-excursion-getter-and-setter (vars proc) - `(,proc ,(excursion-function-syntax vars) - ,@ (getter-and-setter-syntax vars))) - - -(define (excursion-function-syntax vars) - (let ((saved-value-names (map gensym vars)) - (tmp-var-name (gensym 'temp)) - (swap-fn-name (gensym 'swap)) - (thunk-name (gensym 'thunk))) - `(lambda (,thunk-name) - (letrec ((,tmp-var-name #f) - (,swap-fn-name - (lambda () ,@ (map (lambda (n sn) - `(begin (set! ,tmp-var-name ,n) - (set! ,n ,sn) - (set! ,sn ,tmp-var-name))) - vars saved-value-names))) - ,@ (map (lambda (sn n) `(,sn ,n)) saved-value-names vars)) - (dynamic-wind - ,swap-fn-name - ,thunk-name - ,swap-fn-name))))) - - -(define (getter-and-setter-syntax vars) - (let ((args-name (gensym 'args)) - (an-arg-name (gensym 'an-arg)) - (new-val-name (gensym 'new-value)) - (loop-name (gensym 'loop)) - (kws (map symbol->keyword vars))) - (list `(lambda ,args-name - (let ,loop-name ((,args-name ,args-name)) - (if (null? ,args-name) - ,(if (null? kws) - ''() - `(let ((all-vals (,loop-name ',kws))) - (let ,loop-name ((vals all-vals) - (kws ',kws)) - (if (null? vals) - '() - `(,(car kws) ,(car vals) ,@(,loop-name (cdr vals) (cdr kws))))))) - (map (lambda (,an-arg-name) - (case ,an-arg-name - ,@ (append - (map (lambda (kw v) `((,kw) ,v)) kws vars) - `((else (throw 'bad-get-option ,an-arg-name)))))) - ,args-name)))) - - `(lambda ,args-name - (let ,loop-name ((,args-name ,args-name)) - (or (null? ,args-name) - (null? (cdr ,args-name)) - (let ((,an-arg-name (car ,args-name)) - (,new-val-name (cadr ,args-name))) - (case ,an-arg-name - ,@ (append - (map (lambda (kw v) `((,kw) (set! ,v ,new-val-name))) kws vars) - `((else (throw 'bad-set-option ,an-arg-name))))) - (,loop-name (cddr ,args-name))))))))) - -(define (delegating-getter-and-setter-syntax vars get-delegate set-delegate) - (let ((args-name (gensym 'args)) - (an-arg-name (gensym 'an-arg)) - (new-val-name (gensym 'new-value)) - (loop-name (gensym 'loop)) - (kws (map symbol->keyword vars))) - (list `(lambda ,args-name - (let ,loop-name ((,args-name ,args-name)) - (if (null? ,args-name) - (append! - ,(if (null? kws) - ''() - `(let ((all-vals (,loop-name ',kws))) - (let ,loop-name ((vals all-vals) - (kws ',kws)) - (if (null? vals) - '() - `(,(car kws) ,(car vals) ,@(,loop-name (cdr vals) (cdr kws))))))) - (,get-delegate)) - (map (lambda (,an-arg-name) - (case ,an-arg-name - ,@ (append - (map (lambda (kw v) `((,kw) ,v)) kws vars) - `((else (car (,get-delegate ,an-arg-name))))))) - ,args-name)))) - - `(lambda ,args-name - (let ,loop-name ((,args-name ,args-name)) - (or (null? ,args-name) - (null? (cdr ,args-name)) - (let ((,an-arg-name (car ,args-name)) - (,new-val-name (cadr ,args-name))) - (case ,an-arg-name - ,@ (append - (map (lambda (kw v) `((,kw) (set! ,v ,new-val-name))) kws vars) - `((else (,set-delegate ,an-arg-name ,new-val-name))))) - (,loop-name (cddr ,args-name))))))))) - - - - -;;; with-configuration-getter-and-setter <vars-etc> proc -;;; -;;; Create a getter and setter that can trigger arbitrary computation. -;;; -;;; <vars-etc> is a list of variable specifiers, explained below. -;;; proc is called: -;;; -;;; (proc getter setter) -;;; -;;; Each element of the <vars-etc> list is of the form: -;;; -;;; (<var> getter-hook setter-hook) -;;; -;;; Both hook elements are evaluated; the variable name is not. -;;; Either hook may be #f or procedure. -;;; -;;; A getter hook is a thunk that returns a value for the corresponding -;;; variable. If omitted (#f is passed), the binding of <var> is -;;; returned. -;;; -;;; A setter hook is a procedure of one argument that accepts a new value -;;; for the corresponding variable. If omitted, the binding of <var> -;;; is simply set using set!. -;;; -(defmacro-public with-configuration-getter-and-setter (vars-etc proc) - `((lambda (simpler-get simpler-set body-proc) - (with-delegating-getter-and-setter () - simpler-get simpler-set body-proc)) - - (lambda (kw) - (case kw - ,@(map (lambda (v) `((,(symbol->keyword (car v))) - ,(cond - ((cadr v) => list) - (else `(list ,(car v)))))) - vars-etc))) - - (lambda (kw new-val) - (case kw - ,@(map (lambda (v) `((,(symbol->keyword (car v))) - ,(cond - ((caddr v) => (lambda (proc) `(,proc new-val))) - (else `(set! ,(car v) new-val))))) - vars-etc))) - - ,proc)) - -(defmacro-public with-delegating-configuration-getter-and-setter (vars-etc delegate-get delegate-set proc) - `((lambda (simpler-get simpler-set body-proc) - (with-delegating-getter-and-setter () - simpler-get simpler-set body-proc)) - - (lambda (kw) - (case kw - ,@(append! (map (lambda (v) `((,(symbol->keyword (car v))) - ,(cond - ((cadr v) => list) - (else `(list ,(car v)))))) - vars-etc) - `((else (,delegate-get kw)))))) - - (lambda (kw new-val) - (case kw - ,@(append! (map (lambda (v) `((,(symbol->keyword (car v))) - ,(cond - ((caddr v) => (lambda (proc) `(,proc new-val))) - (else `(set! ,(car v) new-val))))) - vars-etc) - `((else (,delegate-set kw new-val)))))) - - ,proc)) - - -;;; let-configuration-getter-and-setter <vars-etc> proc -;;; -;;; This procedure is like with-configuration-getter-and-setter (q.v.) -;;; except that each element of <vars-etc> is: -;;; -;;; (<var> initial-value getter-hook setter-hook) -;;; -;;; Unlike with-configuration-getter-and-setter, let-configuration-getter-and-setter -;;; introduces bindings for the variables named in <vars-etc>. -;;; It is short-hand for: -;;; -;;; (let ((<var1> initial-value-1) -;;; (<var2> initial-value-2) -;;; ...) -;;; (with-configuration-getter-and-setter ((<var1> v1-get v1-set) ...) proc)) -;;; -(defmacro-public let-with-configuration-getter-and-setter (vars-etc proc) - `(let ,(map (lambda (v) `(,(car v) ,(cadr v))) vars-etc) - (with-configuration-getter-and-setter ,(map (lambda (v) `(,(car v) ,(caddr v) ,(cadddr v))) vars-etc) - ,proc))) - - - diff --git a/ice-9/common-list.scm b/ice-9/common-list.scm deleted file mode 100644 index 70f13fc81..000000000 --- a/ice-9/common-list.scm +++ /dev/null @@ -1,191 +0,0 @@ -;;;; common-list.scm --- COMMON LISP list functions for Scheme -;;;; -;;;; Copyright (C) 1995, 1996, 1997 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., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA -;;;; - -(define-module (ice-9 common-list)) - -;;"comlist.scm" Implementation of COMMON LISP list functions for Scheme -; Copyright (C) 1991, 1993, 1995 Aubrey Jaffer. -; -;Permission to copy this software, to redistribute it, and to use it -;for any purpose is granted, subject to the following restrictions and -;understandings. -; -;1. Any copy made of this software must include this copyright notice -;in full. -; -;2. I have made no warrantee or representation that the operation of -;this software will be error-free, and I am under no obligation to -;provide any services, by way of maintenance, update, or otherwise. -; -;3. In conjunction with products arising from the use of this -;material, there shall be no use of my name in any advertising, -;promotional, or sales literature without prior written consent in -;each case. - -(define-public (adjoin e l) (if (memq e l) l (cons e l))) - -(define-public (union l1 l2) - (cond ((null? l1) l2) - ((null? l2) l1) - (else (union (cdr l1) (adjoin (car l1) l2))))) - -(define-public (intersection l1 l2) - (cond ((null? l1) l1) - ((null? l2) l2) - ((memv (car l1) l2) (cons (car l1) (intersection (cdr l1) l2))) - (else (intersection (cdr l1) l2)))) - -(define-public (set-difference l1 l2) - (cond ((null? l1) l1) - ((memv (car l1) l2) (set-difference (cdr l1) l2)) - (else (cons (car l1) (set-difference (cdr l1) l2))))) - -(define-public (reduce-init p init l) - (if (null? l) - init - (reduce-init p (p init (car l)) (cdr l)))) - -(define-public (reduce p l) - (cond ((null? l) l) - ((null? (cdr l)) (car l)) - (else (reduce-init p (car l) (cdr l))))) - -(define-public (some pred l . rest) - (cond ((null? rest) - (let mapf ((l l)) - (and (not (null? l)) - (or (pred (car l)) (mapf (cdr l)))))) - (else (let mapf ((l l) (rest rest)) - (and (not (null? l)) - (or (apply pred (car l) (map car rest)) - (mapf (cdr l) (map cdr rest)))))))) - -(define-public (every pred l . rest) - (cond ((null? rest) - (let mapf ((l l)) - (or (null? l) - (and (pred (car l)) (mapf (cdr l)))))) - (else (let mapf ((l l) (rest rest)) - (or (null? l) - (and (apply pred (car l) (map car rest)) - (mapf (cdr l) (map cdr rest)))))))) - -(define-public (notany pred . ls) (not (apply some pred ls))) - -(define-public (notevery pred . ls) (not (apply every pred ls))) - -(define-public (find-if t l) - (cond ((null? l) #f) - ((t (car l)) (car l)) - (else (find-if t (cdr l))))) - -(define-public (member-if t l) - (cond ((null? l) #f) - ((t (car l)) l) - (else (member-if t (cdr l))))) - -(define-public (remove-if p l) - (cond ((null? l) '()) - ((p (car l)) (remove-if p (cdr l))) - (else (cons (car l) (remove-if p (cdr l)))))) - -(define-public (delete-if! pred list) - (let delete-if ((list list)) - (cond ((null? list) '()) - ((pred (car list)) (delete-if (cdr list))) - (else - (set-cdr! list (delete-if (cdr list))) - list)))) - -(define-public (delete-if-not! pred list) - (let delete-if ((list list)) - (cond ((null? list) '()) - ((not (pred (car list))) (delete-if (cdr list))) - (else - (set-cdr! list (delete-if (cdr list))) - list)))) - -(define-public (butlast lst n) - (letrec ((l (- (length lst) n)) - (bl (lambda (lst n) - (cond ((null? lst) lst) - ((positive? n) - (cons (car lst) (bl (cdr lst) (+ -1 n)))) - (else '()))))) - (bl lst (if (negative? n) - (error "negative argument to butlast" n) - l)))) - -(define-public (and? . args) - (cond ((null? args) #t) - ((car args) (apply and? (cdr args))) - (else #f))) - -(define-public (or? . args) - (cond ((null? args) #f) - ((car args) #t) - (else (apply or? (cdr args))))) - -(define-public (has-duplicates? lst) - (cond ((null? lst) #f) - ((member (car lst) (cdr lst)) #t) - (else (has-duplicates? (cdr lst))))) - -(define-public (list* x . y) - (define (list*1 x) - (if (null? (cdr x)) - (car x) - (cons (car x) (list*1 (cdr x))))) - (if (null? y) - x - (cons x (list*1 y)))) - -;; pick p l -;; Apply P to each element of L, returning a list of elts -;; for which P returns a non-#f value. -;; -(define-public (pick p l) - (let loop ((s '()) - (l l)) - (cond - ((null? l) s) - ((p (car l)) (loop (cons (car l) s) (cdr l))) - (else (loop s (cdr l)))))) - -;; pick p l -;; Apply P to each element of L, returning a list of the -;; non-#f return values of P. -;; -(define-public (pick-mappings p l) - (let loop ((s '()) - (l l)) - (cond - ((null? l) s) - ((p (car l)) => (lambda (mapping) (loop (cons mapping s) (cdr l)))) - (else (loop s (cdr l)))))) - -(define-public (uniq l) - (if (null? l) - '() - (let ((u (uniq (cdr l)))) - (if (memq (car l) u) - u - (cons (car l) u))))) - diff --git a/ice-9/debug.scm b/ice-9/debug.scm deleted file mode 100644 index 9dadcf050..000000000 --- a/ice-9/debug.scm +++ /dev/null @@ -1,113 +0,0 @@ -;;;; Copyright (C) 1996, 1997 Free Software Foundation -;;;; -;;;; 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., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA -;;;; -;;;; The author can be reached at djurfeldt@nada.kth.se -;;;; Mikael Djurfeldt, SANS/NADA KTH, 10044 STOCKHOLM, SWEDEN -;;;; - - -(define-module (ice-9 debug)) - - -;;; {Misc} -;;; -(define-public (frame-number->index n) - (if (memq 'backwards (debug-options)) - n - (- (stack-length (fluid-ref the-last-stack)) n 1))) - - -;;; {Trace} -;;; -;;; This code is just an experimental prototype (e. g., it is not -;;; thread safe), but since it's at the same time useful, it's -;;; included anyway. -;;; -(define traced-procedures '()) - -(define-public (trace . args) - (if (null? args) - (nameify traced-procedures) - (begin - (for-each (lambda (proc) - (if (not (procedure? proc)) - (error "trace: Wrong type argument:" proc)) - (set-procedure-property! proc 'trace #t) - (if (not (memq proc traced-procedures)) - (set! traced-procedures - (cons proc traced-procedures)))) - args) - (set! apply-frame-handler trace-entry) - (set! exit-frame-handler trace-exit) - (set! trace-level 0) - (debug-enable 'trace) - (nameify args)))) - -(define-public (untrace . args) - (if (and (null? args) - (not (null? traced-procedures))) - (apply untrace traced-procedures) - (begin - (for-each (lambda (proc) - (set-procedure-property! proc 'trace #f) - (set! traced-procedures (delq! proc traced-procedures))) - args) - (if (null? traced-procedures) - (debug-disable 'trace)) - (nameify args)))) - -(define (nameify ls) - (map (lambda (proc) - (let ((name (procedure-name proc))) - (or name proc))) - ls)) - -(define trace-level 0) -(add-hook! abort-hook (lambda () (set! trace-level 0))) - -(define (trace-entry key cont tail) - (if (eq? (stack-id cont) 'repl-stack) - (let ((cep (current-error-port)) - (frame (last-stack-frame cont))) - (if (not tail) - (set! trace-level (+ trace-level 1))) - (let indent ((n trace-level)) - (cond ((> n 1) (display "| " cep) (indent (- n 1))))) - (display-application frame cep))) - ;; It's not necessary to call the continuation since - ;; execution will continue if the handler returns - ;(cont #f) - ) - -(define (trace-exit key cont retval) - (if (eq? (stack-id cont) 'repl-stack) - (let ((cep (current-error-port))) - (set! trace-level (- trace-level 1)) - (let indent ((n trace-level)) - (cond ((> n 0) (display "| " cep) (indent (- n 1))))) - (write retval cep) - (newline cep)))) - - -;;; A fix to get the error handling working together with the module system. -;;; -(variable-set! (builtin-variable 'debug-options) debug-options) - - - -(debug-enable 'debug) -(read-enable 'positions) diff --git a/ice-9/emacs.scm b/ice-9/emacs.scm deleted file mode 100644 index d814711e0..000000000 --- a/ice-9/emacs.scm +++ /dev/null @@ -1,259 +0,0 @@ -;;;; Copyright (C) 1996, 1997, 1998 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., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA -;;;; -;;;; The author can be reached at djurfeldt@nada.kth.se -;;;; Mikael Djurfeldt, SANS/NADA KTH, 10044 STOCKHOLM, SWEDEN -;;;; (I didn't write this!) -;;;; - - -;;; ********************************************************************* -;;; * This is the Guile side of the Emacs interface * -;;; * Experimental hACK---the real version will be coming soon (almost) * -;;; ********************************************************************* - -;;; {Session support for Emacs} -;;; - -(define-module (ice-9 emacs) - :use-module (ice-9 debug) - :use-module (ice-9 threads) - :use-module (ice-9 session)) - -(define emacs-escape-character #\sub) - -(define emacs-output-port (current-output-port)) - -(define (make-emacs-command char) - (let ((cmd (list->string (list emacs-escape-character char)))) - (lambda () - (display cmd emacs-output-port)))) - -(define enter-input-wait (make-emacs-command #\s)) -(define exit-input-wait (make-emacs-command #\f)) -(define enter-read-character #\r) -(define sending-error (make-emacs-command #\F)) -(define sending-backtrace (make-emacs-command #\B)) -(define sending-result (make-emacs-command #\x)) -(define end-of-text (make-emacs-command #\.)) -(define no-stack (make-emacs-command #\S)) -(define no-source (make-emacs-command #\R)) - -;; {Error handling} -;; - -(add-hook! before-backtrace-hook sending-backtrace) -(add-hook! after-backtrace-hook end-of-text) -(add-hook! before-error-hook sending-error) -(add-hook! after-error-hook end-of-text) - -;; {Repl} -;; - -(set-current-error-port emacs-output-port) - -(add-hook! before-read-hook - (lambda () - (enter-input-wait) - (force-output emacs-output-port))) - -(add-hook! after-read-hook - (lambda () - (exit-input-wait) - (force-output emacs-output-port))) - -;;; {Misc.} - -(define (make-emacs-load-port orig-port) - (letrec ((read-char-fn (lambda args - (let ((c (read-char orig-port))) - (if (eq? c #\soh) - (throw 'end-of-chunk) - c))))) - - (make-soft-port - (vector #f #f #f - read-char-fn - (lambda () (close-port orig-port))) - "r"))) - -(set-current-input-port (make-emacs-load-port (current-input-port))) - -(define (result-to-emacs exp) - (sending-result) - (write exp emacs-output-port) - (end-of-text) - (force-output emacs-output-port)) - -(define load-acknowledge (make-emacs-command #\l)) - -(define load-port (current-input-port)) - -(define (flush-line port) - (let loop ((c (read-char port))) - (if (not (eq? c #\nl)) - (loop (read-char port))))) - -(define whitespace-chars (list #\space #\tab #\nl #\np)) - -(define (flush-whitespace port) - (catch 'end-of-chunk - (lambda () - (let loop ((c (read-char port))) - (cond ((eq? c the-eof-object) - (error "End of file while recieving Emacs data")) - ((memq c whitespace-chars) (loop (read-char port))) - ((eq? c #\;) (flush-line port) (loop (read-char port))) - (else (unread-char c port)))) - #f) - (lambda args - (read-char port) ; Read final newline - #t))) - -(define (emacs-load filename linum colnum module interactivep) - (set-port-filename! %%load-port filename) - (set-port-line! %%load-port linum) - (set-port-column! %%load-port colnum) - (lazy-catch #t - (lambda () - (let loop ((endp (flush-whitespace %%load-port))) - (if (not endp) - (begin - (save-module-excursion - (lambda () - (if module - (set-current-module (resolve-module module #f))) - (let ((result - (start-stack read-and-eval! - (read-and-eval! %%load-port)))) - (if interactivep - (result-to-emacs result))))) - (loop (flush-whitespace %%load-port))) - (begin - (load-acknowledge)))) - ) - (lambda (key . args) - (cond ((eq? key 'end-of-chunk) - (fluid-set! the-last-stack #f) - (set! stack-saved? #t) - (scm-error 'misc-error - #f - "Incomplete expression" - '() - '())) - ((eq? key 'exit)) - (else - (save-stack 2) - (catch 'end-of-chunk - (lambda () - (let loop () - (read-char %%load-port) - (loop))) - (lambda args - #f)) - (apply throw key args)))))) - -(define (emacs-eval-request form) - (result-to-emacs (eval form))) - -;;*fixme* Not necessary to use flags no-stack and no-source -(define (get-frame-source frame) - (if (or (not (fluid-ref the-last-stack)) - (>= frame (stack-length (fluid-ref the-last-stack)))) - (begin - (no-stack) - #f) - (let* ((frame (stack-ref (fluid-ref the-last-stack) - (frame-number->index frame))) - (source (frame-source frame))) - (or source - (begin (no-source) - #f))))) - -(define (emacs-select-frame frame) - (let ((source (get-frame-source frame))) - (if source - (let ((fname (source-property source 'filename)) - (line (source-property source 'line)) - (column (source-property source 'column))) - (if (and fname line column) - (list fname line column) - (begin (no-source) - '()))) - '()))) - -(define (object->string x . method) - (with-output-to-string - (lambda () - ((if (null? method) - write - (car method)) - x)))) - -(define (format template . rest) - (let loop ((chars (string->list template)) - (result '())) - (cond ((null? chars) (list->string (reverse result))) - ((char=? (car chars) #\%) - (loop (cddr chars) - (append (reverse - (string->list - (case (cadr chars) - ((#\S) (object->string (car rest))) - ((#\s) (object->string (car rest) display))))) - result))) - (else (loop (cdr chars) (cons (car chars) result)))))) - -(define (error-args->string args) - (let ((msg (apply format (caddr args) (cadddr args)))) - (if (symbol? (cadr args)) - (string-append (symbol->string (cadr args)) - ": " - msg) - msg))) - -(define (emacs-frame-eval frame form) - (let ((source (get-frame-source frame))) - (if source - (catch #t - (lambda () - (list 'result - (object->string - (local-eval (with-input-from-string form read) - (memoized-environment source))))) - (lambda args - (list (car args) - (error-args->string args)))) - (begin - (no-source) - '())))) - -(define (emacs-symdoc symbol) - (if (or (not (module-bound? (current-module) symbol)) - (not (procedure? (eval symbol)))) - 'nil - (procedure-documentation (eval symbol)))) - -;;; A fix to get the emacs interface to work together with the module system. -;;; -(variable-set! (builtin-variable '%%load-port) load-port) -(variable-set! (builtin-variable '%%emacs-load) emacs-load) -(variable-set! (builtin-variable '%%emacs-eval-request) emacs-eval-request) -(variable-set! (builtin-variable '%%emacs-select-frame) emacs-select-frame) -(variable-set! (builtin-variable '%%emacs-frame-eval) emacs-frame-eval) -(variable-set! (builtin-variable '%%emacs-symdoc) emacs-symdoc) -(variable-set! (builtin-variable '%%apropos-internal) apropos-internal) diff --git a/ice-9/expect.scm b/ice-9/expect.scm deleted file mode 100644 index 20275b707..000000000 --- a/ice-9/expect.scm +++ /dev/null @@ -1,139 +0,0 @@ -;;; installed-scm-file - -;;;; Copyright (C) 1996 Free Software Foundation, Inc. -;;;; -;;;; This program is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. -;;;; -;;;; This program is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this software; see the file COPYING. If not, write to -;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA -;;;; - - -(define-module (ice-9 expect) :use-module (ice-9 regex)) - -;;; Expect: a macro for selecting actions based on what it reads from a port. -;;; The idea is from Don Libes' expect based on Tcl. -;;; This version by Gary Houston incorporating ideas from Aubrey Jaffer. - - -(define-public expect-port #f) -(define-public expect-timeout #f) -(define-public expect-timeout-proc #f) -(define-public expect-eof-proc #f) -(define-public expect-char-proc #f) - -;;; expect: each test is a procedure which is applied to the accumulating -;;; string. -(defmacro-public expect clauses - (let ((s (gentemp)) - (c (gentemp)) - (port (gentemp)) - (timeout (gentemp))) - `(let ((,s "") - (,port (or expect-port (current-input-port))) - ;; when timeout occurs, in floating point seconds. - (,timeout (if expect-timeout - (let* ((secs-usecs (gettimeofday))) - (+ (car secs-usecs) - expect-timeout - (/ (cdr secs-usecs) - 1000000))) ; one million. - #f))) - (let next-char () - (if (and expect-timeout - (or (>= (get-internal-real-time) ,timeout) - (and (not (char-ready? ,port)) - (not (expect-select ,port ,timeout))))) - (if expect-timeout-proc - (expect-timeout-proc ,s) - #f) - (let ((,c (read-char ,port))) - (if expect-char-proc - (expect-char-proc ,c)) - (cond ((eof-object? ,c) - (if expect-eof-proc - (expect-eof-proc ,s) - #f)) - (else - (set! ,s (string-append ,s (string ,c))) - (cond - ,@(let next-expr ((tests (map car clauses)) - (exprs (map cdr clauses)) - (body '())) - (cond - ((null? tests) - (reverse body)) - (else - (next-expr - (cdr tests) - (cdr exprs) - (cons - `((,(car tests) ,s) - ,@(cond ((null? (car exprs)) - '()) - ((eq? (caar exprs) '=>) - (if (not (= (length (car exprs)) - 2)) - (scm-error 'misc-error - "expect" - "bad recipient: %S" - (list (car exprs)) - #f) - `((apply ,(cadar exprs) - (,(car tests) ,s))))) - (else - (car exprs)))) - body))))) - (else (next-char))))))))))) - -;;; the regexec front-end to expect: -;;; each test must evaluate to a regular expression. -(defmacro-public expect-strings clauses - `(let ,@(let next-test ((tests (map car clauses)) - (exprs (map cdr clauses)) - (defs '()) - (body '())) - (cond ((null? tests) - (list (reverse defs) `(expect ,@(reverse body)))) - (else - (let ((rxname (gentemp))) - (next-test (cdr tests) - (cdr exprs) - (cons `(,rxname (make-regexp ,(car tests) - regexp/newline)) - defs) - (cons `((lambda (s) - (expect-regexec ,rxname s)) - ,@(car exprs)) - body)))))))) - -;;; simplified select: returns #t if input is waiting or #f if timed out. -;;; timeout is an absolute time in floating point seconds. -(define-public (expect-select port timeout) - (let* ((secs-usecs (gettimeofday)) - (relative (- timeout - (car secs-usecs) - (/ (cdr secs-usecs) - 1000000)))) ; one million. - (and (> relative 0) - (pair? (car (select (list port) '() '() - relative)))))) - -;;; convert a match object to a list of strings, for the => syntax. -(define-public (expect-regexec rx s) - (let ((match (regexp-exec rx s))) - (if match - (do ((i (- (match:count match) 1) (- i 1)) - (result '() (cons (match:substring match i) result))) - ((< i 0) result)) - #f))) diff --git a/ice-9/getopt-gnu-style.scm b/ice-9/getopt-gnu-style.scm deleted file mode 100644 index 03d04536e..000000000 --- a/ice-9/getopt-gnu-style.scm +++ /dev/null @@ -1,76 +0,0 @@ -;;;; getopt-gnu-style.scm --- command-line argument parsing functions -;;;; -;;;; author: russ mcmanus -;;;; Id: getopt-gnu-style.scm,v 1.5 1998/01/05 17:28:45 mcmanr Exp - -(define-module (ice-9 getopt-gnu-style)) - -(define (split-arg-list arg-ls) - "Given an arg-ls, decide which part to process for options. -Everything before an arg of \"--\" is fair game, everything -after it should not be processed. the \"--\" is discarded. -A cons pair is returned whose car is the list to process for -options, and whose cdr is the list to not process." - (let loop ((process-ls '()) - (not-process-ls arg-ls)) - (cond ((null? not-process-ls) - (cons process-ls '())) - ((equal? "--" (car not-process-ls)) - (cons process-ls (cdr not-process-ls))) - (#t - (loop (cons (car not-process-ls) process-ls) - (cdr not-process-ls)))))) - -(define arg-rx (make-regexp "^--[^=]+=")) -(define no-arg-rx (make-regexp "^--[^=]+$")) - -(define (getopt-gnu-style arg-ls) - "Parse a list of program arguments into an alist of option descriptions. - -Each item in the list of program arguments is examined to see if it -meets the syntax of a GNU long-named option. An argument like -`--MUMBLE' produces an element of the form (MUMBLE . #t) in the -returned alist, where MUMBLE is a keyword object with the same name as -the argument. An argument like `--MUMBLE=FROB' produces an element of -the form (MUMBLE . FROB), where FROB is a string. - -As a special case, the returned alist also contains a pair whose car -is the symbol `rest'. The cdr of this pair is a list containing all -the items in the argument list that are not options of the form -mentioned above. - -The argument `--' is treated specially: all items in the argument list -appearing after such an argument are not examined, and are returned in -the special `rest' list. - -This function does not parse normal single-character switches. You -will need to parse them out of the `rest' list yourself." - (let* ((pair (split-arg-list arg-ls)) - (eligible-arg-ls (car pair)) - (ineligible-arg-ls (cdr pair))) - (let loop ((arg-ls eligible-arg-ls) - (alist (list (cons 'rest ineligible-arg-ls)))) - (if (null? arg-ls) alist - (let ((first (car arg-ls)) - (rest (cdr arg-ls)) - (result #f)) - (cond ((begin (set! result (regexp-exec arg-rx first)) result) - (loop rest - (cons (cons (symbol->keyword - (string->symbol - (substring first 2 (- (cdr (vector-ref result 1)) 1)))) - (substring first (cdr (vector-ref result 1)))) - alist))) - ((begin (set! result (regexp-exec no-arg-rx first)) result) - (loop rest - (cons (cons (symbol->keyword - (string->symbol - (substring first 2 (cdr (vector-ref result 1))))) - #t) - alist))) - (#t - (let ((pair (assq 'rest alist))) - (set-cdr! pair (cons first (cdr pair))) - (loop rest alist))))))))) - -(define-public getopt-gnu-style getopt-gnu-style) diff --git a/ice-9/hcons.scm b/ice-9/hcons.scm deleted file mode 100644 index ebbf58651..000000000 --- a/ice-9/hcons.scm +++ /dev/null @@ -1,78 +0,0 @@ -;;; installed-scm-file - -;;;; Copyright (C) 1995, 1996 Free Software Foundation, Inc. -;;;; -;;;; This program is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. -;;;; -;;;; This program is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this software; see the file COPYING. If not, write to -;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA -;;;; - - -(define-module (ice-9 hcons)) - - -;;; {Eq? hash-consing} -;;; -;;; A hash conser maintains a private universe of pairs s.t. if -;;; two cons calls pass eq? arguments, the pairs returned are eq?. -;;; -;;; A hash conser does not contribute life to the pairs it returns. -;;; - -(define-public (hashq-cons-hash pair n) - (modulo (logxor (hashq (car pair) 4194303) - (hashq (cdr pair) 4194303)) - n)) - -(define-public (hashq-cons-assoc key l) - (and (not (null? l)) - (or (and (pair? l) ; If not a pair, use its cdr? - (pair? (car l)) - (pair? (caar l)) - (eq? (car key) (caaar l)) - (eq? (cdr key) (cdaar l)) - (car l)) - (hashq-cons-assoc key (cdr l))))) - -(define-public (hashq-cons-get-handle table key) - (hashx-get-handle hashq-cons-hash hashq-cons-assoc table key #f)) - -(define-public (hashq-cons-create-handle! table key init) - (hashx-create-handle! hashq-cons-hash hashq-cons-assoc table key init)) - -(define-public (hashq-cons-ref table key) - (hashx-ref hashq-cons-hash hashq-cons-assoc table key #f)) - -(define-public (hashq-cons-set! table key val) - (hashx-set! hashq-cons-hash hashq-cons-assoc table key val)) - -(define-public (hashq-cons table a d) - (car (hashq-cons-create-handle! table (cons a d) #f))) - -(define-public (hashq-conser hash-tab-or-size) - (let ((table (if (vector? hash-tab-or-size) - hash-tab-or-size - (make-doubly-weak-hash-table hash-tab-or-size)))) - (lambda (a d) (hashq-cons table a d)))) - - - - -(define-public (make-gc-buffer n) - (let ((ring (make-list n #f))) - (append! ring ring) - (lambda (next) - (set-car! ring next) - (set! ring (cdr ring)) - next))) diff --git a/ice-9/lineio.scm b/ice-9/lineio.scm deleted file mode 100644 index 74169d75e..000000000 --- a/ice-9/lineio.scm +++ /dev/null @@ -1,113 +0,0 @@ -;;; installed-scm-file - -;;;; Copyright (C) 1996 Free Software Foundation, Inc. -;;;; -;;;; This program is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. -;;;; -;;;; This program is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this software; see the file COPYING. If not, write to -;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA -;;;; - - - -(define-module (ice-9 lineio)) - - -;;; {Line Buffering Input Ports} -;;; -;;; [This is a work-around to get past certain deficiencies in the capabilities -;;; of ports. Eventually, ports should be fixed and this module nuked.] -;;; -;;; A line buffering input port supports: -;;; -;;; read-string which returns the next line of input -;;; unread-string which pushes a line back onto the stream -;;; -;;; The implementation of unread-string is kind of limited; it doesn't -;;; interact properly with unread-char, or any of the other port -;;; reading functions. Only read-string will get you back the things that -;;; unread-string accepts. -;;; -;;; Normally a "line" is all characters up to and including a newline. -;;; If lines are put back using unread-string, they can be broken arbitrarily -;;; -- that is, read-string returns strings passed to unread-string (or -;;; shared substrings of them). -;;; - -;; read-string port -;; unread-string port str -;; Read (or buffer) a line from PORT. -;; -;; Not all ports support these functions -- only those with -;; 'unread-string and 'read-string properties, bound to hooks -;; implementing these functions. -;; -(define-public (unread-string str line-buffering-input-port) - ((object-property line-buffering-input-port 'unread-string) str)) - -;; -(define-public (read-string line-buffering-input-port) - ((object-property line-buffering-input-port 'read-string))) - - -(define-public (lineio-port? port) - (not (not (object-property port 'read-string)))) - -;; make-line-buffering-input-port port -;; Return a wrapper for PORT. The wrapper handles read-string/unread-string. -;; -;; The port returned by this function reads newline terminated lines from PORT. -;; It buffers these characters internally, and parsels them out via calls -;; to read-char, read-string, and unread-string. -;; - -(define-public (make-line-buffering-input-port underlying-port) - (let* (;; buffers - a list of strings put back by unread-string or cached - ;; using read-line. - ;; - (buffers '()) - - ;; getc - return the next character from a buffer or from the underlying - ;; port. - ;; - (getc (lambda () - (if (not buffers) - (read-char underlying-port) - (let ((c (string-ref (car buffers)))) - (if (= 1 (string-length (car buffers))) - (set! buffers (cdr buffers)) - (set-car! buffers (make-shared-substring (car buffers) 1))) - c)))) - - (propogate-close (lambda () (close-port underlying-port))) - - (self (make-soft-port (vector #f #f #f getc propogate-close) "r")) - - (unread-string (lambda (str) - (and (< 0 (string-length str)) - (set! buffers (cons str buffers))))) - - (read-string (lambda () - (cond - ((not (null? buffers)) - (let ((answer (car buffers))) - (set! buffers (cdr buffers)) - answer)) - (else - (read-line underlying-port 'concat)))))) ;handle-newline->concat - - (set-object-property! self 'unread-string unread-string) - (set-object-property! self 'read-string read-string) - self)) - - diff --git a/ice-9/ls.scm b/ice-9/ls.scm deleted file mode 100644 index ae1fb80af..000000000 --- a/ice-9/ls.scm +++ /dev/null @@ -1,85 +0,0 @@ -;;;; ls.scm --- functions for browsing modules -;;;; -;;;; Copyright (C) 1995, 1996, 1997 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., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA -;;;; - -(define-module (ice-9 ls) - :use-module (ice-9 common-list)) - -;;;; -;;; local-definitions-in root name -;;; Returns a list of names defined locally in the named -;;; subdirectory of root. -;;; definitions-in root name -;;; Returns a list of all names defined in the named -;;; subdirectory of root. The list includes alll locally -;;; defined names as well as all names inherited from a -;;; member of a use-list. -;;; -;;; A convenient interface for examining the nature of things: -;;; -;;; ls . various-names -;;; -;;; With just one argument, interpret that argument as the -;;; name of a subdirectory of the current module and -;;; return a list of names defined there. -;;; -;;; With more than one argument, still compute -;;; subdirectory lists, but return a list: -;;; ((<subdir-name> . <names-defined-there>) -;;; (<subdir-name> . <names-defined-there>) -;;; ...) -;;; - -(define-public (local-definitions-in root names) - (let ((m (nested-ref root names)) - (answer '())) - (if (not (module? m)) - (set! answer m) - (module-for-each (lambda (k v) (set! answer (cons k answer))) m)) - answer)) - -(define-public (definitions-in root names) - (let ((m (nested-ref root names))) - (if (not (module? m)) - m - (reduce union - (cons (local-definitions-in m '()) - (map (lambda (m2) (definitions-in m2 '())) - (module-uses m))))))) - -(define-public (ls . various-refs) - (and (pair? various-refs) - (if (cdr various-refs) - (map (lambda (ref) - (cons ref (definitions-in (current-module) ref))) - various-refs) - (definitions-in (current-module) (car various-refs))))) - -(define-public (lls . various-refs) - (and (pair? various-refs) - (if (cdr various-refs) - (map (lambda (ref) - (cons ref (local-definitions-in (current-module) ref))) - various-refs) - (local-definitions-in (current-module) (car various-refs))))) - -(define-public (recursive-local-define name value) - (let ((parent (reverse! (cdr (reverse name))))) - (and parent (make-modules-in (current-module) parent)) - (local-define name value))) diff --git a/ice-9/mapping.scm b/ice-9/mapping.scm deleted file mode 100644 index 3610b87f8..000000000 --- a/ice-9/mapping.scm +++ /dev/null @@ -1,122 +0,0 @@ -;;; installed-scm-file - -;;;; Copyright (C) 1996 Free Software Foundation, Inc. -;;;; -;;;; This program is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. -;;;; -;;;; This program is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this software; see the file COPYING. If not, write to -;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA -;;;; - - - -(define-module (ice-9 mapping) - :use-module (ice-9 poe)) - -(define-public mapping-hooks-type (make-record-type 'mapping-hooks '(get-handle - create-handle - remove))) - - -(define-public make-mapping-hooks (perfect-funcq 17 (record-constructor mapping-hooks-type))) -(define-public mapping-hooks? (record-predicate mapping-hooks-type)) -(define-public mapping-hooks-get-handle (record-accessor mapping-hooks-type 'get-handle)) -(define-public mapping-hooks-create-handle (record-accessor mapping-hooks-type 'create-handle)) -(define-public mapping-hooks-remove (record-accessor mapping-hooks-type 'remove)) - -(define-public mapping-type (make-record-type 'mapping '(hooks data))) -(define-public make-mapping (record-constructor mapping-type)) -(define-public mapping? (record-predicate mapping-type)) -(define-public mapping-hooks (record-accessor mapping-type 'hooks)) -(define-public mapping-data (record-accessor mapping-type 'data)) -(define-public set-mapping-hooks! (record-modifier mapping-type 'hooks)) -(define-public set-mapping-data! (record-modifier mapping-type 'data)) - -(define-public (mapping-get-handle map key) - ((mapping-hooks-get-handle (mapping-hooks map)) map key)) -(define-public (mapping-create-handle! map key . opts) - (apply (mapping-hooks-create-handle (mapping-hooks map)) map key opts)) -(define-public (mapping-remove! map key) - ((mapping-hooks-remove (mapping-hooks map)) map key)) - -(define-public (mapping-ref map key . dflt) - (cond - ((mapping-get-handle map key) => cdr) - (dflt => car) - (else #f))) - -(define-public (mapping-set! map key val) - (set-cdr! (mapping-create-handle! map key #f) val)) - - - -(define-public hash-table-mapping-hooks - (let ((wrap (lambda (proc) (lambda (1st . rest) (apply proc (mapping-data 1st) rest))))) - - (perfect-funcq 17 - (lambda (hash-proc assoc-proc delete-proc) - (let ((procs (list hash-proc assoc-proc delete-proc))) - (cond - ((equal? procs `(,hashq ,assq ,delq!)) - (make-mapping-hooks (wrap hashq-get-handle) - (wrap hashq-create-handle!) - (wrap hashq-remove!))) - ((equal? procs `(,hashv ,assv ,delv!)) - (make-mapping-hooks (wrap hashv-get-handle) - (wrap hashv-create-handle!) - (wrap hashv-remove!))) - ((equal? procs `(,hash ,assoc ,delete!)) - (make-mapping-hooks (wrap hash-get-handle) - (wrap hash-create-handle!) - (wrap hash-remove!))) - (else - (make-mapping-hooks (wrap - (lambda (table key) - (hashx-get-handle hash-proc assoc-proc table key))) - (wrap - (lambda (table key) - (hashx-create-handle hash-proc assoc-proc table key))) - (wrap - (lambda (table key) - (hashx-get-handle hash-proc assoc-proc delete-proc table key))))))))))) - -(define-public (make-hash-table-mapping table hash-proc assoc-proc delete-proc) - (make-mapping (hash-table-mapping-hooks hash-proc assoc-proc delete-proc) table)) - -(define-public (hash-table-mapping . options) - (let* ((size (or (and options (number? (car options)) (car options)) - 71)) - (hash-proc (or (kw-arg-ref options :hash-proc) hash)) - (assoc-proc (or (kw-arg-ref options :assoc-proc) - (cond - ((eq? hash-proc hash) assoc) - ((eq? hash-proc hashv) assv) - ((eq? hash-proc hashq) assq) - (else (error 'hash-table-mapping - "Hash-procedure specified with no known assoc function." - hash-proc))))) - (delete-proc (or (kw-arg-ref options :delete-proc) - (cond - ((eq? hash-proc hash) delete!) - ((eq? hash-proc hashv) delv!) - ((eq? hash-proc hashq) delq!) - (else (error 'hash-table-mapping - "Hash-procedure specified with no known delete function." - hash-proc))))) - (table-constructor (or (kw-arg-ref options :table-constructor) - (lambda (len) (make-vector len '()))))) - (make-hash-table-mapping (table-constructor size) - hash-proc - assoc-proc - delete-proc))) - diff --git a/ice-9/oldprint.scm b/ice-9/oldprint.scm deleted file mode 100644 index 442dddd46..000000000 --- a/ice-9/oldprint.scm +++ /dev/null @@ -1,123 +0,0 @@ -;;;; Copyright (C) 1995, 1996, 1997 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., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA -;;;; - - -;;; {Print} -;;; -;;; This code was removed from boot-9.scm by MDJ 970301 -;;; <djurfeldt@nada.kth.se>. It is placed here for archival -;;; purposes. - -(define (print obj . args) - (let ((default-args (list (current-output-port) 0 0 default-print-style #f))) - (apply-to-args (append args (list-cdr-ref default-args (length args))) - (lambda (port depth length style table) - (cond - ((and table (print-table-ref table obj)) - ((print-style-tag-hook style 'eq-val) - obj port depth length style table)) - (else - (and table (print-table-add! table obj)) - (cond - ((print-style-max-depth? style depth) - ((print-style-excess-depth-hook style))) - ((print-style-max-length? style length) - ((print-style-excess-length-hook style))) - (else - ((print-style-hook style obj) - obj port depth length style table))))))))) - -(define (make-print-style) (make-vector 59 '())) - -(define (extend-print-style! style utag printer) - (hashq-set! style utag printer)) - -(define (print-style-hook style obj) - (let ((type-tag (tag obj))) - (or (hashq-ref style type-tag) - (hashq-ref style (logand type-tag 255)) - print-obj))) - -(define (print-style-tag-hook style type-tag) - (or (hashq-ref style type-tag) - print-obj)) - -(define (print-style-max-depth? style d) #f) -(define (print-style-max-length? style l) #f) -(define (print-style-excess-length-hook style) - (hashq-ref style 'excess-length-hook)) -(define (print-style-excess-depth-hook style) - (hashq-ref style 'excess-depth-hook)) - -(define (make-print-table) (make-vector 59 '())) -(define (print-table-ref table obj) (hashq-ref table obj)) -(define (print-table-add! table obj) (hashq-set! table obj (gensym 'ref))) - -(define (print-obj obj port depth length style table) (write obj port)) - -(define (print-pair pair port depth length style table) - (if (= 0 length) - (display #\( port)) - - (print (car pair) port (+ 1 depth) 0 style table) - - (cond - ((and (pair? (cdr pair)) - (or (not table) - (not (print-table-ref table (cdr pair))))) - - (display #\space port) - (print (cdr pair) port depth (+ 1 length) style table)) - - ((null? (cdr pair)) (display #\) port)) - - (else (display " . " port) - (print (cdr pair) port (+ 1 depth) 0 - style table) - (display #\) port)))) - -(define (print-vector obj port depth length style table) - (if (= 0 length) - (cond - ((weak-key-hash-table? obj) (display "#wh(" port)) - ((weak-value-hash-table? obj) (display "#whv(" port)) - ((doubly-weak-hash-table? obj) (display "#whd(" port)) - (else (display "#(" port)))) - - (if (< length (vector-length obj)) - (print (vector-ref obj length) port (+ 1 depth) 0 style table)) - - (cond - ((>= (+ 1 length) (vector-length obj)) (display #\) port)) - (else (display #\space port) - (print obj port depth - (+ 1 length) - style table)))) - -(define default-print-style (make-print-style)) - -(extend-print-style! default-print-style utag_vector print-vector) -(extend-print-style! default-print-style utag_wvect print-vector) -(extend-print-style! default-print-style utag_pair print-pair) -(extend-print-style! default-print-style 'eq-val - (lambda (obj port depth length style table) - (if (symbol? obj) - (display obj) - (begin - (display "##" port) - (display (print-table-ref table obj)))))) diff --git a/ice-9/poe.scm b/ice-9/poe.scm deleted file mode 100644 index ccb8759ec..000000000 --- a/ice-9/poe.scm +++ /dev/null @@ -1,118 +0,0 @@ -;;; installed-scm-file - -;;;; Copyright (C) 1996 Free Software Foundation, Inc. -;;;; -;;;; This program is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. -;;;; -;;;; This program is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this software; see the file COPYING. If not, write to -;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA -;;;; - - -(define-module (ice-9 poe) - :use-module (ice-9 hcons)) - - - - -;;; {Pure Functions} -;;; -;;; A pure function (of some sort) is characterized by two equality -;;; relations: one on argument lists and one on return values. -;;; A pure function is one that when applied to equal arguments lists -;;; yields equal results. -;;; -;;; If the equality relationship on return values can be eq?, it may make -;;; sense to cache values returned by the function. Choosing the right -;;; equality relation on arguments is tricky. -;;; - - -;;; {pure-funcq} -;;; -;;; The simplest case of pure functions are those in which results -;;; are only certainly eq? if all of the arguments are. These functions -;;; are called "pure-funcq", for obvious reasons. -;;; - - -(define funcq-memo (make-weak-key-hash-table 523)) ; !!! randomly selected values -(define funcq-buffer (make-gc-buffer 256)) - -(define (funcq-hash arg-list n) - (let ((it (let loop ((x 0) - (arg-list arg-list)) - (if (null? arg-list) - (modulo x n) - (loop (logior x (hashq (car arg-list) 4194303)) - (cdr arg-list)))))) - it)) - -(define (funcq-assoc arg-list alist) - (let ((it (and alist - (let and-map ((key arg-list) - (entry (caar alist))) - (or (and (and (not key) (not entry)) - (car alist)) - (and key entry - (eq? (car key) (car entry)) - (and-map (cdr key) (cdr entry)))))))) - it)) - - - -(define-public (pure-funcq base-func) - (lambda args - (let ((cached (hashx-get-handle funcq-hash funcq-assoc funcq-memo (cons base-func args)))) - (if cached - (begin - (funcq-buffer (car cached)) - (cdr cached)) - - (let ((val (apply base-func args)) - (key (cons base-func args))) - (funcq-buffer key) - (hashx-set! funcq-hash funcq-assoc funcq-memo key val) - val))))) - - - -;;; {Perfect funq} -;;; -;;; A pure funq may sometimes forget its past but a perfect -;;; funcq never does. -;;; - -(define-public (perfect-funcq size base-func) - (define funcq-memo (make-hash-table size)) - - (lambda args - (let ((cached (hashx-get-handle funcq-hash funcq-assoc funcq-memo (cons base-func args)))) - (if cached - (begin - (funcq-buffer (car cached)) - (cdr cached)) - - (let ((val (apply base-func args)) - (key (cons base-func args))) - (funcq-buffer key) - (hashx-set! funcq-hash funcq-assoc funcq-memo key val) - val))))) - - - - - - - - diff --git a/ice-9/psyntax.pp b/ice-9/psyntax.pp deleted file mode 100644 index 172342d6d..000000000 --- a/ice-9/psyntax.pp +++ /dev/null @@ -1,11 +0,0 @@ -(letrec ((lambda-var-list (lambda (vars203) (let lvl ((vars204 vars203) (ls (quote ())) (w205 (quote (())))) (cond ((pair? vars204) (lvl (cdr vars204) (cons (wrap (car vars204) w205) ls) w205)) ((id? vars204) (cons (wrap vars204 w205) ls)) ((null? vars204) ls) ((syntax-object? vars204) (lvl (syntax-object-expression vars204) ls (join-wraps w205 (syntax-object-wrap vars204)))) ((annotation? vars204) (lvl (annotation-expression vars204) ls w205)) (else (cons vars204 ls)))))) (gen-var (lambda (id206) (let ((id207 (if (syntax-object? id206) (syntax-object-expression id206) id206))) (if (annotation? id207) (gensym (annotation-expression id207) generated-symbols) (gensym id207 generated-symbols))))) (strip (lambda (x208 w209) (if (memq (quote top) (wrap-marks w209)) (if (or (annotation? x208) (and (pair? x208) (annotation? (car x208)))) (strip-annotation x208 (quote #f)) x208) (let f210 ((x211 x208)) (cond ((syntax-object? x211) (strip (syntax-object-expression x211) (syntax-object-wrap x211))) ((pair? x211) (let ((a (f210 (car x211))) (d (f210 (cdr x211)))) (if (and (eq? a (car x211)) (eq? d (cdr x211))) x211 (cons a d)))) ((vector? x211) (let ((old212 (vector->list x211))) (let ((new213 (map f210 old212))) (if (andmap eq? old212 new213) x211 (list->vector new213))))) (else x211)))))) (strip-annotation (lambda (x214 parent) (cond ((pair? x214) (let ((new215 (cons (quote #f) (quote #f)))) (begin (when parent (set-annotation-stripped! parent new215)) (set-car! new215 (strip-annotation (car x214) (quote #f))) (set-cdr! new215 (strip-annotation (cdr x214) (quote #f))) new215))) ((annotation? x214) (or (annotation-stripped x214) (strip-annotation (annotation-expression x214) x214))) ((vector? x214) (let ((new216 (make-vector (vector-length x214)))) (begin (when parent (set-annotation-stripped! parent new216)) (let loop ((i217 (- (vector-length x214) (quote 1)))) (unless (fx< i217 (quote 0)) (vector-set! new216 i217 (strip-annotation (vector-ref x214 i217) (quote #f))) (loop (fx- i217 (quote 1))))) new216))) (else x214)))) (ellipsis? (lambda (x218) (and (nonsymbol-id? x218) (free-id=? x218 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))))))))) (chi-void (lambda () (list (quote void)))) (eval-local-transformer (lambda (expanded) (let ((p (local-eval-hook expanded))) (if (procedure? p) p (syntax-error p (quote "nonprocedure transfomer")))))) (chi-local-syntax (lambda (rec? e219 r w220 s k) ((lambda (tmp221) ((lambda (tmp222) (if tmp222 (apply (lambda (_223 id224 val e1 e2) (let ((ids225 id224)) (if (not (valid-bound-ids? ids225)) (syntax-error e219 (quote "duplicate bound keyword in")) (let ((labels (gen-labels ids225))) (let ((new-w (make-binding-wrap ids225 labels w220))) (k (cons e1 e2) (extend-env labels (let ((w228 (if rec? new-w w220)) (trans-r (macros-only-env r))) (map (lambda (x229) (cons (quote macro) (eval-local-transformer (chi x229 trans-r w228)))) val)) r) new-w s)))))) tmp222) ((lambda (_231) (syntax-error (source-wrap e219 w220 s))) tmp221))) (syntax-dispatch tmp221 (quote (any #(each (any any)) any . each-any))))) e219))) (chi-lambda-clause (lambda (e232 c r233 w234 k235) ((lambda (tmp236) ((lambda (tmp237) (if tmp237 (apply (lambda (id238 e1239 e2240) (let ((ids241 id238)) (if (not (valid-bound-ids? ids241)) (syntax-error e232 (quote "invalid parameter list in")) (let ((labels243 (gen-labels ids241)) (new-vars (map gen-var ids241))) (k235 new-vars (chi-body (cons e1239 e2240) e232 (extend-var-env labels243 new-vars r233) (make-binding-wrap ids241 labels243 w234))))))) tmp237) ((lambda (tmp245) (if tmp245 (apply (lambda (ids246 e1247 e2248) (let ((old-ids (lambda-var-list ids246))) (if (not (valid-bound-ids? old-ids)) (syntax-error e232 (quote "invalid parameter list in")) (let ((labels249 (gen-labels old-ids)) (new-vars250 (map gen-var old-ids))) (k235 (let f251 ((ls1 (cdr new-vars250)) (ls2 (car new-vars250))) (if (null? ls1) ls2 (f251 (cdr ls1) (cons (car ls1) ls2)))) (chi-body (cons e1247 e2248) e232 (extend-var-env labels249 new-vars250 r233) (make-binding-wrap old-ids labels249 w234))))))) tmp245) ((lambda (_253) (syntax-error e232)) tmp236))) (syntax-dispatch tmp236 (quote (any any . each-any)))))) (syntax-dispatch tmp236 (quote (each-any any . each-any))))) c))) (chi-body (lambda (body outer-form r254 w255) (let ((r256 (cons (quote ("placeholder" placeholder)) r254))) (let ((ribcage (make-ribcage (quote ()) (quote ()) (quote ())))) (let ((w257 (make-wrap (wrap-marks w255) (cons ribcage (wrap-subst w255))))) (let parse ((body258 (map (lambda (x262) (cons r256 (wrap x262 w257))) body)) (ids259 (quote ())) (labels260 (quote ())) (vars261 (quote ())) (vals (quote ())) (bindings (quote ()))) (if (null? body258) (syntax-error outer-form (quote "no expressions in body")) (let ((e263 (cdar body258)) (er (caar body258))) (call-with-values (lambda () (syntax-type e263 er (quote (())) (quote #f) ribcage)) (lambda (type264 value265 e266 w267 s268) (let ((t type264)) (if (memv t (quote (define-form))) (let ((id269 (wrap value265 w267)) (label (gen-label))) (let ((var270 (gen-var id269))) (begin (extend-ribcage! ribcage id269 label) (parse (cdr body258) (cons id269 ids259) (cons label labels260) (cons var270 vars261) (cons (cons er (wrap e266 w267)) vals) (cons (cons (quote lexical) var270) bindings))))) (if (memv t (quote (define-syntax-form))) (let ((id271 (wrap value265 w267)) (label272 (gen-label))) (begin (extend-ribcage! ribcage id271 label272) (parse (cdr body258) (cons id271 ids259) (cons label272 labels260) vars261 vals (cons (cons (quote macro) (cons er (wrap e266 w267))) bindings)))) (if (memv t (quote (begin-form))) ((lambda (tmp273) ((lambda (tmp274) (if tmp274 (apply (lambda (_275 e1276) (parse (let f277 ((forms e1276)) (if (null? forms) (cdr body258) (cons (cons er (wrap (car forms) w267)) (f277 (cdr forms))))) ids259 labels260 vars261 vals bindings)) tmp274) (syntax-error tmp273))) (syntax-dispatch tmp273 (quote (any . each-any))))) e266) (if (memv t (quote (local-syntax-form))) (chi-local-syntax value265 e266 er w267 s268 (lambda (forms279 er280 w281 s282) (parse (let f283 ((forms284 forms279)) (if (null? forms284) (cdr body258) (cons (cons er280 (wrap (car forms284) w281)) (f283 (cdr forms284))))) ids259 labels260 vars261 vals bindings))) (if (null? ids259) (build-sequence (quote #f) (map (lambda (x285) (chi (cdr x285) (car x285) (quote (())))) (cons (cons er (source-wrap e266 w267 s268)) (cdr body258)))) (begin (if (not (valid-bound-ids? ids259)) (syntax-error outer-form (quote "invalid or duplicate identifier in definition"))) (let loop286 ((bs bindings) (er-cache (quote #f)) (r-cache (quote #f))) (if (not (null? bs)) (let ((b (car bs))) (if (eq? (car b) (quote macro)) (let ((er287 (cadr b))) (let ((r-cache288 (if (eq? er287 er-cache) r-cache (macros-only-env er287)))) (begin (set-cdr! b (eval-local-transformer (chi (cddr b) r-cache288 (quote (()))))) (loop286 (cdr bs) er287 r-cache288)))) (loop286 (cdr bs) er-cache r-cache))))) (set-cdr! r256 (extend-env labels260 bindings (cdr r256))) (build-letrec (quote #f) vars261 (map (lambda (x289) (chi (cdr x289) (car x289) (quote (())))) vals) (build-sequence (quote #f) (map (lambda (x290) (chi (cdr x290) (car x290) (quote (())))) (cons (cons er (source-wrap e266 w267 s268)) (cdr body258)))))))))))))))))))))) (chi-macro (lambda (p291 e292 r293 w294 rib) (letrec ((rebuild-macro-output (lambda (x295 m) (cond ((pair? x295) (cons (rebuild-macro-output (car x295) m) (rebuild-macro-output (cdr x295) m))) ((syntax-object? x295) (let ((w296 (syntax-object-wrap x295))) (let ((ms (wrap-marks w296)) (s297 (wrap-subst w296))) (make-syntax-object (syntax-object-expression x295) (if (and (pair? ms) (eq? (car ms) (quote #f))) (make-wrap (cdr ms) (if rib (cons rib (cdr s297)) (cdr s297))) (make-wrap (cons m ms) (if rib (cons rib (cons (quote shift) s297)) (cons (quote shift) s297)))))))) ((vector? x295) (let ((n (vector-length x295))) (let ((v (make-vector n))) (let doloop ((i298 (quote 0))) (if (fx= i298 n) v (begin (vector-set! v i298 (rebuild-macro-output (vector-ref x295 i298) m)) (doloop (fx+ i298 (quote 1))))))))) ((symbol? x295) (syntax-error x295 (quote "encountered raw symbol in macro output"))) (else x295))))) (rebuild-macro-output (p291 (wrap e292 (anti-mark w294))) (string (quote #\m)))))) (chi-application (lambda (x299 e300 r301 w302 s303) ((lambda (tmp304) ((lambda (tmp305) (if tmp305 (apply (lambda (e0 e1306) (cons x299 (map (lambda (e307) (chi e307 r301 w302)) e1306))) tmp305) (syntax-error tmp304))) (syntax-dispatch tmp304 (quote (any . each-any))))) e300))) (chi-expr (lambda (type309 value310 e311 r312 w313 s314) (let ((t315 type309)) (if (memv t315 (quote (lexical))) value310 (if (memv t315 (quote (core))) (value310 e311 r312 w313 s314) (if (memv t315 (quote (lexical-call))) (chi-application value310 e311 r312 w313 s314) (if (memv t315 (quote (global-call))) (chi-application value310 e311 r312 w313 s314) (if (memv t315 (quote (constant))) (list (quote quote) (strip (source-wrap e311 w313 s314) (quote (())))) (if (memv t315 (quote (global))) value310 (if (memv t315 (quote (call))) (chi-application (chi (car e311) r312 w313) e311 r312 w313 s314) (if (memv t315 (quote (begin-form))) ((lambda (tmp316) ((lambda (tmp317) (if tmp317 (apply (lambda (_318 e1319 e2320) (chi-sequence (cons e1319 e2320) r312 w313 s314)) tmp317) (syntax-error tmp316))) (syntax-dispatch tmp316 (quote (any any . each-any))))) e311) (if (memv t315 (quote (local-syntax-form))) (chi-local-syntax value310 e311 r312 w313 s314 chi-sequence) (if (memv t315 (quote (eval-when-form))) ((lambda (tmp322) ((lambda (tmp323) (if tmp323 (apply (lambda (_324 x325 e1326 e2327) (let ((when-list (chi-when-list e311 x325 w313))) (if (memq (quote eval) when-list) (chi-sequence (cons e1326 e2327) r312 w313 s314) (chi-void)))) tmp323) (syntax-error tmp322))) (syntax-dispatch tmp322 (quote (any each-any any . each-any))))) e311) (if (memv t315 (quote (define-form define-syntax-form))) (syntax-error (wrap value310 w313) (quote "invalid context for definition of")) (if (memv t315 (quote (syntax))) (syntax-error (source-wrap e311 w313 s314) (quote "reference to pattern variable outside syntax form")) (if (memv t315 (quote (displaced-lexical))) (syntax-error (source-wrap e311 w313 s314) (quote "reference to identifier outside its scope")) (syntax-error (source-wrap e311 w313 s314)))))))))))))))))) (chi (lambda (e330 r331 w332) (call-with-values (lambda () (syntax-type e330 r331 w332 (quote #f) (quote #f))) (lambda (type333 value334 e335 w336 s337) (chi-expr type333 value334 e335 r331 w336 s337))))) (chi-top (lambda (e338 r339 w340 m341 esew) (call-with-values (lambda () (syntax-type e338 r339 w340 (quote #f) (quote #f))) (lambda (type348 value349 e350 w351 s352) (let ((t353 type348)) (if (memv t353 (quote (begin-form))) ((lambda (tmp354) ((lambda (tmp355) (if tmp355 (apply (lambda (_356) (chi-void)) tmp355) ((lambda (tmp357) (if tmp357 (apply (lambda (_358 e1359 e2360) (chi-top-sequence (cons e1359 e2360) r339 w351 s352 m341 esew)) tmp357) (syntax-error tmp354))) (syntax-dispatch tmp354 (quote (any any . each-any)))))) (syntax-dispatch tmp354 (quote (any))))) e350) (if (memv t353 (quote (local-syntax-form))) (chi-local-syntax value349 e350 r339 w351 s352 (lambda (body362 r363 w364 s365) (chi-top-sequence body362 r363 w364 s365 m341 esew))) (if (memv t353 (quote (eval-when-form))) ((lambda (tmp366) ((lambda (tmp367) (if tmp367 (apply (lambda (_368 x369 e1370 e2371) (let ((when-list372 (chi-when-list e350 x369 w351)) (body373 (cons e1370 e2371))) (cond ((eq? m341 (quote e)) (if (memq (quote eval) when-list372) (chi-top-sequence body373 r339 w351 s352 (quote e) (quote (eval))) (chi-void))) ((memq (quote load) when-list372) (if (or (memq (quote compile) when-list372) (and (eq? m341 (quote c&e)) (memq (quote eval) when-list372))) (chi-top-sequence body373 r339 w351 s352 (quote c&e) (quote (compile load))) (if (memq m341 (quote (c c&e))) (chi-top-sequence body373 r339 w351 s352 (quote c) (quote (load))) (chi-void)))) ((or (memq (quote compile) when-list372) (and (eq? m341 (quote c&e)) (memq (quote eval) when-list372))) (top-level-eval-hook (chi-top-sequence body373 r339 w351 s352 (quote e) (quote (eval)))) (chi-void)) (else (chi-void))))) tmp367) (syntax-error tmp366))) (syntax-dispatch tmp366 (quote (any each-any any . each-any))))) e350) (if (memv t353 (quote (define-syntax-form))) (let ((n376 (id-var-name value349 w351)) (r377 (macros-only-env r339))) (let ((t378 m341)) (if (memv t378 (quote (c))) (if (memq (quote compile) esew) (let ((e379 (chi-install-global n376 (chi e350 r377 w351)))) (begin (top-level-eval-hook e379) (if (memq (quote load) esew) e379 (chi-void)))) (if (memq (quote load) esew) (chi-install-global n376 (chi e350 r377 w351)) (chi-void))) (if (memv t378 (quote (c&e))) (let ((e380 (chi-install-global n376 (chi e350 r377 w351)))) (begin (top-level-eval-hook e380) e380)) (begin (if (memq (quote eval) esew) (top-level-eval-hook (chi-install-global n376 (chi e350 r377 w351)))) (chi-void)))))) (if (memv t353 (quote (define-form))) (let ((n381 (id-var-name value349 w351))) (let ((t382 (binding-type (lookup n381 r339)))) (if (memv t382 (quote (global))) (let ((x383 (list (quote define) n381 (chi e350 r339 w351)))) (begin (if (eq? m341 (quote c&e)) (top-level-eval-hook x383)) x383)) (if (memv t382 (quote (displaced-lexical))) (syntax-error (wrap value349 w351) (quote "identifier out of context")) (syntax-error (wrap value349 w351) (quote "cannot define keyword at top level")))))) (let ((x384 (chi-expr type348 value349 e350 r339 w351 s352))) (begin (if (eq? m341 (quote c&e)) (top-level-eval-hook x384)) x384)))))))))))) (syntax-type (lambda (e385 r386 w387 s388 rib389) (cond ((symbol? e385) (let ((n390 (id-var-name e385 w387))) (let ((b391 (lookup n390 r386))) (let ((type392 (binding-type b391))) (let ((t393 type392)) (if (memv t393 (quote (lexical))) (values type392 (binding-value b391) e385 w387 s388) (if (memv t393 (quote (global))) (values type392 n390 e385 w387 s388) (if (memv t393 (quote (macro))) (syntax-type (chi-macro (binding-value b391) e385 r386 w387 rib389) r386 (quote (())) s388 rib389) (values type392 (binding-value b391) e385 w387 s388))))))))) ((pair? e385) (let ((first (car e385))) (if (id? first) (let ((n394 (id-var-name first w387))) (let ((b395 (lookup n394 r386))) (let ((type396 (binding-type b395))) (let ((t397 type396)) (if (memv t397 (quote (lexical))) (values (quote lexical-call) (binding-value b395) e385 w387 s388) (if (memv t397 (quote (global))) (values (quote global-call) n394 e385 w387 s388) (if (memv t397 (quote (macro))) (syntax-type (chi-macro (binding-value b395) e385 r386 w387 rib389) r386 (quote (())) s388 rib389) (if (memv t397 (quote (core))) (values type396 (binding-value b395) e385 w387 s388) (if (memv t397 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value b395) e385 w387 s388) (if (memv t397 (quote (begin))) (values (quote begin-form) (quote #f) e385 w387 s388) (if (memv t397 (quote (eval-when))) (values (quote eval-when-form) (quote #f) e385 w387 s388) (if (memv t397 (quote (define))) ((lambda (tmp398) ((lambda (tmp399) (if (if tmp399 (apply (lambda (_400 name401 val402) (id? name401)) tmp399) (quote #f)) (apply (lambda (_403 name404 val405) (values (quote define-form) name404 val405 w387 s388)) tmp399) ((lambda (tmp406) (if (if tmp406 (apply (lambda (_407 name408 args409 e1410 e2411) (and (id? name408) (or (valid-bound-ids? (lambda-var-list args409)) (id? (lambda-var-list args409))))) tmp406) (quote #f)) (apply (lambda (_412 name413 args414 e1415 e2416) (values (quote define-form) (wrap name413 w387) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))))) (wrap (cons args414 (cons e1415 e2416)) w387)) (quote (())) s388)) tmp406) ((lambda (tmp418) (if (if tmp418 (apply (lambda (_419 name420) (id? name420)) tmp418) (quote #f)) (apply (lambda (_421 name422) (values (quote define-form) (wrap name422 w387) (quote (#(syntax-object void ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i")))))) (quote (())) s388)) tmp418) (syntax-error tmp398))) (syntax-dispatch tmp398 (quote (any any)))))) (syntax-dispatch tmp398 (quote (any (any . any) any . each-any)))))) (syntax-dispatch tmp398 (quote (any any any))))) e385) (if (memv t397 (quote (define-syntax))) ((lambda (tmp423) ((lambda (tmp424) (if (if tmp424 (apply (lambda (_425 name426 val427) (id? name426)) tmp424) (quote #f)) (apply (lambda (_428 name429 val430) (values (quote define-syntax-form) name429 val430 w387 s388)) tmp424) (syntax-error tmp423))) (syntax-dispatch tmp423 (quote (any any any))))) e385) (values (quote call) (quote #f) e385 w387 s388)))))))))))))) (values (quote call) (quote #f) e385 w387 s388)))) ((syntax-object? e385) (syntax-type (syntax-object-expression e385) r386 (join-wraps w387 (syntax-object-wrap e385)) (quote #f) rib389)) ((annotation? e385) (syntax-type (annotation-expression e385) r386 w387 (annotation-source e385) rib389)) ((let ((x431 e385)) (or (boolean? x431) (number? x431) (string? x431) (char? x431) (null? x431) (keyword? x431))) (values (quote constant) (quote #f) e385 w387 s388)) (else (values (quote other) (quote #f) e385 w387 s388))))) (chi-when-list (lambda (e432 when-list433 w434) (let f435 ((when-list436 when-list433) (situations (quote ()))) (if (null? when-list436) situations (f435 (cdr when-list436) (cons (let ((x437 (car when-list436))) (cond ((free-id=? x437 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i")))))) (quote compile)) ((free-id=? x437 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i")))))) (quote load)) ((free-id=? x437 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i")))))) (quote eval)) (else (syntax-error (wrap x437 w434) (quote "invalid eval-when situation"))))) situations)))))) (chi-install-global (lambda (name438 e439) (list (quote install-global-transformer) (list (quote quote) name438) e439))) (chi-top-sequence (lambda (body440 r441 w442 s443 m444 esew445) (build-sequence s443 (let dobody ((body446 body440) (r447 r441) (w448 w442) (m449 m444) (esew450 esew445)) (if (null? body446) (quote ()) (let ((first451 (chi-top (car body446) r447 w448 m449 esew450))) (cons first451 (dobody (cdr body446) r447 w448 m449 esew450)))))))) (chi-sequence (lambda (body452 r453 w454 s455) (build-sequence s455 (let dobody456 ((body457 body452) (r458 r453) (w459 w454)) (if (null? body457) (quote ()) (let ((first460 (chi (car body457) r458 w459))) (cons first460 (dobody456 (cdr body457) r458 w459)))))))) (source-wrap (lambda (x461 w462 s463) (wrap (if s463 (make-annotation x461 s463 (quote #f)) x461) w462))) (wrap (lambda (x464 w465) (cond ((and (null? (wrap-marks w465)) (null? (wrap-subst w465))) x464) ((syntax-object? x464) (make-syntax-object (syntax-object-expression x464) (join-wraps w465 (syntax-object-wrap x464)))) ((null? x464) x464) (else (make-syntax-object x464 w465))))) (bound-id-member? (lambda (x466 list) (and (not (null? list)) (or (bound-id=? x466 (car list)) (bound-id-member? x466 (cdr list)))))) (distinct-bound-ids? (lambda (ids467) (let distinct? ((ids468 ids467)) (or (null? ids468) (and (not (bound-id-member? (car ids468) (cdr ids468))) (distinct? (cdr ids468))))))) (valid-bound-ids? (lambda (ids469) (and (let all-ids? ((ids470 ids469)) (or (null? ids470) (and (id? (car ids470)) (all-ids? (cdr ids470))))) (distinct-bound-ids? ids469)))) (bound-id=? (lambda (i471 j) (if (and (syntax-object? i471) (syntax-object? j)) (and (eq? (let ((e472 (syntax-object-expression i471))) (if (annotation? e472) (annotation-expression e472) e472)) (let ((e473 (syntax-object-expression j))) (if (annotation? e473) (annotation-expression e473) e473))) (same-marks? (wrap-marks (syntax-object-wrap i471)) (wrap-marks (syntax-object-wrap j)))) (eq? (let ((e474 i471)) (if (annotation? e474) (annotation-expression e474) e474)) (let ((e475 j)) (if (annotation? e475) (annotation-expression e475) e475)))))) (free-id=? (lambda (i476 j477) (and (eq? (let ((x478 i476)) (let ((e479 (if (syntax-object? x478) (syntax-object-expression x478) x478))) (if (annotation? e479) (annotation-expression e479) e479))) (let ((x480 j477)) (let ((e481 (if (syntax-object? x480) (syntax-object-expression x480) x480))) (if (annotation? e481) (annotation-expression e481) e481)))) (eq? (id-var-name i476 (quote (()))) (id-var-name j477 (quote (()))))))) (id-var-name (lambda (id482 w483) (letrec ((search-vector-rib (lambda (sym subst marks489 symnames ribcage490) (let ((n491 (vector-length symnames))) (let f492 ((i493 (quote 0))) (cond ((fx= i493 n491) (search sym (cdr subst) marks489)) ((and (eq? (vector-ref symnames i493) sym) (same-marks? marks489 (vector-ref (ribcage-marks ribcage490) i493))) (values (vector-ref (ribcage-labels ribcage490) i493) marks489)) (else (f492 (fx+ i493 (quote 1))))))))) (search-list-rib (lambda (sym494 subst495 marks496 symnames497 ribcage498) (let f499 ((symnames500 symnames497) (i501 (quote 0))) (cond ((null? symnames500) (search sym494 (cdr subst495) marks496)) ((and (eq? (car symnames500) sym494) (same-marks? marks496 (list-ref (ribcage-marks ribcage498) i501))) (values (list-ref (ribcage-labels ribcage498) i501) marks496)) (else (f499 (cdr symnames500) (fx+ i501 (quote 1)))))))) (search (lambda (sym502 subst503 marks504) (if (null? subst503) (values (quote #f) marks504) (let ((fst (car subst503))) (if (eq? fst (quote shift)) (search sym502 (cdr subst503) (cdr marks504)) (let ((symnames505 (ribcage-symnames fst))) (if (vector? symnames505) (search-vector-rib sym502 subst503 marks504 symnames505 fst) (search-list-rib sym502 subst503 marks504 symnames505 fst))))))))) (cond ((symbol? id482) (or (call-with-values (lambda () (search id482 (wrap-subst w483) (wrap-marks w483))) (lambda (x506 . ignore) x506)) id482)) ((syntax-object? id482) (let ((id507 (let ((e508 (syntax-object-expression id482))) (if (annotation? e508) (annotation-expression e508) e508))) (w1 (syntax-object-wrap id482))) (let ((marks509 (join-marks (wrap-marks w483) (wrap-marks w1)))) (call-with-values (lambda () (search id507 (wrap-subst w483) marks509)) (lambda (new-id marks510) (or new-id (call-with-values (lambda () (search id507 (wrap-subst w1) marks510)) (lambda (x512 . ignore511) x512)) id507)))))) ((annotation? id482) (let ((id513 (let ((e514 id482)) (if (annotation? e514) (annotation-expression e514) e514)))) (or (call-with-values (lambda () (search id513 (wrap-subst w483) (wrap-marks w483))) (lambda (x516 . ignore515) x516)) id513))) (else (error-hook (quote id-var-name) (quote "invalid id") id482)))))) (same-marks? (lambda (x517 y) (or (eq? x517 y) (and (not (null? x517)) (not (null? y)) (eq? (car x517) (car y)) (same-marks? (cdr x517) (cdr y)))))) (join-marks (lambda (m1 m2) (smart-append m1 m2))) (join-wraps (lambda (w1518 w2) (let ((m1519 (wrap-marks w1518)) (s1 (wrap-subst w1518))) (if (null? m1519) (if (null? s1) w2 (make-wrap (wrap-marks w2) (smart-append s1 (wrap-subst w2)))) (make-wrap (smart-append m1519 (wrap-marks w2)) (smart-append s1 (wrap-subst w2))))))) (smart-append (lambda (m1520 m2521) (if (null? m2521) m1520 (append m1520 m2521)))) (make-binding-wrap (lambda (ids522 labels523 w524) (if (null? ids522) w524 (make-wrap (wrap-marks w524) (cons (let ((labelvec (list->vector labels523))) (let ((n525 (vector-length labelvec))) (let ((symnamevec (make-vector n525)) (marksvec (make-vector n525))) (begin (let f526 ((ids527 ids522) (i528 (quote 0))) (if (not (null? ids527)) (call-with-values (lambda () (id-sym-name&marks (car ids527) w524)) (lambda (symname marks529) (begin (vector-set! symnamevec i528 symname) (vector-set! marksvec i528 marks529) (f526 (cdr ids527) (fx+ i528 (quote 1)))))))) (make-ribcage symnamevec marksvec labelvec))))) (wrap-subst w524)))))) (extend-ribcage! (lambda (ribcage530 id531 label532) (begin (set-ribcage-symnames! ribcage530 (cons (let ((e533 (syntax-object-expression id531))) (if (annotation? e533) (annotation-expression e533) e533)) (ribcage-symnames ribcage530))) (set-ribcage-marks! ribcage530 (cons (wrap-marks (syntax-object-wrap id531)) (ribcage-marks ribcage530))) (set-ribcage-labels! ribcage530 (cons label532 (ribcage-labels ribcage530)))))) (anti-mark (lambda (w534) (make-wrap (cons (quote #f) (wrap-marks w534)) (cons (quote shift) (wrap-subst w534))))) (set-ribcage-labels! (lambda (x535 update) (vector-set! x535 (quote 3) update))) (set-ribcage-marks! (lambda (x536 update537) (vector-set! x536 (quote 2) update537))) (set-ribcage-symnames! (lambda (x538 update539) (vector-set! x538 (quote 1) update539))) (ribcage-labels (lambda (x540) (vector-ref x540 (quote 3)))) (ribcage-marks (lambda (x541) (vector-ref x541 (quote 2)))) (ribcage-symnames (lambda (x542) (vector-ref x542 (quote 1)))) (ribcage? (lambda (x543) (and (vector? x543) (= (vector-length x543) (quote 4)) (eq? (vector-ref x543 (quote 0)) (quote ribcage))))) (make-ribcage (lambda (symnames544 marks545 labels546) (vector (quote ribcage) symnames544 marks545 labels546))) (gen-labels (lambda (ls547) (if (null? ls547) (quote ()) (cons (gen-label) (gen-labels (cdr ls547)))))) (gen-label (lambda () (string (quote #\i)))) (wrap-subst cdr) (wrap-marks car) (make-wrap cons) (id-sym-name&marks (lambda (x548 w549) (if (syntax-object? x548) (values (let ((e550 (syntax-object-expression x548))) (if (annotation? e550) (annotation-expression e550) e550)) (join-marks (wrap-marks w549) (wrap-marks (syntax-object-wrap x548)))) (values (let ((e551 x548)) (if (annotation? e551) (annotation-expression e551) e551)) (wrap-marks w549))))) (id? (lambda (x552) (cond ((symbol? x552) (quote #t)) ((syntax-object? x552) (symbol? (let ((e553 (syntax-object-expression x552))) (if (annotation? e553) (annotation-expression e553) e553)))) ((annotation? x552) (symbol? (annotation-expression x552))) (else (quote #f))))) (nonsymbol-id? (lambda (x554) (and (syntax-object? x554) (symbol? (let ((e555 (syntax-object-expression x554))) (if (annotation? e555) (annotation-expression e555) e555)))))) (global-extend (lambda (type556 sym557 val558) (put-global-definition-hook sym557 (cons type556 val558)))) (lookup (lambda (x559 r560) (cond ((assq x559 r560) => cdr) ((symbol? x559) (or (get-global-definition-hook x559) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env (lambda (r561) (if (null? r561) (quote ()) (let ((a562 (car r561))) (if (eq? (cadr a562) (quote macro)) (cons a562 (macros-only-env (cdr r561))) (macros-only-env (cdr r561))))))) (extend-var-env (lambda (labels563 vars564 r565) (if (null? labels563) r565 (extend-var-env (cdr labels563) (cdr vars564) (cons (cons (car labels563) (cons (quote lexical) (car vars564))) r565))))) (extend-env (lambda (labels566 bindings567 r568) (if (null? labels566) r568 (extend-env (cdr labels566) (cdr bindings567) (cons (cons (car labels566) (car bindings567)) r568))))) (binding-value cdr) (binding-type car) (source-annotation (lambda (x569) (cond ((annotation? x569) (annotation-source x569)) ((syntax-object? x569) (source-annotation (syntax-object-expression x569))) (else (quote #f))))) (set-syntax-object-wrap! (lambda (x570 update571) (vector-set! x570 (quote 2) update571))) (set-syntax-object-expression! (lambda (x572 update573) (vector-set! x572 (quote 1) update573))) (syntax-object-wrap (lambda (x574) (vector-ref x574 (quote 2)))) (syntax-object-expression (lambda (x575) (vector-ref x575 (quote 1)))) (syntax-object? (lambda (x576) (and (vector? x576) (= (vector-length x576) (quote 3)) (eq? (vector-ref x576 (quote 0)) (quote syntax-object))))) (make-syntax-object (lambda (expression wrap577) (vector (quote syntax-object) expression wrap577))) (build-letrec (lambda (src578 vars579 val-exps body-exp) (if (null? vars579) body-exp (list (quote letrec) (map list vars579 val-exps) body-exp)))) (build-named-let (lambda (src580 vars581 val-exps582 body-exp583) (if (null? vars581) body-exp583 (list (quote let) (car vars581) (map list (cdr vars581) val-exps582) body-exp583)))) (build-let (lambda (src584 vars585 val-exps586 body-exp587) (if (null? vars585) body-exp587 (list (quote let) (map list vars585 val-exps586) body-exp587)))) (build-sequence (lambda (src588 exps) (if (null? (cdr exps)) (car exps) (cons (quote begin) exps)))) (get-global-definition-hook (lambda (symbol) (getprop symbol (quote *sc-expander*)))) (put-global-definition-hook (lambda (symbol589 binding) (putprop symbol589 (quote *sc-expander*) binding))) (error-hook (lambda (who590 why what) (error who590 (quote "~a ~s") why what))) (local-eval-hook (lambda (x591) (eval (list noexpand x591)))) (top-level-eval-hook (lambda (x592) (eval (list noexpand x592)))) (annotation? (lambda (x593) (quote #f))) (fx< <) (fx= =) (fx- -) (fx+ +) (noexpand (quote "noexpand"))) (begin (global-extend (quote local-syntax) (quote letrec-syntax) (quote #t)) (global-extend (quote local-syntax) (quote let-syntax) (quote #f)) (global-extend (quote core) (quote fluid-let-syntax) (lambda (e594 r595 w596 s597) ((lambda (tmp598) ((lambda (tmp599) (if (if tmp599 (apply (lambda (_600 var601 val602 e1603 e2604) (valid-bound-ids? var601)) tmp599) (quote #f)) (apply (lambda (_606 var607 val608 e1609 e2610) (let ((names (map (lambda (x611) (id-var-name x611 w596)) var607))) (begin (for-each (lambda (id613 n614) (let ((t615 (binding-type (lookup n614 r595)))) (if (memv t615 (quote (displaced-lexical))) (syntax-error (source-wrap id613 w596 s597) (quote "identifier out of context"))))) var607 names) (chi-body (cons e1609 e2610) (source-wrap e594 w596 s597) (extend-env names (let ((trans-r618 (macros-only-env r595))) (map (lambda (x619) (cons (quote macro) (eval-local-transformer (chi x619 trans-r618 w596)))) val608)) r595) w596)))) tmp599) ((lambda (_621) (syntax-error (source-wrap e594 w596 s597))) tmp598))) (syntax-dispatch tmp598 (quote (any #(each (any any)) any . each-any))))) e594))) (global-extend (quote core) (quote quote) (lambda (e622 r623 w624 s625) ((lambda (tmp626) ((lambda (tmp627) (if tmp627 (apply (lambda (_628 e629) (list (quote quote) (strip e629 w624))) tmp627) ((lambda (_630) (syntax-error (source-wrap e622 w624 s625))) tmp626))) (syntax-dispatch tmp626 (quote (any any))))) e622))) (global-extend (quote core) (quote syntax) (letrec ((regen (lambda (x631) (let ((t632 (car x631))) (if (memv t632 (quote (ref))) (cadr x631) (if (memv t632 (quote (primitive))) (cadr x631) (if (memv t632 (quote (quote))) (list (quote quote) (cadr x631)) (if (memv t632 (quote (lambda))) (list (quote lambda) (cadr x631) (regen (caddr x631))) (if (memv t632 (quote (map))) (let ((ls633 (map regen (cdr x631)))) (cons (if (fx= (length ls633) (quote 2)) (quote map) (quote map)) ls633)) (cons (car x631) (map regen (cdr x631))))))))))) (gen-vector (lambda (x634) (cond ((eq? (car x634) (quote list)) (cons (quote vector) (cdr x634))) ((eq? (car x634) (quote quote)) (list (quote quote) (list->vector (cadr x634)))) (else (list (quote list->vector) x634))))) (gen-append (lambda (x635 y636) (if (equal? y636 (quote (quote ()))) x635 (list (quote append) x635 y636)))) (gen-cons (lambda (x637 y638) (let ((t639 (car y638))) (if (memv t639 (quote (quote))) (if (eq? (car x637) (quote quote)) (list (quote quote) (cons (cadr x637) (cadr y638))) (if (eq? (cadr y638) (quote ())) (list (quote list) x637) (list (quote cons) x637 y638))) (if (memv t639 (quote (list))) (cons (quote list) (cons x637 (cdr y638))) (list (quote cons) x637 y638)))))) (gen-map (lambda (e640 map-env) (let ((formals (map cdr map-env)) (actuals (map (lambda (x641) (list (quote ref) (car x641))) map-env))) (cond ((eq? (car e640) (quote ref)) (car actuals)) ((andmap (lambda (x642) (and (eq? (car x642) (quote ref)) (memq (cadr x642) formals))) (cdr e640)) (cons (quote map) (cons (list (quote primitive) (car e640)) (map (let ((r643 (map cons formals actuals))) (lambda (x644) (cdr (assq (cadr x644) r643)))) (cdr e640))))) (else (cons (quote map) (cons (list (quote lambda) formals e640) actuals))))))) (gen-mappend (lambda (e645 map-env646) (list (quote apply) (quote (primitive append)) (gen-map e645 map-env646)))) (gen-ref (lambda (src647 var648 level649 maps) (if (fx= level649 (quote 0)) (values var648 maps) (if (null? maps) (syntax-error src647 (quote "missing ellipsis in syntax form")) (call-with-values (lambda () (gen-ref src647 var648 (fx- level649 (quote 1)) (cdr maps))) (lambda (outer-var outer-maps) (let ((b650 (assq outer-var (car maps)))) (if b650 (values (cdr b650) maps) (let ((inner-var (gen-var (quote tmp)))) (values inner-var (cons (cons (cons outer-var inner-var) (car maps)) outer-maps))))))))))) (gen-syntax (lambda (src651 e652 r653 maps654 ellipsis?655) (if (id? e652) (let ((label656 (id-var-name e652 (quote (()))))) (let ((b657 (lookup label656 r653))) (if (eq? (binding-type b657) (quote syntax)) (call-with-values (lambda () (let ((var.lev (binding-value b657))) (gen-ref src651 (car var.lev) (cdr var.lev) maps654))) (lambda (var658 maps659) (values (list (quote ref) var658) maps659))) (if (ellipsis?655 e652) (syntax-error src651 (quote "misplaced ellipsis in syntax form")) (values (list (quote quote) e652) maps654))))) ((lambda (tmp660) ((lambda (tmp661) (if (if tmp661 (apply (lambda (dots e662) (ellipsis?655 dots)) tmp661) (quote #f)) (apply (lambda (dots663 e664) (gen-syntax src651 e664 r653 maps654 (lambda (x665) (quote #f)))) tmp661) ((lambda (tmp666) (if (if tmp666 (apply (lambda (x667 dots668 y669) (ellipsis?655 dots668)) tmp666) (quote #f)) (apply (lambda (x670 dots671 y672) (let f673 ((y674 y672) (k675 (lambda (maps676) (call-with-values (lambda () (gen-syntax src651 x670 r653 (cons (quote ()) maps676) ellipsis?655)) (lambda (x677 maps678) (if (null? (car maps678)) (syntax-error src651 (quote "extra ellipsis in syntax form")) (values (gen-map x677 (car maps678)) (cdr maps678)))))))) ((lambda (tmp679) ((lambda (tmp680) (if (if tmp680 (apply (lambda (dots681 y682) (ellipsis?655 dots681)) tmp680) (quote #f)) (apply (lambda (dots683 y684) (f673 y684 (lambda (maps685) (call-with-values (lambda () (k675 (cons (quote ()) maps685))) (lambda (x686 maps687) (if (null? (car maps687)) (syntax-error src651 (quote "extra ellipsis in syntax form")) (values (gen-mappend x686 (car maps687)) (cdr maps687)))))))) tmp680) ((lambda (_688) (call-with-values (lambda () (gen-syntax src651 y674 r653 maps654 ellipsis?655)) (lambda (y689 maps690) (call-with-values (lambda () (k675 maps690)) (lambda (x691 maps692) (values (gen-append x691 y689) maps692)))))) tmp679))) (syntax-dispatch tmp679 (quote (any . any))))) y674))) tmp666) ((lambda (tmp693) (if tmp693 (apply (lambda (x694 y695) (call-with-values (lambda () (gen-syntax src651 x694 r653 maps654 ellipsis?655)) (lambda (x696 maps697) (call-with-values (lambda () (gen-syntax src651 y695 r653 maps697 ellipsis?655)) (lambda (y698 maps699) (values (gen-cons x696 y698) maps699)))))) tmp693) ((lambda (tmp700) (if tmp700 (apply (lambda (e1701 e2702) (call-with-values (lambda () (gen-syntax src651 (cons e1701 e2702) r653 maps654 ellipsis?655)) (lambda (e704 maps705) (values (gen-vector e704) maps705)))) tmp700) ((lambda (_706) (values (list (quote quote) e652) maps654)) tmp660))) (syntax-dispatch tmp660 (quote #(vector (any . each-any))))))) (syntax-dispatch tmp660 (quote (any . any)))))) (syntax-dispatch tmp660 (quote (any any . any)))))) (syntax-dispatch tmp660 (quote (any any))))) e652))))) (lambda (e707 r708 w709 s710) (let ((e711 (source-wrap e707 w709 s710))) ((lambda (tmp712) ((lambda (tmp713) (if tmp713 (apply (lambda (_714 x715) (call-with-values (lambda () (gen-syntax e711 x715 r708 (quote ()) ellipsis?)) (lambda (e716 maps717) (regen e716)))) tmp713) ((lambda (_718) (syntax-error e711)) tmp712))) (syntax-dispatch tmp712 (quote (any any))))) e711))))) (global-extend (quote core) (quote lambda) (lambda (e719 r720 w721 s722) ((lambda (tmp723) ((lambda (tmp724) (if tmp724 (apply (lambda (_725 c726) (chi-lambda-clause (source-wrap e719 w721 s722) c726 r720 w721 (lambda (vars727 body728) (list (quote lambda) vars727 body728)))) tmp724) (syntax-error tmp723))) (syntax-dispatch tmp723 (quote (any . any))))) e719))) (global-extend (quote core) (quote let) (letrec ((chi-let (lambda (e729 r730 w731 s732 constructor733 ids734 vals735 exps736) (if (not (valid-bound-ids? ids734)) (syntax-error e729 (quote "duplicate bound variable in")) (let ((labels737 (gen-labels ids734)) (new-vars738 (map gen-var ids734))) (let ((nw (make-binding-wrap ids734 labels737 w731)) (nr (extend-var-env labels737 new-vars738 r730))) (constructor733 s732 new-vars738 (map (lambda (x739) (chi x739 r730 w731)) vals735) (chi-body exps736 (source-wrap e729 nw s732) nr nw)))))))) (lambda (e740 r741 w742 s743) ((lambda (tmp744) ((lambda (tmp745) (if tmp745 (apply (lambda (_746 id747 val748 e1749 e2750) (chi-let e740 r741 w742 s743 build-let id747 val748 (cons e1749 e2750))) tmp745) ((lambda (tmp754) (if (if tmp754 (apply (lambda (_755 f756 id757 val758 e1759 e2760) (id? f756)) tmp754) (quote #f)) (apply (lambda (_761 f762 id763 val764 e1765 e2766) (chi-let e740 r741 w742 s743 build-named-let (cons f762 id763) val764 (cons e1765 e2766))) tmp754) ((lambda (_770) (syntax-error (source-wrap e740 w742 s743))) tmp744))) (syntax-dispatch tmp744 (quote (any any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp744 (quote (any #(each (any any)) any . each-any))))) e740)))) (global-extend (quote core) (quote letrec) (lambda (e771 r772 w773 s774) ((lambda (tmp775) ((lambda (tmp776) (if tmp776 (apply (lambda (_777 id778 val779 e1780 e2781) (let ((ids782 id778)) (if (not (valid-bound-ids? ids782)) (syntax-error e771 (quote "duplicate bound variable in")) (let ((labels784 (gen-labels ids782)) (new-vars785 (map gen-var ids782))) (let ((w786 (make-binding-wrap ids782 labels784 w773)) (r787 (extend-var-env labels784 new-vars785 r772))) (build-letrec s774 new-vars785 (map (lambda (x788) (chi x788 r787 w786)) val779) (chi-body (cons e1780 e2781) (source-wrap e771 w786 s774) r787 w786))))))) tmp776) ((lambda (_791) (syntax-error (source-wrap e771 w773 s774))) tmp775))) (syntax-dispatch tmp775 (quote (any #(each (any any)) any . each-any))))) e771))) (global-extend (quote core) (quote set!) (lambda (e792 r793 w794 s795) ((lambda (tmp796) ((lambda (tmp797) (if (if tmp797 (apply (lambda (_798 id799 val800) (id? id799)) tmp797) (quote #f)) (apply (lambda (_801 id802 val803) (let ((val804 (chi val803 r793 w794)) (n805 (id-var-name id802 w794))) (let ((b806 (lookup n805 r793))) (let ((t807 (binding-type b806))) (if (memv t807 (quote (lexical))) (list (quote set!) (binding-value b806) val804) (if (memv t807 (quote (global))) (list (quote set!) n805 val804) (if (memv t807 (quote (displaced-lexical))) (syntax-error (wrap id802 w794) (quote "identifier out of context")) (syntax-error (source-wrap e792 w794 s795))))))))) tmp797) ((lambda (_808) (syntax-error (source-wrap e792 w794 s795))) tmp796))) (syntax-dispatch tmp796 (quote (any any any))))) e792))) (global-extend (quote begin) (quote begin) (quote ())) (global-extend (quote define) (quote define) (quote ())) (global-extend (quote define-syntax) (quote define-syntax) (quote ())) (global-extend (quote eval-when) (quote eval-when) (quote ())) (global-extend (quote core) (quote syntax-case) (letrec ((gen-syntax-case (lambda (x809 keys clauses r810) (if (null? clauses) (list (quote syntax-error) x809) ((lambda (tmp811) ((lambda (tmp812) (if tmp812 (apply (lambda (pat exp813) (if (and (id? pat) (andmap (lambda (x814) (not (free-id=? pat x814))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? id-var-name same-marks? join-marks join-wraps smart-append make-binding-wrap extend-ribcage! make-empty-ribcage new-mark anti-mark the-anti-mark top-marked? top-wrap empty-wrap set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels gen-label make-rename rename-marks rename-new rename-old subst-rename? wrap-subst wrap-marks make-wrap id-sym-name&marks id-sym-name id? nonsymbol-id? global-extend lookup macros-only-env extend-var-env extend-env null-env binding-value binding-type make-binding arg-check source-annotation no-source unannotate set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object self-evaluating? build-lexical-var build-letrec build-named-let build-let build-sequence build-data build-primref build-lambda build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook error-hook local-eval-hook top-level-eval-hook annotation? fx< fx= fx- fx+ noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure) ((top)) ("i"))))) keys))) (let ((labels815 (list (gen-label))) (var816 (gen-var pat))) (list (list (quote lambda) (list var816) (chi exp813 (extend-env labels815 (list (cons (quote syntax) (cons var816 (quote 0)))) r810) (make-binding-wrap (list pat) labels815 (quote (()))))) x809)) (gen-clause x809 keys (cdr clauses) r810 pat (quote #t) exp813))) tmp812) ((lambda (tmp817) (if tmp817 (apply (lambda (pat818 fender exp819) (gen-clause x809 keys (cdr clauses) r810 pat818 fender exp819)) tmp817) ((lambda (_820) (syntax-error (car clauses) (quote "invalid syntax-case clause"))) tmp811))) (syntax-dispatch tmp811 (quote (any any any)))))) (syntax-dispatch tmp811 (quote (any any))))) (car clauses))))) (gen-clause (lambda (x821 keys822 clauses823 r824 pat825 fender826 exp827) (call-with-values (lambda () (convert-pattern pat825 keys822)) (lambda (p828 pvars) (cond ((not (distinct-bound-ids? (map car pvars))) (syntax-error pat825 (quote "duplicate pattern variable in syntax-case pattern"))) ((not (andmap (lambda (x829) (not (ellipsis? (car x829)))) pvars)) (syntax-error pat825 (quote "misplaced ellipsis in syntax-case pattern"))) (else (let ((y830 (gen-var (quote tmp)))) (list (list (quote lambda) (list y830) (let ((y831 y830)) (list (quote if) ((lambda (tmp832) ((lambda (tmp833) (if tmp833 (apply (lambda () y831) tmp833) ((lambda (_834) (list (quote if) y831 (build-dispatch-call pvars fender826 y831 r824) (list (quote quote) (quote #f)))) tmp832))) (syntax-dispatch tmp832 (quote #(atom #t))))) fender826) (build-dispatch-call pvars exp827 y831 r824) (gen-syntax-case x821 keys822 clauses823 r824)))) (if (eq? p828 (quote any)) (list (quote list) x821) (list (quote syntax-dispatch) x821 (list (quote quote) p828))))))))))) (build-dispatch-call (lambda (pvars835 exp836 y837 r838) (let ((ids839 (map car pvars835)) (levels (map cdr pvars835))) (let ((labels840 (gen-labels ids839)) (new-vars841 (map gen-var ids839))) (list (quote apply) (list (quote lambda) new-vars841 (chi exp836 (extend-env labels840 (map (lambda (var842 level843) (cons (quote syntax) (cons var842 level843))) new-vars841 (map cdr pvars835)) r838) (make-binding-wrap ids839 labels840 (quote (()))))) y837))))) (convert-pattern (lambda (pattern keys844) (let cvt ((p845 pattern) (n846 (quote 0)) (ids847 (quote ()))) (if (id? p845) (if (bound-id-member? p845 keys844) (values (vector (quote free-id) p845) ids847) (values (quote any) (cons (cons p845 n846) ids847))) ((lambda (tmp848) ((lambda (tmp849) (if (if tmp849 (apply (lambda (x850 dots851) (ellipsis? dots851)) tmp849) (quote #f)) (apply (lambda (x852 dots853) (call-with-values (lambda () (cvt x852 (fx+ n846 (quote 1)) ids847)) (lambda (p854 ids855) (values (if (eq? p854 (quote any)) (quote each-any) (vector (quote each) p854)) ids855)))) tmp849) ((lambda (tmp856) (if tmp856 (apply (lambda (x857 y858) (call-with-values (lambda () (cvt y858 n846 ids847)) (lambda (y859 ids860) (call-with-values (lambda () (cvt x857 n846 ids860)) (lambda (x861 ids862) (values (cons x861 y859) ids862)))))) tmp856) ((lambda (tmp863) (if tmp863 (apply (lambda () (values (quote ()) ids847)) tmp863) ((lambda (tmp864) (if tmp864 (apply (lambda (x865) (call-with-values (lambda () (cvt x865 n846 ids847)) (lambda (p867 ids868) (values (vector (quote vector) p867) ids868)))) tmp864) ((lambda (x869) (values (vector (quote atom) (strip p845 (quote (())))) ids847)) tmp848))) (syntax-dispatch tmp848 (quote #(vector each-any)))))) (syntax-dispatch tmp848 (quote ()))))) (syntax-dispatch tmp848 (quote (any . any)))))) (syntax-dispatch tmp848 (quote (any any))))) p845)))))) (lambda (e870 r871 w872 s873) (let ((e874 (source-wrap e870 w872 s873))) ((lambda (tmp875) ((lambda (tmp876) (if tmp876 (apply (lambda (_877 val878 key m879) (if (andmap (lambda (x880) (and (id? x880) (not (ellipsis? x880)))) key) (let ((x882 (gen-var (quote tmp)))) (list (list (quote lambda) (list x882) (gen-syntax-case x882 key m879 r871)) (chi val878 r871 (quote (()))))) (syntax-error e874 (quote "invalid literals list in")))) tmp876) (syntax-error tmp875))) (syntax-dispatch tmp875 (quote (any any each-any . each-any))))) e874))))) (set! sc-expand (let ((m885 (quote e)) (esew886 (quote (eval)))) (lambda (x887) (if (and (pair? x887) (equal? (car x887) noexpand)) (cadr x887) (chi-top x887 (quote ()) (quote ((top))) m885 esew886))))) (set! sc-expand3 (let ((m888 (quote e)) (esew889 (quote (eval)))) (lambda (x890 . rest) (if (and (pair? x890) (equal? (car x890) noexpand)) (cadr x890) (chi-top x890 (quote ()) (quote ((top))) (if (null? rest) m888 (car rest)) (if (or (null? rest) (null? (cdr rest))) esew889 (cadr rest))))))) (set! identifier? (lambda (x891) (nonsymbol-id? x891))) (set! datum->syntax-object (lambda (id892 datum) (begin (let ((x893 id892)) (if (not (nonsymbol-id? x893)) (error-hook (quote datum->syntax-object) (quote "invalid argument") x893))) (make-syntax-object datum (syntax-object-wrap id892))))) (set! syntax-object->datum (lambda (x894) (strip x894 (quote (()))))) (set! generate-temporaries (lambda (ls895) (begin (let ((x896 ls895)) (if (not (list? x896)) (error-hook (quote generate-temporaries) (quote "invalid argument") x896))) (map (lambda (x897) (wrap (gensym) (quote ((top))))) ls895)))) (set! free-identifier=? (lambda (x898 y899) (begin (let ((x900 x898)) (if (not (nonsymbol-id? x900)) (error-hook (quote free-identifier=?) (quote "invalid argument") x900))) (let ((x901 y899)) (if (not (nonsymbol-id? x901)) (error-hook (quote free-identifier=?) (quote "invalid argument") x901))) (free-id=? x898 y899)))) (set! bound-identifier=? (lambda (x902 y903) (begin (let ((x904 x902)) (if (not (nonsymbol-id? x904)) (error-hook (quote bound-identifier=?) (quote "invalid argument") x904))) (let ((x905 y903)) (if (not (nonsymbol-id? x905)) (error-hook (quote bound-identifier=?) (quote "invalid argument") x905))) (bound-id=? x902 y903)))) (set! syntax-error (lambda (object . messages) (begin (for-each (lambda (x906) (let ((x907 x906)) (if (not (string? x907)) (error-hook (quote syntax-error) (quote "invalid argument") x907)))) messages) (let ((message (if (null? messages) (quote "invalid syntax") (apply string-append messages)))) (error-hook (quote #f) message (strip object (quote (())))))))) (set! install-global-transformer (lambda (sym908 v909) (begin (let ((x910 sym908)) (if (not (symbol? x910)) (error-hook (quote define-syntax) (quote "invalid argument") x910))) (let ((x911 v909)) (if (not (procedure? x911)) (error-hook (quote define-syntax) (quote "invalid argument") x911))) (global-extend (quote macro) sym908 v909)))) (letrec ((match (lambda (e912 p913 w914 r915) (cond ((not r915) (quote #f)) ((eq? p913 (quote any)) (cons (wrap e912 w914) r915)) ((syntax-object? e912) (match* (let ((e916 (syntax-object-expression e912))) (if (annotation? e916) (annotation-expression e916) e916)) p913 (join-wraps w914 (syntax-object-wrap e912)) r915)) (else (match* (let ((e917 e912)) (if (annotation? e917) (annotation-expression e917) e917)) p913 w914 r915))))) (match* (lambda (e918 p919 w920 r921) (cond ((null? p919) (and (null? e918) r921)) ((pair? p919) (and (pair? e918) (match (car e918) (car p919) w920 (match (cdr e918) (cdr p919) w920 r921)))) ((eq? p919 (quote each-any)) (let ((l (match-each-any e918 w920))) (and l (cons l r921)))) (else (let ((t922 (vector-ref p919 (quote 0)))) (if (memv t922 (quote (each))) (if (null? e918) (match-empty (vector-ref p919 (quote 1)) r921) (let ((l923 (match-each e918 (vector-ref p919 (quote 1)) w920))) (and l923 (let collect ((l924 l923)) (if (null? (car l924)) r921 (cons (map car l924) (collect (map cdr l924)))))))) (if (memv t922 (quote (free-id))) (and (id? e918) (free-id=? (wrap e918 w920) (vector-ref p919 (quote 1))) r921) (if (memv t922 (quote (atom))) (and (equal? (vector-ref p919 (quote 1)) (strip e918 w920)) r921) (if (memv t922 (quote (vector))) (and (vector? e918) (match (vector->list e918) (vector-ref p919 (quote 1)) w920 r921))))))))))) (match-empty (lambda (p925 r926) (cond ((null? p925) r926) ((eq? p925 (quote any)) (cons (quote ()) r926)) ((pair? p925) (match-empty (car p925) (match-empty (cdr p925) r926))) ((eq? p925 (quote each-any)) (cons (quote ()) r926)) (else (let ((t927 (vector-ref p925 (quote 0)))) (if (memv t927 (quote (each))) (match-empty (vector-ref p925 (quote 1)) r926) (if (memv t927 (quote (free-id atom))) r926 (if (memv t927 (quote (vector))) (match-empty (vector-ref p925 (quote 1)) r926))))))))) (match-each-any (lambda (e928 w929) (cond ((annotation? e928) (match-each-any (annotation-expression e928) w929)) ((pair? e928) (let ((l930 (match-each-any (cdr e928) w929))) (and l930 (cons (wrap (car e928) w929) l930)))) ((null? e928) (quote ())) ((syntax-object? e928) (match-each-any (syntax-object-expression e928) (join-wraps w929 (syntax-object-wrap e928)))) (else (quote #f))))) (match-each (lambda (e931 p932 w933) (cond ((annotation? e931) (match-each (annotation-expression e931) p932 w933)) ((pair? e931) (let ((first934 (match (car e931) p932 w933 (quote ())))) (and first934 (let ((rest935 (match-each (cdr e931) p932 w933))) (and rest935 (cons first934 rest935)))))) ((null? e931) (quote ())) ((syntax-object? e931) (match-each (syntax-object-expression e931) p932 (join-wraps w933 (syntax-object-wrap e931)))) (else (quote #f)))))) (set! syntax-dispatch (lambda (e936 p937) (cond ((eq? p937 (quote any)) (list e936)) ((syntax-object? e936) (match* (let ((e938 (syntax-object-expression e936))) (if (annotation? e938) (annotation-expression e938) e938)) p937 (syntax-object-wrap e936) (quote ()))) (else (match* (let ((e939 e936)) (if (annotation? e939) (annotation-expression e939) e939)) p937 (quote (())) (quote ()))))))))) -(install-global-transformer (quote with-syntax) (lambda (x940) ((lambda (tmp941) ((lambda (tmp942) (if tmp942 (apply (lambda (_943 e1944 e2945) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e1944 e2945))) tmp942) ((lambda (tmp947) (if tmp947 (apply (lambda (_948 out in e1949 e2950) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) in (quote ()) (list out (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e1949 e2950))))) tmp947) ((lambda (tmp952) (if tmp952 (apply (lambda (_953 out954 in955 e1956 e2957) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) in955) (quote ()) (list out954 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e1956 e2957))))) tmp952) (syntax-error tmp941))) (syntax-dispatch tmp941 (quote (any #(each (any any)) any . each-any)))))) (syntax-dispatch tmp941 (quote (any ((any any)) any . each-any)))))) (syntax-dispatch tmp941 (quote (any () any . each-any))))) x940))) -(install-global-transformer (quote syntax-rules) (lambda (x961) ((lambda (tmp962) ((lambda (tmp963) (if tmp963 (apply (lambda (_964 k965 keyword pattern966 template) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons k965 (map (lambda (tmp969 tmp968) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) tmp968) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) tmp969))) template pattern966)))))) tmp963) (syntax-error tmp962))) (syntax-dispatch tmp962 (quote (any each-any . #(each ((any . any) any))))))) x961))) -(install-global-transformer (quote let*) (lambda (x970) ((lambda (tmp971) ((lambda (tmp972) (if (if tmp972 (apply (lambda (let* x973 v974 e1975 e2976) (andmap identifier? x973)) tmp972) (quote #f)) (apply (lambda (let*978 x979 v980 e1981 e2982) (let f983 ((bindings984 (map list x979 v980))) (if (null? bindings984) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons (quote ()) (cons e1981 e2982))) ((lambda (tmp988) ((lambda (tmp989) (if tmp989 (apply (lambda (body binding) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list binding) body)) tmp989) (syntax-error tmp988))) (syntax-dispatch tmp988 (quote (any any))))) (list (f983 (cdr bindings984)) (car bindings984)))))) tmp972) (syntax-error tmp971))) (syntax-dispatch tmp971 (quote (any #(each (any any)) any . each-any))))) x970))) -(install-global-transformer (quote do) (lambda (orig-x) ((lambda (tmp990) ((lambda (tmp991) (if tmp991 (apply (lambda (_992 var init step e0 e1 c) ((lambda (tmp993) ((lambda (tmp994) (if tmp994 (apply (lambda (step995) ((lambda (tmp996) ((lambda (tmp997) (if tmp997 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (map list var init) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) e0) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (append c (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) step995))))))) tmp997) ((lambda (tmp1002) (if tmp1002 (apply (lambda (e11003 e2) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (map list var init) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) e0 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (cons e11003 e2)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) (append c (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))))) step995))))))) tmp1002) (syntax-error tmp996))) (syntax-dispatch tmp996 (quote (any . each-any)))))) (syntax-dispatch tmp996 (quote ())))) e1)) tmp994) (syntax-error tmp993))) (syntax-dispatch tmp993 (quote each-any)))) (map (lambda (v s) ((lambda (tmp1010) ((lambda (tmp1011) (if tmp1011 (apply (lambda () v) tmp1011) ((lambda (tmp1012) (if tmp1012 (apply (lambda (e) e) tmp1012) ((lambda (_1013) (syntax-error orig-x)) tmp1010))) (syntax-dispatch tmp1010 (quote (any)))))) (syntax-dispatch tmp1010 (quote ())))) s)) var step))) tmp991) (syntax-error tmp990))) (syntax-dispatch tmp990 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x))) -(install-global-transformer (quote quasiquote) (letrec ((quasicons (lambda (x1016 y) ((lambda (tmp1017) ((lambda (tmp1018) (if tmp1018 (apply (lambda (x1019 y1020) ((lambda (tmp1021) ((lambda (tmp1022) (if tmp1022 (apply (lambda (dy) ((lambda (tmp1023) ((lambda (tmp1024) (if tmp1024 (apply (lambda (dx) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) (cons dx dy))) tmp1024) ((lambda (_1025) (if (null? dy) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) x1019) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) x1019 y1020))) tmp1023))) (syntax-dispatch tmp1023 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any))))) x1019)) tmp1022) ((lambda (tmp) (if tmp (apply (lambda (stuff) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) (cons x1019 stuff))) tmp) ((lambda (else) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) x1019 y1020)) tmp1021))) (syntax-dispatch tmp1021 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) . any)))))) (syntax-dispatch tmp1021 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any))))) y1020)) tmp1018) (syntax-error tmp1017))) (syntax-dispatch tmp1017 (quote (any any))))) (list x1016 y)))) (quasiappend (lambda (x y1026) ((lambda (tmp1027) ((lambda (tmp1028) (if tmp1028 (apply (lambda (x1029 y1030) ((lambda (tmp1031) ((lambda (tmp1032) (if tmp1032 (apply (lambda () x1029) tmp1032) ((lambda (_) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) x1029 y1030)) tmp1031))) (syntax-dispatch tmp1031 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) ()))))) y1030)) tmp1028) (syntax-error tmp1027))) (syntax-dispatch tmp1027 (quote (any any))))) (list x y1026)))) (quasivector (lambda (x1033) ((lambda (tmp1034) ((lambda (x1035) ((lambda (tmp1036) ((lambda (tmp1037) (if tmp1037 (apply (lambda (x1038) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) (list->vector x1038))) tmp1037) ((lambda (tmp1040) (if tmp1040 (apply (lambda (x1041) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) x1041)) tmp1040) ((lambda (_1043) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) x1035)) tmp1036))) (syntax-dispatch tmp1036 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) . each-any)))))) (syntax-dispatch tmp1036 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) each-any))))) x1035)) tmp1034)) x1033))) (quasi (lambda (p lev) ((lambda (tmp1044) ((lambda (tmp1045) (if tmp1045 (apply (lambda (p1046) (if (= lev (quote 0)) p1046 (quasicons (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))))) (quasi (list p1046) (- lev (quote 1)))))) tmp1045) ((lambda (tmp1047) (if tmp1047 (apply (lambda (p1048 q) (if (= lev (quote 0)) (quasiappend p1048 (quasi q lev)) (quasicons (quasicons (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))))) (quasi (list p1048) (- lev (quote 1)))) (quasi q lev)))) tmp1047) ((lambda (tmp1049) (if tmp1049 (apply (lambda (p1050) (quasicons (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i")))))) (quasi (list p1050) (+ lev (quote 1))))) tmp1049) ((lambda (tmp1051) (if tmp1051 (apply (lambda (p1052 q1053) (quasicons (quasi p1052 lev) (quasi q1053 lev))) tmp1051) ((lambda (tmp1054) (if tmp1054 (apply (lambda (x1055) (quasivector (quasi x1055 lev))) tmp1054) ((lambda (p1057) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) p1057)) tmp1044))) (syntax-dispatch tmp1044 (quote #(vector each-any)))))) (syntax-dispatch tmp1044 (quote (any . any)))))) (syntax-dispatch tmp1044 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any)))))) (syntax-dispatch tmp1044 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any) . any)))))) (syntax-dispatch tmp1044 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))))) any))))) p)))) (lambda (x1058) ((lambda (tmp1059) ((lambda (tmp1060) (if tmp1060 (apply (lambda (_1061 e1062) (quasi e1062 (quote 0))) tmp1060) (syntax-error tmp1059))) (syntax-dispatch tmp1059 (quote (any any))))) x1058)))) -(install-global-transformer (quote include) (lambda (x1063) (letrec ((read-file (lambda (fn k) (let ((p1064 (open-input-file fn))) (let f ((x1065 (read p1064))) (if (eof-object? x1065) (begin (close-input-port p1064) (quote ())) (cons (datum->syntax-object k x1065) (f (read p1064))))))))) ((lambda (tmp1066) ((lambda (tmp1067) (if tmp1067 (apply (lambda (k1068 filename) (let ((fn1069 (syntax-object->datum filename))) ((lambda (tmp1070) ((lambda (tmp1071) (if tmp1071 (apply (lambda (exp) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))))) exp)) tmp1071) (syntax-error tmp1070))) (syntax-dispatch tmp1070 (quote each-any)))) (read-file fn1069 k1068)))) tmp1067) (syntax-error tmp1066))) (syntax-dispatch tmp1066 (quote (any any))))) x1063)))) -(install-global-transformer (quote unquote) (lambda (x1073) ((lambda (tmp1074) ((lambda (tmp1075) (if tmp1075 (apply (lambda (_1076 e1077) (error (quote unquote) (quote "expression ,~s not valid outside of quasiquote") (syntax-object->datum e1077))) tmp1075) (syntax-error tmp1074))) (syntax-dispatch tmp1074 (quote (any any))))) x1073))) -(install-global-transformer (quote unquote-splicing) (lambda (x1078) ((lambda (tmp1079) ((lambda (tmp1080) (if tmp1080 (apply (lambda (_1081 e1082) (error (quote unquote-splicing) (quote "expression ,@~s not valid outside of quasiquote") (syntax-object->datum e1082))) tmp1080) (syntax-error tmp1079))) (syntax-dispatch tmp1079 (quote (any any))))) x1078))) -(install-global-transformer (quote case) (lambda (x1083) ((lambda (tmp1084) ((lambda (tmp1085) (if tmp1085 (apply (lambda (_1086 e1087 m1 m2) ((lambda (tmp1088) ((lambda (body1089) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) e1087)) body1089)) tmp1088)) (let f1090 ((clause m1) (clauses m2)) (if (null? clauses) ((lambda (tmp1092) ((lambda (tmp1093) (if tmp1093 (apply (lambda (e11094 e21095) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e11094 e21095))) tmp1093) ((lambda (tmp1097) (if tmp1097 (apply (lambda (k1098 e11099 e21100) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) k1098)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e11099 e21100)))) tmp1097) ((lambda (_1103) (syntax-error x1083)) tmp1092))) (syntax-dispatch tmp1092 (quote (each-any any . each-any)))))) (syntax-dispatch tmp1092 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) any . each-any))))) clause) ((lambda (tmp1104) ((lambda (rest) ((lambda (tmp1105) ((lambda (tmp1106) (if tmp1106 (apply (lambda (k1107 e11108 e21109) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) k1107)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e11108 e21109)) rest)) tmp1106) ((lambda (_1112) (syntax-error x1083)) tmp1105))) (syntax-dispatch tmp1105 (quote (each-any any . each-any))))) clause)) tmp1104)) (f1090 (car clauses) (cdr clauses))))))) tmp1085) (syntax-error tmp1084))) (syntax-dispatch tmp1084 (quote (any any any . each-any))))) x1083))) -(install-global-transformer (quote identifier-syntax) (lambda (x1113) ((lambda (tmp1114) ((lambda (tmp1115) (if tmp1115 (apply (lambda (_1116 e1117) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) e1117)) (list (cons _1116 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))))) (cons e1117 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")))))))))))) tmp1115) (syntax-error tmp1114))) (syntax-dispatch tmp1114 (quote (any any))))) x1113))) diff --git a/ice-9/psyntax.ss b/ice-9/psyntax.ss deleted file mode 100644 index f45ac9191..000000000 --- a/ice-9/psyntax.ss +++ /dev/null @@ -1,2179 +0,0 @@ -;;; Portable implementation of syntax-case -;;; Extracted from Chez Scheme Version 5.9f -;;; Authors: R. Kent Dybvig, Oscar Waddell, Bob Hieb, Carl Bruggeman - -;;; Copyright (c) 1992-1997 Cadence Research Systems -;;; Permission to copy this software, in whole or in part, to use this -;;; software for any lawful purpose, and to redistribute this software -;;; is granted subject to the restriction that all copies made of this -;;; software must include this copyright notice in full. This software -;;; is provided AS IS, with NO WARRANTY, EITHER EXPRESS OR IMPLIED, -;;; INCLUDING BUT NOT LIMITED TO IMPLIED WARRANTIES OF MERCHANTABILITY -;;; OR FITNESS FOR ANY PARTICULAR PURPOSE. IN NO EVENT SHALL THE -;;; AUTHORS BE LIABLE FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES OF ANY -;;; NATURE WHATSOEVER. - - -;;; Before attempting to port this code to a new implementation of -;;; Scheme, please read the notes below carefully. - - -;;; This file defines the syntax-case expander, sc-expand, and a set -;;; of associated syntactic forms and procedures. Of these, the -;;; following are documented in The Scheme Programming Language, -;;; Second Edition (R. Kent Dybvig, Prentice Hall, 1996). Most are -;;; also documented in the R4RS and draft R5RS. -;;; -;;; bound-identifier=? -;;; datum->syntax-object -;;; define-syntax -;;; fluid-let-syntax -;;; free-identifier=? -;;; generate-temporaries -;;; identifier? -;;; identifier-syntax -;;; let-syntax -;;; letrec-syntax -;;; syntax -;;; syntax-case -;;; syntax-object->datum -;;; syntax-rules -;;; with-syntax -;;; -;;; All standard Scheme syntactic forms are supported by the expander -;;; or syntactic abstractions defined in this file. Only the R4RS -;;; delay is omitted, since its expansion is implementation-dependent. - -;;; The remaining exports are listed below: -;;; -;;; (sc-expand datum) -;;; if datum represents a valid expression, sc-expand returns an -;;; expanded version of datum in a core language that includes no -;;; syntactic abstractions. The core language includes begin, -;;; define, if, lambda, letrec, quote, and set!. -;;; (eval-when situations expr ...) -;;; conditionally evaluates expr ... at compile-time or run-time -;;; depending upon situations (see the Chez Scheme System Manual, -;;; Revision 3, for a complete description) -;;; (syntax-error object message) -;;; used to report errors found during expansion -;;; (install-global-transformer symbol value) -;;; used by expanded code to install top-level syntactic abstractions -;;; (syntax-dispatch e p) -;;; used by expanded code to handle syntax-case matching - -;;; The following nonstandard procedures must be provided by the -;;; implementation for this code to run. -;;; -;;; (void) -;;; returns the implementation's cannonical "unspecified value". This -;;; usually works: (define void (lambda () (if #f #f))). -;;; -;;; (andmap proc list1 list2 ...) -;;; returns true if proc returns true when applied to each element of list1 -;;; along with the corresponding elements of list2 .... -;;; The following definition works but does no error checking: -;;; -;;; (define andmap -;;; (lambda (f first . rest) -;;; (or (null? first) -;;; (if (null? rest) -;;; (let andmap ((first first)) -;;; (let ((x (car first)) (first (cdr first))) -;;; (if (null? first) -;;; (f x) -;;; (and (f x) (andmap first))))) -;;; (let andmap ((first first) (rest rest)) -;;; (let ((x (car first)) -;;; (xr (map car rest)) -;;; (first (cdr first)) -;;; (rest (map cdr rest))) -;;; (if (null? first) -;;; (apply f (cons x xr)) -;;; (and (apply f (cons x xr)) (andmap first rest))))))))) -;;; -;;; The following nonstandard procedures must also be provided by the -;;; implementation for this code to run using the standard portable -;;; hooks and output constructors. They are not used by expanded code, -;;; and so need be present only at expansion time. -;;; -;;; (eval x) -;;; where x is always in the form ("noexpand" expr). -;;; returns the value of expr. the "noexpand" flag is used to tell the -;;; evaluator/expander that no expansion is necessary, since expr has -;;; already been fully expanded to core forms. -;;; -;;; eval will not be invoked during the loading of psyntax.pp. After -;;; psyntax.pp has been loaded, the expansion of any macro definition, -;;; whether local or global, will result in a call to eval. If, however, -;;; sc-expand has already been registered as the expander to be used -;;; by eval, and eval accepts one argument, nothing special must be done -;;; to support the "noexpand" flag, since it is handled by sc-expand. -;;; -;;; (error who format-string why what) -;;; where who is either a symbol or #f, format-string is always "~a ~s", -;;; why is always a string, and what may be any object. error should -;;; signal an error with a message something like -;;; -;;; "error in <who>: <why> <what>" -;;; -;;; (gensym) -;;; returns a unique symbol each time it's called -;;; -;;; (putprop symbol key value) -;;; (getprop symbol key) -;;; key is always the symbol *sc-expander*; value may be any object. -;;; putprop should associate the given value with the given symbol in -;;; some way that it can be retrieved later with getprop. - -;;; When porting to a new Scheme implementation, you should define the -;;; procedures listed above, load the expanded version of psyntax.ss -;;; (psyntax.pp, which should be available whereever you found -;;; psyntax.ss), and register sc-expand as the current expander (how -;;; you do this depends upon your implementation of Scheme). You may -;;; change the hooks and constructors defined toward the beginning of -;;; the code below, but to avoid bootstrapping problems, do so only -;;; after you have a working version of the expander. - -;;; Chez Scheme allows the syntactic form (syntax <template>) to be -;;; abbreviated to #'<template>, just as (quote <datum>) may be -;;; abbreviated to '<datum>. The #' syntax makes programs written -;;; using syntax-case shorter and more readable and draws out the -;;; intuitive connection between syntax and quote. - -;;; If you find that this code loads or runs slowly, consider -;;; switching to faster hardware or a faster implementation of -;;; Scheme. In Chez Scheme on a 200Mhz Pentium Pro, expanding, -;;; compiling (with full optimization), and loading this file takes -;;; between one and two seconds. - -;;; In the expander implementation, we sometimes use syntactic abstractions -;;; when procedural abstractions would suffice. For example, we define -;;; top-wrap and top-marked? as -;;; (define-syntax top-wrap (identifier-syntax '((top)))) -;;; (define-syntax top-marked? -;;; (syntax-rules () -;;; ((_ w) (memq 'top (wrap-marks w))))) -;;; rather than -;;; (define top-wrap '((top))) -;;; (define top-marked? -;;; (lambda (w) (memq 'top (wrap-marks w)))) -;;; On ther other hand, we don't do this consistently; we define make-wrap, -;;; wrap-marks, and wrap-subst simply as -;;; (define make-wrap cons) -;;; (define wrap-marks car) -;;; (define wrap-subst cdr) -;;; In Chez Scheme, the syntactic and procedural forms of these -;;; abstractions are equivalent, since the optimizer consistently -;;; integrates constants and small procedures. Some Scheme -;;; implementations, however, may benefit from more consistent use -;;; of one form or the other. - - -;;; implementation information: - -;;; "begin" is treated as a splicing construct at top level and at -;;; the beginning of bodies. Any sequence of expressions that would -;;; be allowed where the "begin" occurs is allowed. - -;;; "let-syntax" and "letrec-syntax" are also treated as splicing -;;; constructs, in violation of the R4RS appendix and probably the R5RS -;;; when it comes out. A consequence, let-syntax and letrec-syntax do -;;; not create local contours, as do let and letrec. Although the -;;; functionality is greater as it is presently implemented, we will -;;; probably change it to conform to the R4RS/expected R5RS. - -;;; Objects with no standard print syntax, including objects containing -;;; cycles and syntax object, are allowed in quoted data as long as they -;;; are contained within a syntax form or produced by datum->syntax-object. -;;; Such objects are never copied. - -;;; All identifiers that don't have macro definitions and are not bound -;;; lexically are assumed to be global variables - -;;; Top-level definitions of macro-introduced identifiers are allowed. -;;; This may not be appropriate for implementations in which the -;;; model is that bindings are created by definitions, as opposed to -;;; one in which initial values are assigned by definitions. - -;;; Top-level variable definitions of syntax keywords is not permitted. -;;; Any solution allowing this would be kludgey and would yield -;;; surprising results in some cases. We can provide an undefine-syntax -;;; form. The questions is, should define be an implicit undefine-syntax? -;;; We've decided no for now. - -;;; Identifiers and syntax objects are implemented as vectors for -;;; portability. As a result, it is possible to "forge" syntax -;;; objects. - -;;; The implementation of generate-temporaries assumes that it is possible -;;; to generate globally unique symbols (gensyms). - -;;; The input to sc-expand may contain "annotations" describing, e.g., the -;;; source file and character position from where each object was read if -;;; it was read from a file. These annotations are handled properly by -;;; sc-expand only if the annotation? hook (see hooks below) is implemented -;;; properly and the operators make-annotation, annotation-expression, -;;; annotation-source, annotation-stripped, and set-annotation-stripped! -;;; are supplied. If annotations are supplied, the proper annotation -;;; source is passed to the various output constructors, allowing -;;; implementations to accurately correlate source and expanded code. -;;; Contact one of the authors for details if you wish to make use of -;;; this feature. - - - -;;; Bootstrapping: - -;;; When changing syntax-object representations, it is necessary to support -;;; both old and new syntax-object representations in id-var-name. It -;;; should be sufficient to recognize old representations and treat -;;; them as not lexically bound. - - - -(let () -(define-syntax define-structure - (lambda (x) - (define construct-name - (lambda (template-identifier . args) - (datum->syntax-object - template-identifier - (string->symbol - (apply string-append - (map (lambda (x) - (if (string? x) - x - (symbol->string (syntax-object->datum x)))) - args)))))) - (syntax-case x () - ((_ (name id1 ...)) - (andmap identifier? (syntax (name id1 ...))) - (with-syntax - ((constructor (construct-name (syntax name) "make-" (syntax name))) - (predicate (construct-name (syntax name) (syntax name) "?")) - ((access ...) - (map (lambda (x) (construct-name x (syntax name) "-" x)) - (syntax (id1 ...)))) - ((assign ...) - (map (lambda (x) - (construct-name x "set-" (syntax name) "-" x "!")) - (syntax (id1 ...)))) - (structure-length - (+ (length (syntax (id1 ...))) 1)) - ((index ...) - (let f ((i 1) (ids (syntax (id1 ...)))) - (if (null? ids) - '() - (cons i (f (+ i 1) (cdr ids))))))) - (syntax (begin - (define constructor - (lambda (id1 ...) - (vector 'name id1 ... ))) - (define predicate - (lambda (x) - (and (vector? x) - (= (vector-length x) structure-length) - (eq? (vector-ref x 0) 'name)))) - (define access - (lambda (x) - (vector-ref x index))) - ... - (define assign - (lambda (x update) - (vector-set! x index update))) - ...))))))) - -(let () -(define noexpand "noexpand") - -;;; hooks to nonportable run-time helpers -(begin -(define fx+ +) -(define fx- -) -(define fx= =) -(define fx< <) - -(define annotation? (lambda (x) #f)) - -(define top-level-eval-hook - (lambda (x) - (eval `(,noexpand ,x)))) - -(define local-eval-hook - (lambda (x) - (eval `(,noexpand ,x)))) - -(define error-hook - (lambda (who why what) - (error who "~a ~s" why what))) - -(define-syntax gensym-hook - (syntax-rules () - ((_) (gensym)))) - -(define put-global-definition-hook - (lambda (symbol binding) - (putprop symbol '*sc-expander* binding))) - -(define get-global-definition-hook - (lambda (symbol) - (getprop symbol '*sc-expander*))) -) - - -;;; output constructors -(begin -(define-syntax build-application - (syntax-rules () - ((_ source fun-exp arg-exps) - `(,fun-exp . ,arg-exps)))) - -(define-syntax build-conditional - (syntax-rules () - ((_ source test-exp then-exp else-exp) - `(if ,test-exp ,then-exp ,else-exp)))) - -(define-syntax build-lexical-reference - (syntax-rules () - ((_ type source var) - var))) - -(define-syntax build-lexical-assignment - (syntax-rules () - ((_ source var exp) - `(set! ,var ,exp)))) - -(define-syntax build-global-reference - (syntax-rules () - ((_ source var) - var))) - -(define-syntax build-global-assignment - (syntax-rules () - ((_ source var exp) - `(set! ,var ,exp)))) - -(define-syntax build-global-definition - (syntax-rules () - ((_ source var exp) - `(define ,var ,exp)))) - -(define-syntax build-lambda - (syntax-rules () - ((_ src vars exp) - `(lambda ,vars ,exp)))) - -(define-syntax build-primref - (syntax-rules () - ((_ src name) name) - ((_ src level name) name))) - -(define-syntax build-data - (syntax-rules () - ((_ src exp) `',exp))) - -(define build-sequence - (lambda (src exps) - (if (null? (cdr exps)) - (car exps) - `(begin ,@exps)))) - -(define build-let - (lambda (src vars val-exps body-exp) - (if (null? vars) - body-exp - `(let ,(map list vars val-exps) ,body-exp)))) - -(define build-named-let - (lambda (src vars val-exps body-exp) - (if (null? vars) - body-exp - `(let ,(car vars) ,(map list (cdr vars) val-exps) ,body-exp)))) - -(define build-letrec - (lambda (src vars val-exps body-exp) - (if (null? vars) - body-exp - `(letrec ,(map list vars val-exps) ,body-exp)))) - -(define-syntax build-lexical-var - (syntax-rules () - ((_ src id) (gensym id generated-symbols)))) - -(define-syntax self-evaluating? - (syntax-rules () - ((_ e) - (let ((x e)) - (or (boolean? x) (number? x) (string? x) (char? x) (null? x) (keyword? x)))))) -) - -(define-structure (syntax-object expression wrap)) - -(define-syntax unannotate - (syntax-rules () - ((_ x) - (let ((e x)) - (if (annotation? e) - (annotation-expression e) - e))))) - -(define-syntax no-source (identifier-syntax #f)) - -(define source-annotation - (lambda (x) - (cond - ((annotation? x) (annotation-source x)) - ((syntax-object? x) (source-annotation (syntax-object-expression x))) - (else no-source)))) - -(define-syntax arg-check - (syntax-rules () - ((_ pred? e who) - (let ((x e)) - (if (not (pred? x)) (error-hook who "invalid argument" x)))))) - -;;; compile-time environments - -;;; wrap and environment comprise two level mapping. -;;; wrap : id --> label -;;; env : label --> <element> - -;;; environments are represented in two parts: a lexical part and a global -;;; part. The lexical part is a simple list of associations from labels -;;; to bindings. The global part is implemented by -;;; {put,get}-global-definition-hook and associates symbols with -;;; bindings. - -;;; global (assumed global variable) and displaced-lexical (see below) -;;; do not show up in any environment; instead, they are fabricated by -;;; lookup when it finds no other bindings. - -;;; <environment> ::= ((<label> . <binding>)*) - -;;; identifier bindings include a type and a value - -;;; <binding> ::= (macro . <procedure>) macros -;;; (core . <procedure>) core forms -;;; (begin) begin -;;; (define) define -;;; (define-syntax) define-syntax -;;; (local-syntax . rec?) let-syntax/letrec-syntax -;;; (eval-when) eval-when -;;; (syntax . (<var> . <level>)) pattern variables -;;; (global) assumed global variable -;;; (lexical . <var>) lexical variables -;;; (displaced-lexical) displaced lexicals -;;; <level> ::= <nonnegative integer> -;;; <var> ::= variable returned by build-lexical-var - -;;; a macro is a user-defined syntactic-form. a core is a system-defined -;;; syntactic form. begin, define, define-syntax, and eval-when are -;;; treated specially since they are sensitive to whether the form is -;;; at top-level and (except for eval-when) can denote valid internal -;;; definitions. - -;;; a pattern variable is a variable introduced by syntax-case and can -;;; be referenced only within a syntax form. - -;;; any identifier for which no top-level syntax definition or local -;;; binding of any kind has been seen is assumed to be a global -;;; variable. - -;;; a lexical variable is a lambda- or letrec-bound variable. - -;;; a displaced-lexical identifier is a lexical identifier removed from -;;; it's scope by the return of a syntax object containing the identifier. -;;; a displaced lexical can also appear when a letrec-syntax-bound -;;; keyword is referenced on the rhs of one of the letrec-syntax clauses. -;;; a displaced lexical should never occur with properly written macros. - -(define-syntax make-binding - (syntax-rules (quote) - ((_ type value) (cons type value)) - ((_ 'type) '(type)) - ((_ type) (cons type '())))) -(define binding-type car) -(define binding-value cdr) - -(define-syntax null-env (identifier-syntax '())) - -(define extend-env - (lambda (labels bindings r) - (if (null? labels) - r - (extend-env (cdr labels) (cdr bindings) - (cons (cons (car labels) (car bindings)) r))))) - -(define extend-var-env - ; variant of extend-env that forms "lexical" binding - (lambda (labels vars r) - (if (null? labels) - r - (extend-var-env (cdr labels) (cdr vars) - (cons (cons (car labels) (make-binding 'lexical (car vars))) r))))) - -;;; we use a "macros only" environment in expansion of local macro -;;; definitions so that their definitions can use local macros without -;;; attempting to use other lexical identifiers. -(define macros-only-env - (lambda (r) - (if (null? r) - '() - (let ((a (car r))) - (if (eq? (cadr a) 'macro) - (cons a (macros-only-env (cdr r))) - (macros-only-env (cdr r))))))) - -(define lookup - ; x may be a label or a symbol - ; although symbols are usually global, we check the environment first - ; anyway because a temporary binding may have been established by - ; fluid-let-syntax - (lambda (x r) - (cond - ((assq x r) => cdr) - ((symbol? x) - (or (get-global-definition-hook x) (make-binding 'global))) - (else (make-binding 'displaced-lexical))))) - -(define global-extend - (lambda (type sym val) - (put-global-definition-hook sym (make-binding type val)))) - - -;;; Conceptually, identifiers are always syntax objects. Internally, -;;; however, the wrap is sometimes maintained separately (a source of -;;; efficiency and confusion), so that symbols are also considered -;;; identifiers by id?. Externally, they are always wrapped. - -(define nonsymbol-id? - (lambda (x) - (and (syntax-object? x) - (symbol? (unannotate (syntax-object-expression x)))))) - -(define id? - (lambda (x) - (cond - ((symbol? x) #t) - ((syntax-object? x) (symbol? (unannotate (syntax-object-expression x)))) - ((annotation? x) (symbol? (annotation-expression x))) - (else #f)))) - -(define-syntax id-sym-name - (syntax-rules () - ((_ e) - (let ((x e)) - (unannotate (if (syntax-object? x) (syntax-object-expression x) x)))))) - -(define id-sym-name&marks - (lambda (x w) - (if (syntax-object? x) - (values - (unannotate (syntax-object-expression x)) - (join-marks (wrap-marks w) (wrap-marks (syntax-object-wrap x)))) - (values (unannotate x) (wrap-marks w))))) - -;;; syntax object wraps - -;;; <wrap> ::= ((<mark> ...) . (<subst> ...)) -;;; <subst> ::= <shift> | <subs> -;;; <subs> ::= #(<old name> <label> (<mark> ...)) -;;; <shift> ::= positive fixnum - -(define make-wrap cons) -(define wrap-marks car) -(define wrap-subst cdr) - -(define-syntax subst-rename? (identifier-syntax vector?)) -(define-syntax rename-old (syntax-rules () ((_ x) (vector-ref x 0)))) -(define-syntax rename-new (syntax-rules () ((_ x) (vector-ref x 1)))) -(define-syntax rename-marks (syntax-rules () ((_ x) (vector-ref x 2)))) -(define-syntax make-rename - (syntax-rules () - ((_ old new marks) (vector old new marks)))) - -;;; labels must be comparable with "eq?" and distinct from symbols. -(define gen-label - (lambda () (string #\i))) - -(define gen-labels - (lambda (ls) - (if (null? ls) - '() - (cons (gen-label) (gen-labels (cdr ls)))))) - -(define-structure (ribcage symnames marks labels)) - -(define-syntax empty-wrap (identifier-syntax '(()))) - -(define-syntax top-wrap (identifier-syntax '((top)))) - -(define-syntax top-marked? - (syntax-rules () - ((_ w) (memq 'top (wrap-marks w))))) - -;;; Marks must be comparable with "eq?" and distinct from pairs and -;;; the symbol top. We do not use integers so that marks will remain -;;; unique even across file compiles. - -(define-syntax the-anti-mark (identifier-syntax #f)) - -(define anti-mark - (lambda (w) - (make-wrap (cons the-anti-mark (wrap-marks w)) - (cons 'shift (wrap-subst w))))) - -(define-syntax new-mark - (syntax-rules () - ((_) (string #\m)))) - -;;; make-empty-ribcage and extend-ribcage maintain list-based ribcages for -;;; internal definitions, in which the ribcages are built incrementally -(define-syntax make-empty-ribcage - (syntax-rules () - ((_) (make-ribcage '() '() '())))) - -(define extend-ribcage! - ; must receive ids with complete wraps - (lambda (ribcage id label) - (set-ribcage-symnames! ribcage - (cons (unannotate (syntax-object-expression id)) - (ribcage-symnames ribcage))) - (set-ribcage-marks! ribcage - (cons (wrap-marks (syntax-object-wrap id)) - (ribcage-marks ribcage))) - (set-ribcage-labels! ribcage - (cons label (ribcage-labels ribcage))))) - -;;; make-binding-wrap creates vector-based ribcages -(define make-binding-wrap - (lambda (ids labels w) - (if (null? ids) - w - (make-wrap - (wrap-marks w) - (cons - (let ((labelvec (list->vector labels))) - (let ((n (vector-length labelvec))) - (let ((symnamevec (make-vector n)) (marksvec (make-vector n))) - (let f ((ids ids) (i 0)) - (if (not (null? ids)) - (call-with-values - (lambda () (id-sym-name&marks (car ids) w)) - (lambda (symname marks) - (vector-set! symnamevec i symname) - (vector-set! marksvec i marks) - (f (cdr ids) (fx+ i 1)))))) - (make-ribcage symnamevec marksvec labelvec)))) - (wrap-subst w)))))) - -(define smart-append - (lambda (m1 m2) - (if (null? m2) - m1 - (append m1 m2)))) - -(define join-wraps - (lambda (w1 w2) - (let ((m1 (wrap-marks w1)) (s1 (wrap-subst w1))) - (if (null? m1) - (if (null? s1) - w2 - (make-wrap - (wrap-marks w2) - (smart-append s1 (wrap-subst w2)))) - (make-wrap - (smart-append m1 (wrap-marks w2)) - (smart-append s1 (wrap-subst w2))))))) - -(define join-marks - (lambda (m1 m2) - (smart-append m1 m2))) - -(define same-marks? - (lambda (x y) - (or (eq? x y) - (and (not (null? x)) - (not (null? y)) - (eq? (car x) (car y)) - (same-marks? (cdr x) (cdr y)))))) - -(define id-var-name - (lambda (id w) - (define-syntax first - (syntax-rules () - ((_ e) (call-with-values (lambda () e) (lambda (x . ignore) x))))) - (define search - (lambda (sym subst marks) - (if (null? subst) - (values #f marks) - (let ((fst (car subst))) - (if (eq? fst 'shift) - (search sym (cdr subst) (cdr marks)) - (let ((symnames (ribcage-symnames fst))) - (if (vector? symnames) - (search-vector-rib sym subst marks symnames fst) - (search-list-rib sym subst marks symnames fst)))))))) - (define search-list-rib - (lambda (sym subst marks symnames ribcage) - (let f ((symnames symnames) (i 0)) - (cond - ((null? symnames) (search sym (cdr subst) marks)) - ((and (eq? (car symnames) sym) - (same-marks? marks (list-ref (ribcage-marks ribcage) i))) - (values (list-ref (ribcage-labels ribcage) i) marks)) - (else (f (cdr symnames) (fx+ i 1))))))) - (define search-vector-rib - (lambda (sym subst marks symnames ribcage) - (let ((n (vector-length symnames))) - (let f ((i 0)) - (cond - ((fx= i n) (search sym (cdr subst) marks)) - ((and (eq? (vector-ref symnames i) sym) - (same-marks? marks (vector-ref (ribcage-marks ribcage) i))) - (values (vector-ref (ribcage-labels ribcage) i) marks)) - (else (f (fx+ i 1)))))))) - (cond - ((symbol? id) - (or (first (search id (wrap-subst w) (wrap-marks w))) id)) - ((syntax-object? id) - (let ((id (unannotate (syntax-object-expression id))) - (w1 (syntax-object-wrap id))) - (let ((marks (join-marks (wrap-marks w) (wrap-marks w1)))) - (call-with-values (lambda () (search id (wrap-subst w) marks)) - (lambda (new-id marks) - (or new-id - (first (search id (wrap-subst w1) marks)) - id)))))) - ((annotation? id) - (let ((id (unannotate id))) - (or (first (search id (wrap-subst w) (wrap-marks w))) id))) - (else (error-hook 'id-var-name "invalid id" id))))) - -;;; free-id=? must be passed fully wrapped ids since (free-id=? x y) -;;; may be true even if (free-id=? (wrap x w) (wrap y w)) is not. - -(define free-id=? - (lambda (i j) - (and (eq? (id-sym-name i) (id-sym-name j)) ; accelerator - (eq? (id-var-name i empty-wrap) (id-var-name j empty-wrap))))) - -;;; bound-id=? may be passed unwrapped (or partially wrapped) ids as -;;; long as the missing portion of the wrap is common to both of the ids -;;; since (bound-id=? x y) iff (bound-id=? (wrap x w) (wrap y w)) - -(define bound-id=? - (lambda (i j) - (if (and (syntax-object? i) (syntax-object? j)) - (and (eq? (unannotate (syntax-object-expression i)) - (unannotate (syntax-object-expression j))) - (same-marks? (wrap-marks (syntax-object-wrap i)) - (wrap-marks (syntax-object-wrap j)))) - (eq? (unannotate i) (unannotate j))))) - -;;; "valid-bound-ids?" returns #t if it receives a list of distinct ids. -;;; valid-bound-ids? may be passed unwrapped (or partially wrapped) ids -;;; as long as the missing portion of the wrap is common to all of the -;;; ids. - -(define valid-bound-ids? - (lambda (ids) - (and (let all-ids? ((ids ids)) - (or (null? ids) - (and (id? (car ids)) - (all-ids? (cdr ids))))) - (distinct-bound-ids? ids)))) - -;;; distinct-bound-ids? expects a list of ids and returns #t if there are -;;; no duplicates. It is quadratic on the length of the id list; long -;;; lists could be sorted to make it more efficient. distinct-bound-ids? -;;; may be passed unwrapped (or partially wrapped) ids as long as the -;;; missing portion of the wrap is common to all of the ids. - -(define distinct-bound-ids? - (lambda (ids) - (let distinct? ((ids ids)) - (or (null? ids) - (and (not (bound-id-member? (car ids) (cdr ids))) - (distinct? (cdr ids))))))) - -(define bound-id-member? - (lambda (x list) - (and (not (null? list)) - (or (bound-id=? x (car list)) - (bound-id-member? x (cdr list)))))) - -;;; wrapping expressions and identifiers - -(define wrap - (lambda (x w) - (cond - ((and (null? (wrap-marks w)) (null? (wrap-subst w))) x) - ((syntax-object? x) - (make-syntax-object - (syntax-object-expression x) - (join-wraps w (syntax-object-wrap x)))) - ((null? x) x) - (else (make-syntax-object x w))))) - -(define source-wrap - (lambda (x w s) - (wrap (if s (make-annotation x s #f) x) w))) - -;;; expanding - -(define chi-sequence - (lambda (body r w s) - (build-sequence s - (let dobody ((body body) (r r) (w w)) - (if (null? body) - '() - (let ((first (chi (car body) r w))) - (cons first (dobody (cdr body) r w)))))))) - -(define chi-top-sequence - (lambda (body r w s m esew) - (build-sequence s - (let dobody ((body body) (r r) (w w) (m m) (esew esew)) - (if (null? body) - '() - (let ((first (chi-top (car body) r w m esew))) - (cons first (dobody (cdr body) r w m esew)))))))) - -(define chi-install-global - (lambda (name e) - (build-application no-source - (build-primref no-source 'install-global-transformer) - (list (build-data no-source name) e)))) - -(define chi-when-list - (lambda (e when-list w) - ; when-list is syntax'd version of list of situations - (let f ((when-list when-list) (situations '())) - (if (null? when-list) - situations - (f (cdr when-list) - (cons (let ((x (car when-list))) - (cond - ((free-id=? x (syntax compile)) 'compile) - ((free-id=? x (syntax load)) 'load) - ((free-id=? x (syntax eval)) 'eval) - (else (syntax-error (wrap x w) - "invalid eval-when situation")))) - situations)))))) - -;;; syntax-type returns five values: type, value, e, w, and s. The first -;;; two are described in the table below. -;;; -;;; type value explanation -;;; ------------------------------------------------------------------- -;;; core procedure core form (including singleton) -;;; lexical name lexical variable reference -;;; global name global variable reference -;;; begin none begin keyword -;;; define none define keyword -;;; define-syntax none define-syntax keyword -;;; local-syntax rec? letrec-syntax/let-syntax keyword -;;; eval-when none eval-when keyword -;;; syntax level pattern variable -;;; displaced-lexical none displaced lexical identifier -;;; lexical-call name call to lexical variable -;;; global-call name call to global variable -;;; call none any other call -;;; begin-form none begin expression -;;; define-form id variable definition -;;; define-syntax-form id syntax definition -;;; local-syntax-form rec? syntax definition -;;; eval-when-form none eval-when form -;;; constant none self-evaluating datum -;;; other none anything else -;;; -;;; For define-form and define-syntax-form, e is the rhs expression. -;;; For all others, e is the entire form. w is the wrap for e. -;;; s is the source for the entire form. -;;; -;;; syntax-type expands macros and unwraps as necessary to get to -;;; one of the forms above. It also parses define and define-syntax -;;; forms, although perhaps this should be done by the consumer. - -(define syntax-type - (lambda (e r w s rib) - (cond - ((symbol? e) - (let* ((n (id-var-name e w)) - (b (lookup n r)) - (type (binding-type b))) - (case type - ((lexical) (values type (binding-value b) e w s)) - ((global) (values type n e w s)) - ((macro) - (syntax-type (chi-macro (binding-value b) e r w rib) r empty-wrap s rib)) - (else (values type (binding-value b) e w s))))) - ((pair? e) - (let ((first (car e))) - (if (id? first) - (let* ((n (id-var-name first w)) - (b (lookup n r)) - (type (binding-type b))) - (case type - ((lexical) (values 'lexical-call (binding-value b) e w s)) - ((global) (values 'global-call n e w s)) - ((macro) - (syntax-type (chi-macro (binding-value b) e r w rib) - r empty-wrap s rib)) - ((core) (values type (binding-value b) e w s)) - ((local-syntax) - (values 'local-syntax-form (binding-value b) e w s)) - ((begin) (values 'begin-form #f e w s)) - ((eval-when) (values 'eval-when-form #f e w s)) - ((define) - (syntax-case e () - ((_ name val) - (id? (syntax name)) - (values 'define-form (syntax name) (syntax val) w s)) - ((_ (name . args) e1 e2 ...) - (and (id? (syntax name)) - (valid-bound-ids? (lambda-var-list (syntax args)))) - ; need lambda here... - (values 'define-form (wrap (syntax name) w) - (cons (syntax lambda) (wrap (syntax (args e1 e2 ...)) w)) - empty-wrap s)) - ((_ name) - (id? (syntax name)) - (values 'define-form (wrap (syntax name) w) - (syntax (void)) - empty-wrap s)))) - ((define-syntax) - (syntax-case e () - ((_ name val) - (id? (syntax name)) - (values 'define-syntax-form (syntax name) - (syntax val) w s)))) - (else (values 'call #f e w s)))) - (values 'call #f e w s)))) - ((syntax-object? e) - ;; s can't be valid source if we've unwrapped - (syntax-type (syntax-object-expression e) - r - (join-wraps w (syntax-object-wrap e)) - no-source rib)) - ((annotation? e) - (syntax-type (annotation-expression e) r w (annotation-source e) rib)) - ((self-evaluating? e) (values 'constant #f e w s)) - (else (values 'other #f e w s))))) - -(define chi-top - (lambda (e r w m esew) - (define-syntax eval-if-c&e - (syntax-rules () - ((_ m e) - (let ((x e)) - (if (eq? m 'c&e) (top-level-eval-hook x)) - x)))) - (call-with-values - (lambda () (syntax-type e r w no-source #f)) - (lambda (type value e w s) - (case type - ((begin-form) - (syntax-case e () - ((_) (chi-void)) - ((_ e1 e2 ...) - (chi-top-sequence (syntax (e1 e2 ...)) r w s m esew)))) - ((local-syntax-form) - (chi-local-syntax value e r w s - (lambda (body r w s) - (chi-top-sequence body r w s m esew)))) - ((eval-when-form) - (syntax-case e () - ((_ (x ...) e1 e2 ...) - (let ((when-list (chi-when-list e (syntax (x ...)) w)) - (body (syntax (e1 e2 ...)))) - (cond - ((eq? m 'e) - (if (memq 'eval when-list) - (chi-top-sequence body r w s 'e '(eval)) - (chi-void))) - ((memq 'load when-list) - (if (or (memq 'compile when-list) - (and (eq? m 'c&e) (memq 'eval when-list))) - (chi-top-sequence body r w s 'c&e '(compile load)) - (if (memq m '(c c&e)) - (chi-top-sequence body r w s 'c '(load)) - (chi-void)))) - ((or (memq 'compile when-list) - (and (eq? m 'c&e) (memq 'eval when-list))) - (top-level-eval-hook - (chi-top-sequence body r w s 'e '(eval))) - (chi-void)) - (else (chi-void))))))) - ((define-syntax-form) - (let ((n (id-var-name value w)) (r (macros-only-env r))) - (case m - ((c) - (if (memq 'compile esew) - (let ((e (chi-install-global n (chi e r w)))) - (top-level-eval-hook e) - (if (memq 'load esew) e (chi-void))) - (if (memq 'load esew) - (chi-install-global n (chi e r w)) - (chi-void)))) - ((c&e) - (let ((e (chi-install-global n (chi e r w)))) - (top-level-eval-hook e) - e)) - (else - (if (memq 'eval esew) - (top-level-eval-hook - (chi-install-global n (chi e r w)))) - (chi-void))))) - ((define-form) - (let ((n (id-var-name value w))) - (case (binding-type (lookup n r)) - ((global) - (eval-if-c&e m - (build-global-definition s n (chi e r w)))) - ((displaced-lexical) - (syntax-error (wrap value w) "identifier out of context")) - (else (syntax-error (wrap value w) - "cannot define keyword at top level"))))) - (else (eval-if-c&e m (chi-expr type value e r w s)))))))) - -(define chi - (lambda (e r w) - (call-with-values - (lambda () (syntax-type e r w no-source #f)) - (lambda (type value e w s) - (chi-expr type value e r w s))))) - -(define chi-expr - (lambda (type value e r w s) - (case type - ((lexical) - (build-lexical-reference 'value s value)) - ((core) (value e r w s)) - ((lexical-call) - (chi-application - (build-lexical-reference 'fun (source-annotation (car e)) value) - e r w s)) - ((global-call) - (chi-application - (build-global-reference (source-annotation (car e)) value) - e r w s)) - ((constant) (build-data s (strip (source-wrap e w s) empty-wrap))) - ((global) (build-global-reference s value)) - ((call) (chi-application (chi (car e) r w) e r w s)) - ((begin-form) - (syntax-case e () - ((_ e1 e2 ...) (chi-sequence (syntax (e1 e2 ...)) r w s)))) - ((local-syntax-form) - (chi-local-syntax value e r w s chi-sequence)) - ((eval-when-form) - (syntax-case e () - ((_ (x ...) e1 e2 ...) - (let ((when-list (chi-when-list e (syntax (x ...)) w))) - (if (memq 'eval when-list) - (chi-sequence (syntax (e1 e2 ...)) r w s) - (chi-void)))))) - ((define-form define-syntax-form) - (syntax-error (wrap value w) "invalid context for definition of")) - ((syntax) - (syntax-error (source-wrap e w s) - "reference to pattern variable outside syntax form")) - ((displaced-lexical) - (syntax-error (source-wrap e w s) - "reference to identifier outside its scope")) - (else (syntax-error (source-wrap e w s)))))) - -(define chi-application - (lambda (x e r w s) - (syntax-case e () - ((e0 e1 ...) - (build-application s x - (map (lambda (e) (chi e r w)) (syntax (e1 ...)))))))) - -(define chi-macro - (lambda (p e r w rib) - (define rebuild-macro-output - (lambda (x m) - (cond ((pair? x) - (cons (rebuild-macro-output (car x) m) - (rebuild-macro-output (cdr x) m))) - ((syntax-object? x) - (let ((w (syntax-object-wrap x))) - (let ((ms (wrap-marks w)) (s (wrap-subst w))) - (make-syntax-object (syntax-object-expression x) - (if (and (pair? ms) (eq? (car ms) the-anti-mark)) - (make-wrap (cdr ms) - (if rib (cons rib (cdr s)) (cdr s))) - (make-wrap (cons m ms) - (if rib - (cons rib (cons 'shift s)) - (cons 'shift s)))))))) - ((vector? x) - (let* ((n (vector-length x)) (v (make-vector n))) - (do ((i 0 (fx+ i 1))) - ((fx= i n) v) - (vector-set! v i - (rebuild-macro-output (vector-ref x i) m))))) - ((symbol? x) - (syntax-error x "encountered raw symbol in macro output")) - (else x)))) - (rebuild-macro-output (p (wrap e (anti-mark w))) (new-mark)))) - -(define chi-body - ;; In processing the forms of the body, we create a new, empty wrap. - ;; This wrap is augmented (destructively) each time we discover that - ;; the next form is a definition. This is done: - ;; - ;; (1) to allow the first nondefinition form to be a call to - ;; one of the defined ids even if the id previously denoted a - ;; definition keyword or keyword for a macro expanding into a - ;; definition; - ;; (2) to prevent subsequent definition forms (but unfortunately - ;; not earlier ones) and the first nondefinition form from - ;; confusing one of the bound identifiers for an auxiliary - ;; keyword; and - ;; (3) so that we do not need to restart the expansion of the - ;; first nondefinition form, which is problematic anyway - ;; since it might be the first element of a begin that we - ;; have just spliced into the body (meaning if we restarted, - ;; we'd really need to restart with the begin or the macro - ;; call that expanded into the begin, and we'd have to give - ;; up allowing (begin <defn>+ <expr>+), which is itself - ;; problematic since we don't know if a begin contains only - ;; definitions until we've expanded it). - ;; - ;; Before processing the body, we also create a new environment - ;; containing a placeholder for the bindings we will add later and - ;; associate this environment with each form. In processing a - ;; let-syntax or letrec-syntax, the associated environment may be - ;; augmented with local keyword bindings, so the environment may - ;; be different for different forms in the body. Once we have - ;; gathered up all of the definitions, we evaluate the transformer - ;; expressions and splice into r at the placeholder the new variable - ;; and keyword bindings. This allows let-syntax or letrec-syntax - ;; forms local to a portion or all of the body to shadow the - ;; definition bindings. - ;; - ;; Subforms of a begin, let-syntax, or letrec-syntax are spliced - ;; into the body. - ;; - ;; outer-form is fully wrapped w/source - (lambda (body outer-form r w) - (let* ((r (cons '("placeholder" . (placeholder)) r)) - (ribcage (make-empty-ribcage)) - (w (make-wrap (wrap-marks w) (cons ribcage (wrap-subst w))))) - (let parse ((body (map (lambda (x) (cons r (wrap x w))) body)) - (ids '()) (labels '()) (vars '()) (vals '()) (bindings '())) - (if (null? body) - (syntax-error outer-form "no expressions in body") - (let ((e (cdar body)) (er (caar body))) - (call-with-values - (lambda () (syntax-type e er empty-wrap no-source ribcage)) - (lambda (type value e w s) - (case type - ((define-form) - (let ((id (wrap value w)) (label (gen-label))) - (let ((var (gen-var id))) - (extend-ribcage! ribcage id label) - (parse (cdr body) - (cons id ids) (cons label labels) - (cons var vars) (cons (cons er (wrap e w)) vals) - (cons (make-binding 'lexical var) bindings))))) - ((define-syntax-form) - (let ((id (wrap value w)) (label (gen-label))) - (extend-ribcage! ribcage id label) - (parse (cdr body) - (cons id ids) (cons label labels) - vars vals - (cons (make-binding 'macro (cons er (wrap e w))) - bindings)))) - ((begin-form) - (syntax-case e () - ((_ e1 ...) - (parse (let f ((forms (syntax (e1 ...)))) - (if (null? forms) - (cdr body) - (cons (cons er (wrap (car forms) w)) - (f (cdr forms))))) - ids labels vars vals bindings)))) - ((local-syntax-form) - (chi-local-syntax value e er w s - (lambda (forms er w s) - (parse (let f ((forms forms)) - (if (null? forms) - (cdr body) - (cons (cons er (wrap (car forms) w)) - (f (cdr forms))))) - ids labels vars vals bindings)))) - (else ; found a non-definition - (if (null? ids) - (build-sequence no-source - (map (lambda (x) - (chi (cdr x) (car x) empty-wrap)) - (cons (cons er (source-wrap e w s)) - (cdr body)))) - (begin - (if (not (valid-bound-ids? ids)) - (syntax-error outer-form - "invalid or duplicate identifier in definition")) - (let loop ((bs bindings) (er-cache #f) (r-cache #f)) - (if (not (null? bs)) - (let* ((b (car bs))) - (if (eq? (car b) 'macro) - (let* ((er (cadr b)) - (r-cache - (if (eq? er er-cache) - r-cache - (macros-only-env er)))) - (set-cdr! b - (eval-local-transformer - (chi (cddr b) r-cache empty-wrap))) - (loop (cdr bs) er r-cache)) - (loop (cdr bs) er-cache r-cache))))) - (set-cdr! r (extend-env labels bindings (cdr r))) - (build-letrec no-source - vars - (map (lambda (x) - (chi (cdr x) (car x) empty-wrap)) - vals) - (build-sequence no-source - (map (lambda (x) - (chi (cdr x) (car x) empty-wrap)) - (cons (cons er (source-wrap e w s)) - (cdr body))))))))))))))))) - -(define chi-lambda-clause - (lambda (e c r w k) - (syntax-case c () - (((id ...) e1 e2 ...) - (let ((ids (syntax (id ...)))) - (if (not (valid-bound-ids? ids)) - (syntax-error e "invalid parameter list in") - (let ((labels (gen-labels ids)) - (new-vars (map gen-var ids))) - (k new-vars - (chi-body (syntax (e1 e2 ...)) - e - (extend-var-env labels new-vars r) - (make-binding-wrap ids labels w))))))) - ((ids e1 e2 ...) - (let ((old-ids (lambda-var-list (syntax ids)))) - (if (not (valid-bound-ids? old-ids)) - (syntax-error e "invalid parameter list in") - (let ((labels (gen-labels old-ids)) - (new-vars (map gen-var old-ids))) - (k (let f ((ls1 (cdr new-vars)) (ls2 (car new-vars))) - (if (null? ls1) - ls2 - (f (cdr ls1) (cons (car ls1) ls2)))) - (chi-body (syntax (e1 e2 ...)) - e - (extend-var-env labels new-vars r) - (make-binding-wrap old-ids labels w))))))) - (_ (syntax-error e))))) - -(define chi-local-syntax - (lambda (rec? e r w s k) - (syntax-case e () - ((_ ((id val) ...) e1 e2 ...) - (let ((ids (syntax (id ...)))) - (if (not (valid-bound-ids? ids)) - (syntax-error e "duplicate bound keyword in") - (let ((labels (gen-labels ids))) - (let ((new-w (make-binding-wrap ids labels w))) - (k (syntax (e1 e2 ...)) - (extend-env - labels - (let ((w (if rec? new-w w)) - (trans-r (macros-only-env r))) - (map (lambda (x) - (make-binding 'macro - (eval-local-transformer (chi x trans-r w)))) - (syntax (val ...)))) - r) - new-w - s)))))) - (_ (syntax-error (source-wrap e w s)))))) - -(define eval-local-transformer - (lambda (expanded) - (let ((p (local-eval-hook expanded))) - (if (procedure? p) - p - (syntax-error p "nonprocedure transfomer"))))) - -(define chi-void - (lambda () - (build-application no-source (build-primref no-source 'void) '()))) - -(define ellipsis? - (lambda (x) - (and (nonsymbol-id? x) - (free-id=? x (syntax (... ...)))))) - -;;; data - -;;; strips all annotations from potentially circular reader output - -(define strip-annotation - (lambda (x parent) - (cond - ((pair? x) - (let ((new (cons #f #f))) - (when parent (set-annotation-stripped! parent new)) - (set-car! new (strip-annotation (car x) #f)) - (set-cdr! new (strip-annotation (cdr x) #f)) - new)) - ((annotation? x) - (or (annotation-stripped x) - (strip-annotation (annotation-expression x) x))) - ((vector? x) - (let ((new (make-vector (vector-length x)))) - (when parent (set-annotation-stripped! parent new)) - (let loop ((i (- (vector-length x) 1))) - (unless (fx< i 0) - (vector-set! new i (strip-annotation (vector-ref x i) #f)) - (loop (fx- i 1)))) - new)) - (else x)))) - -;;; strips syntax-objects down to top-wrap; if top-wrap is layered directly -;;; on an annotation, strips the annotation as well. -;;; since only the head of a list is annotated by the reader, not each pair -;;; in the spine, we also check for pairs whose cars are annotated in case -;;; we've been passed the cdr of an annotated list - -(define strip - (lambda (x w) - (if (top-marked? w) - (if (or (annotation? x) (and (pair? x) (annotation? (car x)))) - (strip-annotation x #f) - x) - (let f ((x x)) - (cond - ((syntax-object? x) - (strip (syntax-object-expression x) (syntax-object-wrap x))) - ((pair? x) - (let ((a (f (car x))) (d (f (cdr x)))) - (if (and (eq? a (car x)) (eq? d (cdr x))) - x - (cons a d)))) - ((vector? x) - (let ((old (vector->list x))) - (let ((new (map f old))) - (if (andmap eq? old new) x (list->vector new))))) - (else x)))))) - -;;; lexical variables - -(define gen-var - (lambda (id) - (let ((id (if (syntax-object? id) (syntax-object-expression id) id))) - (if (annotation? id) - (build-lexical-var (annotation-source id) (annotation-expression id)) - (build-lexical-var no-source id))))) - -(define lambda-var-list - (lambda (vars) - (let lvl ((vars vars) (ls '()) (w empty-wrap)) - (cond - ((pair? vars) (lvl (cdr vars) (cons (wrap (car vars) w) ls) w)) - ((id? vars) (cons (wrap vars w) ls)) - ((null? vars) ls) - ((syntax-object? vars) - (lvl (syntax-object-expression vars) - ls - (join-wraps w (syntax-object-wrap vars)))) - ((annotation? vars) - (lvl (annotation-expression vars) ls w)) - ; include anything else to be caught by subsequent error - ; checking - (else (cons vars ls)))))) - -;;; core transformers - -(global-extend 'local-syntax 'letrec-syntax #t) -(global-extend 'local-syntax 'let-syntax #f) - -(global-extend 'core 'fluid-let-syntax - (lambda (e r w s) - (syntax-case e () - ((_ ((var val) ...) e1 e2 ...) - (valid-bound-ids? (syntax (var ...))) - (let ((names (map (lambda (x) (id-var-name x w)) (syntax (var ...))))) - (for-each - (lambda (id n) - (case (binding-type (lookup n r)) - ((displaced-lexical) - (syntax-error (source-wrap id w s) - "identifier out of context")))) - (syntax (var ...)) - names) - (chi-body - (syntax (e1 e2 ...)) - (source-wrap e w s) - (extend-env - names - (let ((trans-r (macros-only-env r))) - (map (lambda (x) - (make-binding 'macro - (eval-local-transformer (chi x trans-r w)))) - (syntax (val ...)))) - r) - w))) - (_ (syntax-error (source-wrap e w s)))))) - -(global-extend 'core 'quote - (lambda (e r w s) - (syntax-case e () - ((_ e) (build-data s (strip (syntax e) w))) - (_ (syntax-error (source-wrap e w s)))))) - -(global-extend 'core 'syntax - (let () - (define gen-syntax - (lambda (src e r maps ellipsis?) - (if (id? e) - (let ((label (id-var-name e empty-wrap))) - (let ((b (lookup label r))) - (if (eq? (binding-type b) 'syntax) - (call-with-values - (lambda () - (let ((var.lev (binding-value b))) - (gen-ref src (car var.lev) (cdr var.lev) maps))) - (lambda (var maps) (values `(ref ,var) maps))) - (if (ellipsis? e) - (syntax-error src "misplaced ellipsis in syntax form") - (values `(quote ,e) maps))))) - (syntax-case e () - ((dots e) - (ellipsis? (syntax dots)) - (gen-syntax src (syntax e) r maps (lambda (x) #f))) - ((x dots . y) - ; this could be about a dozen lines of code, except that we - ; choose to handle (syntax (x ... ...)) forms - (ellipsis? (syntax dots)) - (let f ((y (syntax y)) - (k (lambda (maps) - (call-with-values - (lambda () - (gen-syntax src (syntax x) r - (cons '() maps) ellipsis?)) - (lambda (x maps) - (if (null? (car maps)) - (syntax-error src - "extra ellipsis in syntax form") - (values (gen-map x (car maps)) - (cdr maps)))))))) - (syntax-case y () - ((dots . y) - (ellipsis? (syntax dots)) - (f (syntax y) - (lambda (maps) - (call-with-values - (lambda () (k (cons '() maps))) - (lambda (x maps) - (if (null? (car maps)) - (syntax-error src - "extra ellipsis in syntax form") - (values (gen-mappend x (car maps)) - (cdr maps)))))))) - (_ (call-with-values - (lambda () (gen-syntax src y r maps ellipsis?)) - (lambda (y maps) - (call-with-values - (lambda () (k maps)) - (lambda (x maps) - (values (gen-append x y) maps))))))))) - ((x . y) - (call-with-values - (lambda () (gen-syntax src (syntax x) r maps ellipsis?)) - (lambda (x maps) - (call-with-values - (lambda () (gen-syntax src (syntax y) r maps ellipsis?)) - (lambda (y maps) (values (gen-cons x y) maps)))))) - (#(e1 e2 ...) - (call-with-values - (lambda () - (gen-syntax src (syntax (e1 e2 ...)) r maps ellipsis?)) - (lambda (e maps) (values (gen-vector e) maps)))) - (_ (values `(quote ,e) maps)))))) - - (define gen-ref - (lambda (src var level maps) - (if (fx= level 0) - (values var maps) - (if (null? maps) - (syntax-error src "missing ellipsis in syntax form") - (call-with-values - (lambda () (gen-ref src var (fx- level 1) (cdr maps))) - (lambda (outer-var outer-maps) - (let ((b (assq outer-var (car maps)))) - (if b - (values (cdr b) maps) - (let ((inner-var (gen-var 'tmp))) - (values inner-var - (cons (cons (cons outer-var inner-var) - (car maps)) - outer-maps))))))))))) - - (define gen-mappend - (lambda (e map-env) - `(apply (primitive append) ,(gen-map e map-env)))) - - (define gen-map - (lambda (e map-env) - (let ((formals (map cdr map-env)) - (actuals (map (lambda (x) `(ref ,(car x))) map-env))) - (cond - ((eq? (car e) 'ref) - ; identity map equivalence: - ; (map (lambda (x) x) y) == y - (car actuals)) - ((andmap - (lambda (x) (and (eq? (car x) 'ref) (memq (cadr x) formals))) - (cdr e)) - ; eta map equivalence: - ; (map (lambda (x ...) (f x ...)) y ...) == (map f y ...) - `(map (primitive ,(car e)) - ,@(map (let ((r (map cons formals actuals))) - (lambda (x) (cdr (assq (cadr x) r)))) - (cdr e)))) - (else `(map (lambda ,formals ,e) ,@actuals)))))) - - (define gen-cons - (lambda (x y) - (case (car y) - ((quote) - (if (eq? (car x) 'quote) - `(quote (,(cadr x) . ,(cadr y))) - (if (eq? (cadr y) '()) - `(list ,x) - `(cons ,x ,y)))) - ((list) `(list ,x ,@(cdr y))) - (else `(cons ,x ,y))))) - - (define gen-append - (lambda (x y) - (if (equal? y '(quote ())) - x - `(append ,x ,y)))) - - (define gen-vector - (lambda (x) - (cond - ((eq? (car x) 'list) `(vector ,@(cdr x))) - ((eq? (car x) 'quote) `(quote #(,@(cadr x)))) - (else `(list->vector ,x))))) - - - (define regen - (lambda (x) - (case (car x) - ((ref) (build-lexical-reference 'value no-source (cadr x))) - ((primitive) (build-primref no-source (cadr x))) - ((quote) (build-data no-source (cadr x))) - ((lambda) (build-lambda no-source (cadr x) (regen (caddr x)))) - ((map) (let ((ls (map regen (cdr x)))) - (build-application no-source - (if (fx= (length ls) 2) - (build-primref no-source 'map) - ; really need to do our own checking here - (build-primref no-source 2 'map)) ; require error check - ls))) - (else (build-application no-source - (build-primref no-source (car x)) - (map regen (cdr x))))))) - - (lambda (e r w s) - (let ((e (source-wrap e w s))) - (syntax-case e () - ((_ x) - (call-with-values - (lambda () (gen-syntax e (syntax x) r '() ellipsis?)) - (lambda (e maps) (regen e)))) - (_ (syntax-error e))))))) - - -(global-extend 'core 'lambda - (lambda (e r w s) - (syntax-case e () - ((_ . c) - (chi-lambda-clause (source-wrap e w s) (syntax c) r w - (lambda (vars body) (build-lambda s vars body))))))) - - -(global-extend 'core 'let - (let () - (define (chi-let e r w s constructor ids vals exps) - (if (not (valid-bound-ids? ids)) - (syntax-error e "duplicate bound variable in") - (let ((labels (gen-labels ids)) - (new-vars (map gen-var ids))) - (let ((nw (make-binding-wrap ids labels w)) - (nr (extend-var-env labels new-vars r))) - (constructor s - new-vars - (map (lambda (x) (chi x r w)) vals) - (chi-body exps (source-wrap e nw s) nr nw)))))) - (lambda (e r w s) - (syntax-case e () - ((_ ((id val) ...) e1 e2 ...) - (chi-let e r w s - build-let - (syntax (id ...)) - (syntax (val ...)) - (syntax (e1 e2 ...)))) - ((_ f ((id val) ...) e1 e2 ...) - (id? (syntax f)) - (chi-let e r w s - build-named-let - (syntax (f id ...)) - (syntax (val ...)) - (syntax (e1 e2 ...)))) - (_ (syntax-error (source-wrap e w s))))))) - - -(global-extend 'core 'letrec - (lambda (e r w s) - (syntax-case e () - ((_ ((id val) ...) e1 e2 ...) - (let ((ids (syntax (id ...)))) - (if (not (valid-bound-ids? ids)) - (syntax-error e "duplicate bound variable in") - (let ((labels (gen-labels ids)) - (new-vars (map gen-var ids))) - (let ((w (make-binding-wrap ids labels w)) - (r (extend-var-env labels new-vars r))) - (build-letrec s - new-vars - (map (lambda (x) (chi x r w)) (syntax (val ...))) - (chi-body (syntax (e1 e2 ...)) (source-wrap e w s) r w))))))) - (_ (syntax-error (source-wrap e w s)))))) - - -(global-extend 'core 'set! - (lambda (e r w s) - (syntax-case e () - ((_ id val) - (id? (syntax id)) - (let ((val (chi (syntax val) r w)) - (n (id-var-name (syntax id) w))) - (let ((b (lookup n r))) - (case (binding-type b) - ((lexical) - (build-lexical-assignment s (binding-value b) val)) - ((global) (build-global-assignment s n val)) - ((displaced-lexical) - (syntax-error (wrap (syntax id) w) - "identifier out of context")) - (else (syntax-error (source-wrap e w s))))))) - (_ (syntax-error (source-wrap e w s)))))) - -(global-extend 'begin 'begin '()) - -(global-extend 'define 'define '()) - -(global-extend 'define-syntax 'define-syntax '()) - -(global-extend 'eval-when 'eval-when '()) - -(global-extend 'core 'syntax-case - (let () - (define convert-pattern - ; accepts pattern & keys - ; returns syntax-dispatch pattern & ids - (lambda (pattern keys) - (let cvt ((p pattern) (n 0) (ids '())) - (if (id? p) - (if (bound-id-member? p keys) - (values (vector 'free-id p) ids) - (values 'any (cons (cons p n) ids))) - (syntax-case p () - ((x dots) - (ellipsis? (syntax dots)) - (call-with-values - (lambda () (cvt (syntax x) (fx+ n 1) ids)) - (lambda (p ids) - (values (if (eq? p 'any) 'each-any (vector 'each p)) - ids)))) - ((x . y) - (call-with-values - (lambda () (cvt (syntax y) n ids)) - (lambda (y ids) - (call-with-values - (lambda () (cvt (syntax x) n ids)) - (lambda (x ids) - (values (cons x y) ids)))))) - (() (values '() ids)) - (#(x ...) - (call-with-values - (lambda () (cvt (syntax (x ...)) n ids)) - (lambda (p ids) (values (vector 'vector p) ids)))) - (x (values (vector 'atom (strip p empty-wrap)) ids))))))) - - (define build-dispatch-call - (lambda (pvars exp y r) - (let ((ids (map car pvars)) (levels (map cdr pvars))) - (let ((labels (gen-labels ids)) (new-vars (map gen-var ids))) - (build-application no-source - (build-primref no-source 'apply) - (list (build-lambda no-source new-vars - (chi exp - (extend-env - labels - (map (lambda (var level) - (make-binding 'syntax `(,var . ,level))) - new-vars - (map cdr pvars)) - r) - (make-binding-wrap ids labels empty-wrap))) - y)))))) - - (define gen-clause - (lambda (x keys clauses r pat fender exp) - (call-with-values - (lambda () (convert-pattern pat keys)) - (lambda (p pvars) - (cond - ((not (distinct-bound-ids? (map car pvars))) - (syntax-error pat - "duplicate pattern variable in syntax-case pattern")) - ((not (andmap (lambda (x) (not (ellipsis? (car x)))) pvars)) - (syntax-error pat - "misplaced ellipsis in syntax-case pattern")) - (else - (let ((y (gen-var 'tmp))) - ; fat finger binding and references to temp variable y - (build-application no-source - (build-lambda no-source (list y) - (let ((y (build-lexical-reference 'value no-source y))) - (build-conditional no-source - (syntax-case fender () - (#t y) - (_ (build-conditional no-source - y - (build-dispatch-call pvars fender y r) - (build-data no-source #f)))) - (build-dispatch-call pvars exp y r) - (gen-syntax-case x keys clauses r)))) - (list (if (eq? p 'any) - (build-application no-source - (build-primref no-source 'list) - (list x)) - (build-application no-source - (build-primref no-source 'syntax-dispatch) - (list x (build-data no-source p))))))))))))) - - (define gen-syntax-case - (lambda (x keys clauses r) - (if (null? clauses) - (build-application no-source - (build-primref no-source 'syntax-error) - (list x)) - (syntax-case (car clauses) () - ((pat exp) - (if (and (id? (syntax pat)) - (andmap (lambda (x) (not (free-id=? (syntax pat) x))) - (cons (syntax (... ...)) keys))) - (let ((labels (list (gen-label))) - (var (gen-var (syntax pat)))) - (build-application no-source - (build-lambda no-source (list var) - (chi (syntax exp) - (extend-env labels - (list (make-binding 'syntax `(,var . 0))) - r) - (make-binding-wrap (syntax (pat)) - labels empty-wrap))) - (list x))) - (gen-clause x keys (cdr clauses) r - (syntax pat) #t (syntax exp)))) - ((pat fender exp) - (gen-clause x keys (cdr clauses) r - (syntax pat) (syntax fender) (syntax exp))) - (_ (syntax-error (car clauses) "invalid syntax-case clause")))))) - - (lambda (e r w s) - (let ((e (source-wrap e w s))) - (syntax-case e () - ((_ val (key ...) m ...) - (if (andmap (lambda (x) (and (id? x) (not (ellipsis? x)))) - (syntax (key ...))) - (let ((x (gen-var 'tmp))) - ; fat finger binding and references to temp variable x - (build-application s - (build-lambda no-source (list x) - (gen-syntax-case (build-lexical-reference 'value no-source x) - (syntax (key ...)) (syntax (m ...)) - r)) - (list (chi (syntax val) r empty-wrap)))) - (syntax-error e "invalid literals list in")))))))) - -;;; The portable sc-expand seeds chi-top's mode m with 'e (for -;;; evaluating) and esew (which stands for "eval syntax expanders -;;; when") with '(eval). In Chez Scheme, m is set to 'c instead of e -;;; if we are compiling a file, and esew is set to -;;; (eval-syntactic-expanders-when), which defaults to the list -;;; '(compile load eval). This means that, by default, top-level -;;; syntactic definitions are evaluated immediately after they are -;;; expanded, and the expanded definitions are also residualized into -;;; the object file if we are compiling a file. -(set! sc-expand - (let ((m 'e) (esew '(eval))) - (lambda (x) - (if (and (pair? x) (equal? (car x) noexpand)) - (cadr x) - (chi-top x null-env top-wrap m esew))))) - -(set! sc-expand3 - (let ((m 'e) (esew '(eval))) - (lambda (x . rest) - (if (and (pair? x) (equal? (car x) noexpand)) - (cadr x) - (chi-top x - null-env - top-wrap - (if (null? rest) m (car rest)) - (if (or (null? rest) (null? (cdr rest))) - esew - (cadr rest))))))) - -(set! identifier? - (lambda (x) - (nonsymbol-id? x))) - -(set! datum->syntax-object - (lambda (id datum) - (arg-check nonsymbol-id? id 'datum->syntax-object) - (make-syntax-object datum (syntax-object-wrap id)))) - -(set! syntax-object->datum - ; accepts any object, since syntax objects may consist partially - ; or entirely of unwrapped, nonsymbolic data - (lambda (x) - (strip x empty-wrap))) - -(set! generate-temporaries - (lambda (ls) - (arg-check list? ls 'generate-temporaries) - (map (lambda (x) (wrap (gensym-hook) top-wrap)) ls))) - -(set! free-identifier=? - (lambda (x y) - (arg-check nonsymbol-id? x 'free-identifier=?) - (arg-check nonsymbol-id? y 'free-identifier=?) - (free-id=? x y))) - -(set! bound-identifier=? - (lambda (x y) - (arg-check nonsymbol-id? x 'bound-identifier=?) - (arg-check nonsymbol-id? y 'bound-identifier=?) - (bound-id=? x y))) - -(set! syntax-error - (lambda (object . messages) - (for-each (lambda (x) (arg-check string? x 'syntax-error)) messages) - (let ((message (if (null? messages) - "invalid syntax" - (apply string-append messages)))) - (error-hook #f message (strip object empty-wrap))))) - -(set! install-global-transformer - (lambda (sym v) - (arg-check symbol? sym 'define-syntax) - (arg-check procedure? v 'define-syntax) - (global-extend 'macro sym v))) - -;;; syntax-dispatch expects an expression and a pattern. If the expression -;;; matches the pattern a list of the matching expressions for each -;;; "any" is returned. Otherwise, #f is returned. (This use of #f will -;;; not work on r4rs implementations that violate the ieee requirement -;;; that #f and () be distinct.) - -;;; The expression is matched with the pattern as follows: - -;;; pattern: matches: -;;; () empty list -;;; any anything -;;; (<pattern>1 . <pattern>2) (<pattern>1 . <pattern>2) -;;; each-any (any*) -;;; #(free-id <key>) <key> with free-identifier=? -;;; #(each <pattern>) (<pattern>*) -;;; #(vector <pattern>) (list->vector <pattern>) -;;; #(atom <object>) <object> with "equal?" - -;;; Vector cops out to pair under assumption that vectors are rare. If -;;; not, should convert to: -;;; #(vector <pattern>*) #(<pattern>*) - -(let () - -(define match-each - (lambda (e p w) - (cond - ((annotation? e) - (match-each (annotation-expression e) p w)) - ((pair? e) - (let ((first (match (car e) p w '()))) - (and first - (let ((rest (match-each (cdr e) p w))) - (and rest (cons first rest)))))) - ((null? e) '()) - ((syntax-object? e) - (match-each (syntax-object-expression e) - p - (join-wraps w (syntax-object-wrap e)))) - (else #f)))) - -(define match-each-any - (lambda (e w) - (cond - ((annotation? e) - (match-each-any (annotation-expression e) w)) - ((pair? e) - (let ((l (match-each-any (cdr e) w))) - (and l (cons (wrap (car e) w) l)))) - ((null? e) '()) - ((syntax-object? e) - (match-each-any (syntax-object-expression e) - (join-wraps w (syntax-object-wrap e)))) - (else #f)))) - -(define match-empty - (lambda (p r) - (cond - ((null? p) r) - ((eq? p 'any) (cons '() r)) - ((pair? p) (match-empty (car p) (match-empty (cdr p) r))) - ((eq? p 'each-any) (cons '() r)) - (else - (case (vector-ref p 0) - ((each) (match-empty (vector-ref p 1) r)) - ((free-id atom) r) - ((vector) (match-empty (vector-ref p 1) r))))))) - -(define match* - (lambda (e p w r) - (cond - ((null? p) (and (null? e) r)) - ((pair? p) - (and (pair? e) (match (car e) (car p) w - (match (cdr e) (cdr p) w r)))) - ((eq? p 'each-any) - (let ((l (match-each-any e w))) (and l (cons l r)))) - (else - (case (vector-ref p 0) - ((each) - (if (null? e) - (match-empty (vector-ref p 1) r) - (let ((l (match-each e (vector-ref p 1) w))) - (and l - (let collect ((l l)) - (if (null? (car l)) - r - (cons (map car l) (collect (map cdr l))))))))) - ((free-id) (and (id? e) (free-id=? (wrap e w) (vector-ref p 1)) r)) - ((atom) (and (equal? (vector-ref p 1) (strip e w)) r)) - ((vector) - (and (vector? e) - (match (vector->list e) (vector-ref p 1) w r)))))))) - -(define match - (lambda (e p w r) - (cond - ((not r) #f) - ((eq? p 'any) (cons (wrap e w) r)) - ((syntax-object? e) - (match* - (unannotate (syntax-object-expression e)) - p - (join-wraps w (syntax-object-wrap e)) - r)) - (else (match* (unannotate e) p w r))))) - -(set! syntax-dispatch - (lambda (e p) - (cond - ((eq? p 'any) (list e)) - ((syntax-object? e) - (match* (unannotate (syntax-object-expression e)) - p (syntax-object-wrap e) '())) - (else (match* (unannotate e) p empty-wrap '()))))) -)) -) - -(define-syntax with-syntax - (lambda (x) - (syntax-case x () - ((_ () e1 e2 ...) - (syntax (begin e1 e2 ...))) - ((_ ((out in)) e1 e2 ...) - (syntax (syntax-case in () (out (begin e1 e2 ...))))) - ((_ ((out in) ...) e1 e2 ...) - (syntax (syntax-case (list in ...) () - ((out ...) (begin e1 e2 ...)))))))) - -(define-syntax syntax-rules - (lambda (x) - (syntax-case x () - ((_ (k ...) ((keyword . pattern) template) ...) - (syntax (lambda (x) - (syntax-case x (k ...) - ((dummy . pattern) (syntax template)) - ...))))))) - -(define-syntax let* - (lambda (x) - (syntax-case x () - ((let* ((x v) ...) e1 e2 ...) - (andmap identifier? (syntax (x ...))) - (let f ((bindings (syntax ((x v) ...)))) - (if (null? bindings) - (syntax (let () e1 e2 ...)) - (with-syntax ((body (f (cdr bindings))) - (binding (car bindings))) - (syntax (let (binding) body))))))))) - -(define-syntax do - (lambda (orig-x) - (syntax-case orig-x () - ((_ ((var init . step) ...) (e0 e1 ...) c ...) - (with-syntax (((step ...) - (map (lambda (v s) - (syntax-case s () - (() v) - ((e) (syntax e)) - (_ (syntax-error orig-x)))) - (syntax (var ...)) - (syntax (step ...))))) - (syntax-case (syntax (e1 ...)) () - (() (syntax (let doloop ((var init) ...) - (if (not e0) - (begin c ... (doloop step ...)))))) - ((e1 e2 ...) - (syntax (let doloop ((var init) ...) - (if e0 - (begin e1 e2 ...) - (begin c ... (doloop step ...)))))))))))) - -(define-syntax quasiquote - (letrec - ((quasicons - (lambda (x y) - (with-syntax ((x x) (y y)) - (syntax-case (syntax y) (quote list) - ((quote dy) - (syntax-case (syntax x) (quote) - ((quote dx) (syntax (quote (dx . dy)))) - (_ (if (null? (syntax dy)) - (syntax (list x)) - (syntax (cons x y)))))) - ((list . stuff) (syntax (list x . stuff))) - (else (syntax (cons x y))))))) - (quasiappend - (lambda (x y) - (with-syntax ((x x) (y y)) - (syntax-case (syntax y) (quote) - ((quote ()) (syntax x)) - (_ (syntax (append x y))))))) - (quasivector - (lambda (x) - (with-syntax ((x x)) - (syntax-case (syntax x) (quote list) - ((quote (x ...)) (syntax (quote #(x ...)))) - ((list x ...) (syntax (vector x ...))) - (_ (syntax (list->vector x))))))) - (quasi - (lambda (p lev) - (syntax-case p (unquote unquote-splicing quasiquote) - ((unquote p) - (if (= lev 0) - (syntax p) - (quasicons (syntax (quote unquote)) - (quasi (syntax (p)) (- lev 1))))) - (((unquote-splicing p) . q) - (if (= lev 0) - (quasiappend (syntax p) (quasi (syntax q) lev)) - (quasicons (quasicons (syntax (quote unquote-splicing)) - (quasi (syntax (p)) (- lev 1))) - (quasi (syntax q) lev)))) - ((quasiquote p) - (quasicons (syntax (quote quasiquote)) - (quasi (syntax (p)) (+ lev 1)))) - ((p . q) - (quasicons (quasi (syntax p) lev) (quasi (syntax q) lev))) - (#(x ...) (quasivector (quasi (syntax (x ...)) lev))) - (p (syntax (quote p))))))) - (lambda (x) - (syntax-case x () - ((_ e) (quasi (syntax e) 0)))))) - -(define-syntax include - (lambda (x) - (define read-file - (lambda (fn k) - (let ((p (open-input-file fn))) - (let f ((x (read p))) - (if (eof-object? x) - (begin (close-input-port p) '()) - (cons (datum->syntax-object k x) - (f (read p)))))))) - (syntax-case x () - ((k filename) - (let ((fn (syntax-object->datum (syntax filename)))) - (with-syntax (((exp ...) (read-file fn (syntax k)))) - (syntax (begin exp ...)))))))) - -(define-syntax unquote - (lambda (x) - (syntax-case x () - ((_ e) - (error 'unquote - "expression ,~s not valid outside of quasiquote" - (syntax-object->datum (syntax e))))))) - -(define-syntax unquote-splicing - (lambda (x) - (syntax-case x () - ((_ e) - (error 'unquote-splicing - "expression ,@~s not valid outside of quasiquote" - (syntax-object->datum (syntax e))))))) - -(define-syntax case - (lambda (x) - (syntax-case x () - ((_ e m1 m2 ...) - (with-syntax - ((body (let f ((clause (syntax m1)) (clauses (syntax (m2 ...)))) - (if (null? clauses) - (syntax-case clause (else) - ((else e1 e2 ...) (syntax (begin e1 e2 ...))) - (((k ...) e1 e2 ...) - (syntax (if (memv t '(k ...)) (begin e1 e2 ...)))) - (_ (syntax-error x))) - (with-syntax ((rest (f (car clauses) (cdr clauses)))) - (syntax-case clause (else) - (((k ...) e1 e2 ...) - (syntax (if (memv t '(k ...)) - (begin e1 e2 ...) - rest))) - (_ (syntax-error x)))))))) - (syntax (let ((t e)) body))))))) - -(define-syntax identifier-syntax - (lambda (x) - (syntax-case x () - ((_ e) - (syntax - (lambda (x) - (syntax-case x () - (id - (identifier? (syntax id)) - (syntax e)) - ((_ x (... ...)) - (syntax (e x (... ...))))))))))) - diff --git a/ice-9/q.scm b/ice-9/q.scm deleted file mode 100644 index 08e754396..000000000 --- a/ice-9/q.scm +++ /dev/null @@ -1,148 +0,0 @@ -;;;; q.scm --- Queues -;;;; -;;;; Copyright (C) 1995 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., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA -;;;; - -(define-module (ice-9 q)) - -;;;; -;;; Q: Based on the interface to -;;; -;;; "queue.scm" Queues/Stacks for Scheme -;;; Written by Andrew Wilcox (awilcox@astro.psu.edu) on April 1, 1992. -;;; - -;;;; -;;; {Q} -;;; -;;; A list is just a bunch of cons pairs that follows some constrains, -;;; right? Association lists are the same. Hash tables are just -;;; vectors and association lists. You can print them, read them, -;;; write them as constants, pun them off as other data structures -;;; etc. This is good. This is lisp. These structures are fast and -;;; compact and easy to manipulate arbitrarily because of their -;;; simple, regular structure and non-disjointedness (associations -;;; being lists and so forth). -;;; -;;; So I figured, queues should be the same -- just a "subtype" of cons-pair -;;; structures in general. -;;; -;;; A queue is a cons pair: -;;; ( <the-q> . <last-pair> ) -;;; -;;; <the-q> is a list of things in the q. New elements go at the end -;;; of that list. -;;; -;;; <last-pair> is #f if the q is empty, and otherwise is the last -;;;pair of <the-q>. -;;; -;;; q's print nicely, but alas, they do not read well because the -;;; eq?-ness of <last-pair> and (last-pair <the-q>) is lost by read. -;;; -;;; All the functions that aren't explicitly defined to return -;;; something else (a queue element; a boolean value) return the queue -;;; object itself. -;;; -;;; The procedure -;;; -;;; (sync-q! q) -;;; -;;; recomputes and resets the <last-pair> component of a queue. -;;; -(define-public (sync-q! q) - (set-cdr! q (if (pair? (car q)) (last-pair (car q)) - #f)) - q) - -;;; make-q -;;; return a new q. -;;; -(define-public (make-q) (cons '() #f)) - -;;; q? obj -;;; Return true if obj is a Q. -;;; An object is a queue if it is equal? to '(() . #f) -;;; or it is a pair P with (list? (car P)) -;;; and (eq? (cdr P) (last-pair (car P))). -;;; -(define-public (q? obj) - (and (pair? obj) - (if (pair? (car obj)) - (eq? (cdr obj) (last-pair (car obj))) - (and (null? (car obj)) - (not (cdr obj)))))) - -;;; q-empty? obj -;;; -(define-public (q-empty? obj) (null? (car obj))) - -;;; q-empty-check q -;;; Throw a q-empty exception if Q is empty. -(define-public (q-empty-check q) (if (q-empty? q) (throw 'q-empty q))) - -;;; q-front q -;;; Return the first element of Q. -(define-public (q-front q) (q-empty-check q) (caar q)) - -;;; q-rear q -;;; Return the last element of Q. -(define-public (q-rear q) (q-empty-check q) (cadr q)) - -;;; q-remove! q obj -;;; Remove all occurences of obj from Q. -(define-public (q-remove! q obj) - (set-car! q (delq! obj (car q))) - (sync-q! q)) - -;;; q-push! q obj -;;; Add obj to the front of Q -(define-public (q-push! q obj) - (let ((h (cons obj (car q)))) - (set-car! q h) - (or (cdr q) (set-cdr! q h))) - q) - -;;; enq! q obj -;;; Add obj to the rear of Q -(define-public (enq! q obj) - (let ((h (cons obj '()))) - (if (null? (car q)) - (set-car! q h) - (set-cdr! (cdr q) h)) - (set-cdr! q h)) - q) - -;;; q-pop! q -;;; Take the front of Q and return it. -(define-public (q-pop! q) - (q-empty-check q) - (let ((it (caar q)) - (next (cdar q))) - (if (not next) - (set-cdr! q #f)) - (set-car! q next) - it)) - -;;; deq! q -;;; Take the front of Q and return it. -(define-public deq! q-pop!) - -;;; q-length q -;;; Return the number of enqueued elements. -;;; -(define-public (q-length q) (length (car q))) diff --git a/ice-9/r4rs.scm b/ice-9/r4rs.scm deleted file mode 100644 index 7da3ae5b6..000000000 --- a/ice-9/r4rs.scm +++ /dev/null @@ -1,145 +0,0 @@ -;;;; r4rs.scm --- definitions needed for libguile to be R4RS compliant -;;;; Jim Blandy <jimb@cyclic.com> --- October 1996 - -;;;; Copyright (C) 1996, 1997 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., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA - - -;;;; apply and call-with-current-continuation - -;;; We want these to be tail-recursive, so instead of using primitive -;;; procedures, we define them as closures in terms of the primitive -;;; macros @apply and @call-with-current-continuation. -(set! apply (lambda (fun . args) (@apply fun (apply:nconc2last args)))) -(set-procedure-property! apply 'name 'apply) -(define (call-with-current-continuation proc) - (@call-with-current-continuation proc)) - - -;;;; Basic Port Code - -;;; Specifically, the parts of the low-level port code that are written in -;;; Scheme rather than C. -;;; -;;; WARNING: the parts of this interface that refer to file ports -;;; are going away. It would be gone already except that it is used -;;; "internally" in a few places. - - -;;; OPEN_READ, OPEN_WRITE, and OPEN_BOTH are used to request the -;;; proper mode to open files in. -;;; -;;; If we want to support systems that do CRLF->LF translation, like -;;; Windows, then we should have a symbol in scmconfig.h made visible -;;; to the Scheme level that we can test here, and autoconf magic to -;;; #define it when appropriate. Windows will probably just have a -;;; hand-generated scmconfig.h file. -(define OPEN_READ "r") -(define OPEN_WRITE "w") -(define OPEN_BOTH "r+") - -(define *null-device* "/dev/null") - -(define (open-input-file str) - (open-file str OPEN_READ)) - -(define (open-output-file str) - (open-file str OPEN_WRITE)) - -(define (open-io-file str) (open-file str OPEN_BOTH)) -(define close-input-port close-port) -(define close-output-port close-port) -(define close-io-port close-port) - -(define (call-with-input-file str proc) - (let* ((file (open-input-file str)) - (ans (proc file))) - (close-input-port file) - ans)) - -(define (call-with-output-file str proc) - (let* ((file (open-output-file str)) - (ans (proc file))) - (close-output-port file) - ans)) - -(define (with-input-from-port port thunk) - (let* ((swaports (lambda () (set! port (set-current-input-port port))))) - (dynamic-wind swaports thunk swaports))) - -(define (with-output-to-port port thunk) - (let* ((swaports (lambda () (set! port (set-current-output-port port))))) - (dynamic-wind swaports thunk swaports))) - -(define (with-error-to-port port thunk) - (let* ((swaports (lambda () (set! port (set-current-error-port port))))) - (dynamic-wind swaports thunk swaports))) - -(define (with-input-from-file file thunk) - (let* ((nport (open-input-file file)) - (ans (with-input-from-port nport thunk))) - (close-port nport) - ans)) - -(define (with-output-to-file file thunk) - (let* ((nport (open-output-file file)) - (ans (with-output-to-port nport thunk))) - (close-port nport) - ans)) - -(define (with-error-to-file file thunk) - (let* ((nport (open-output-file file)) - (ans (with-error-to-port nport thunk))) - (close-port nport) - ans)) - -(define (with-input-from-string string thunk) - (call-with-input-string string - (lambda (p) (with-input-from-port p thunk)))) - -(define (with-output-to-string thunk) - (call-with-output-string - (lambda (p) (with-output-to-port p thunk)))) - -(define (with-error-to-string thunk) - (call-with-output-string - (lambda (p) (with-error-to-port p thunk)))) - -(define the-eof-object (call-with-input-string "" (lambda (p) (read-char p)))) - - -;;;; Loading - -(if (not (defined? '%load-verbosely)) - (define %load-verbosely #f)) -(define (assert-load-verbosity v) (set! %load-verbosely v)) - -(define (%load-announce file) - (if %load-verbosely - (with-output-to-port (current-error-port) - (lambda () - (display ";;; ") - (display "loading ") - (display file) - (newline) - (force-output))))) - -(set! %load-hook %load-announce) - -(define (load name) - (start-stack 'load-stack - (primitive-load name))) diff --git a/ice-9/readline.scm b/ice-9/readline.scm deleted file mode 100644 index 4426600dd..000000000 --- a/ice-9/readline.scm +++ /dev/null @@ -1,138 +0,0 @@ -;;;; readline.scm --- support functions for command-line editing -;;;; -;;;; Copyright (C) 1997 Free Software Foundation, Inc. -;;;; -;;;; This program is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. -;;;; -;;;; This program is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this software; see the file COPYING. If not, write to -;;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;;; -;;;; Contributed by Daniel Risacher <risacher@worldnet.att.net>. -;;;; Extensions based upon code by -;;;; Andrew Archibald <aarchiba@undergrad.math.uwaterloo.ca>. - -(define-module (ice-9 readline) - :use-module (ice-9 session) - :use-module (ice-9 regex)) - -;;; MDJ 980513 <djurfeldt@nada.kth.se>: -;;; There should probably be low-level support instead of this code. - -(define prompt "") -(define input-port (current-input-port)) -(define output-port (current-output-port)) -(define read-hook #f) - -(define (make-readline-port) - (let ((read-string "") - (string-index -1)) - (letrec ((get-character - (lambda () - (cond - ((eof-object? read-string) - read-string) - ((>= string-index (string-length read-string)) - (begin - (set! string-index -1) - #\nl)) - ((= string-index -1) - (begin - (set! read-string - (%readline (if (string? prompt) - prompt - (prompt)) - input-port - output-port - read-hook)) - (set! prompt "... ") - (set! string-index 0) - (if (not (eof-object? read-string)) - (begin - (or (string=? read-string "") - (add-history read-string)) - (get-character)) - read-string))) - (else - (let ((res (string-ref read-string string-index))) - (set! string-index (+ 1 string-index)) - res)))))) - (make-soft-port - (vector write-char display #f get-character #f) - "rw")))) - -;;; We only create one readline port. There's no point in having -;;; more, since they would all share the tty and history --- -;;; everything except the prompt. And don't forget the -;;; compile/load/run phase distinctions. Also, the readline library -;;; isn't reentrant. -(define the-readline-port #f) - -(define-public (readline-port) - (if (not the-readline-port) - (set! the-readline-port (make-readline-port))) - the-readline-port) - -;;; The user might try to use readline in his programs. It then -;;; becomes very uncomfortable that the current-input-port is the -;;; readline port... -;;; -;;; Here, we detect this situation and replace it with the -;;; underlying port. -;;; -;;; %readline is the orginal readline procedure. -(if (not (defined? '%readline)) - (begin - (define-public %readline readline) - (variable-set! (builtin-variable 'readline) - (lambda args - (let ((prompt prompt) - (inp input-port)) - (cond ((not (null? args)) - (set! prompt (car args)) - (set! args (cdr args)) - (cond ((not (null? args)) - (set! inp (car args)) - (set! args (cdr args)))))) - (apply %readline - prompt - (if (eq? inp the-readline-port) - input-port - inp) - args)))))) - -(define-public (set-readline-prompt! p) - (set! prompt p)) - -(define-public (set-readline-input-port! p) - (set! input-port p)) - -(define-public (set-readline-output-port! p) - (set! output-port p)) - -(define-public (set-readline-read-hook! h) - (set! read-hook h)) - -(define-public apropos-completion-function - (let ((completions '())) - (lambda (text cont?) - (if (not cont?) - (set! completions - (map symbol->string - (apropos-internal (string-append "^" - (regexp-quote text)))))) - (if (null? completions) - #f - (let ((retval (car completions))) - (begin (set! completions (cdr completions)) - retval)))))) - -(set! *readline-completion-function* apropos-completion-function) diff --git a/ice-9/regex.scm b/ice-9/regex.scm deleted file mode 100644 index d2f7b309d..000000000 --- a/ice-9/regex.scm +++ /dev/null @@ -1,143 +0,0 @@ -;;;; Copyright (C) 1997 Free Software Foundation, Inc. -;;;; -;;;; This program is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. -;;;; -;;;; This program is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this software; see the file COPYING. If not, write to -;;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;;; - -;;;; POSIX regex support functions. - -(define-module (ice-9 regex)) - -;;; FIXME: -;;; It is not clear what should happen if a `match' function -;;; is passed a `match number' which is out of bounds for the -;;; regexp match: return #f, or throw an error? These routines -;;; throw an out-of-range error. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; These procedures are not defined in SCSH, but I found them useful. - -(define-public (match:count match) - (- (vector-length match) 1)) - -(define-public (match:string match) - (vector-ref match 0)) - -(define-public (match:prefix match) - (make-shared-substring (match:string match) - 0 - (match:start match 0))) - -(define-public (match:suffix match) - (make-shared-substring (match:string match) - (match:end match 0))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; SCSH compatibility routines. - -(define-public (regexp-match? match) - (and (vector? match) - (string? (vector-ref match 0)) - (let loop ((i 1)) - (cond ((>= i (vector-length match)) #t) - ((and (pair? (vector-ref match i)) - (integer? (car (vector-ref match i))) - (integer? (cdr (vector-ref match i)))) - (loop (+ 1 i))) - (else #f))))) - -(define-public (regexp-quote regexp) - (call-with-output-string - (lambda (p) - (let loop ((i 0)) - (and (< i (string-length regexp)) - (begin - (case (string-ref regexp i) - ((#\* #\. #\( #\) #\+ #\? #\\ #\^ #\$ #\{ #\}) - (write-char #\\ p))) - (write-char (string-ref regexp i) p) - (loop (1+ i)))))))) - -(define-public (match:start match . args) - (let* ((matchnum (if (pair? args) - (+ 1 (car args)) - 1)) - (start (car (vector-ref match matchnum)))) - (if (= start -1) #f start))) - -(define-public (match:end match . args) - (let* ((matchnum (if (pair? args) - (+ 1 (car args)) - 1)) - (end (cdr (vector-ref match matchnum)))) - (if (= end -1) #f end))) - -(define-public (match:substring match . args) - (let* ((matchnum (if (pair? args) - (car args) - 0)) - (start (match:start match matchnum)) - (end (match:end match matchnum))) - (and start end (make-shared-substring (match:string match) - start - end)))) - -(define-public (string-match pattern str . args) - (let ((rx (make-regexp pattern)) - (start (if (pair? args) (car args) 0))) - (regexp-exec rx str start))) - -(define-public (regexp-substitute port match . items) - ;; If `port' is #f, send output to a string. - (if (not port) - (call-with-output-string - (lambda (p) - (apply regexp-substitute p match items))) - - ;; Otherwise, process each substitution argument in `items'. - (for-each (lambda (obj) - (cond ((string? obj) (display obj port)) - ((integer? obj) (display (match:substring match obj) port)) - ((eq? 'pre obj) (display (match:prefix match) port)) - ((eq? 'post obj) (display (match:suffix match) port)) - (else (error 'wrong-type-arg obj)))) - items))) - -(define-public (regexp-substitute/global port regexp string . items) - ;; If `port' is #f, send output to a string. - (if (not port) - (call-with-output-string - (lambda (p) - (apply regexp-substitute/global p regexp string items))) - - ;; Otherwise, compile the regexp and match it against the - ;; string, looping if 'post is encountered in `items'. - (let ((rx (make-regexp regexp))) - (let next-match ((str string)) - (let ((match (regexp-exec rx str))) - (if (not match) - (display str port) - - ;; Process all of the items for this match. - (for-each - (lambda (obj) - (cond - ((string? obj) (display obj port)) - ((integer? obj) (display (match:substring match obj) port)) - ((procedure? obj) (display (obj match) port)) - ((eq? 'pre obj) (display (match:prefix match) port)) - ((eq? 'post obj) (next-match (match:suffix match))) - (else (error 'wrong-type-arg obj)))) - items))))))) - diff --git a/ice-9/runq.scm b/ice-9/runq.scm deleted file mode 100644 index 9adb89776..000000000 --- a/ice-9/runq.scm +++ /dev/null @@ -1,240 +0,0 @@ -;;;; runq.scm --- the runq data structure -;;;; -;;;; Copyright (C) 1996 Free Software Foundation, Inc. -;;;; -;;;; This program is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. -;;;; -;;;; This program is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this software; see the file COPYING. If not, write to -;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA -;;;; - -(define-module (ice-9 runq) - :use-module (ice-9 q)) - -;;;; -;;; -;;; One way to schedule parallel computations in a serial environment is -;;; to explicitly divide each task up into small, finite execution time, -;;; strips. Then you interleave the execution of strips from various -;;; tasks to achieve a kind of parallelism. Runqs are a handy data -;;; structure for this style of programming. -;;; -;;; We use thunks (nullary procedures) and lists of thunks to represent -;;; strips. By convention, the return value of a strip-thunk must either -;;; be another strip or the value #f. -;;; -;;; A runq is a procedure that manages a queue of strips. Called with no -;;; arguments, it processes one strip from the queue. Called with -;;; arguments, the arguments form a control message for the queue. The -;;; first argument is a symbol which is the message selector. -;;; -;;; A strip is processed this way: If the strip is a thunk, the thunk is -;;; called -- if it returns a strip, that strip is added back to the -;;; queue. To process a strip which is a list of thunks, the CAR of that -;;; list is called. After a call to that CAR, there are 0, 1, or 2 strips -;;; -- perhaps one returned by the thunk, and perhaps the CDR of the -;;; original strip if that CDR is not nil. The runq puts whichever of -;;; these strips exist back on the queue. (The exact order in which -;;; strips are put back on the queue determines the scheduling behavior of -;;; a particular queue -- it's a parameter.) -;;; -;;; - - - -;;;; -;;; (runq-control q msg . args) -;;; -;;; processes in the default way the control messages that -;;; can be sent to a runq. Q should be an ordinary -;;; Q (see utils/q.scm). -;;; -;;; The standard runq messages are: -;;; -;;; 'add! strip0 strip1... ;; to enqueue one or more strips -;;; 'enqueue! strip0 strip1... ;; to enqueue one or more strips -;;; 'push! strip0 ... ;; add strips to the front of the queue -;;; 'empty? ;; true if it is -;;; 'length ;; how many strips in the queue? -;;; 'kill! ;; empty the queue -;;; else ;; throw 'not-understood -;;; -(define-public (runq-control q msg . args) - (case msg - ((add!) (for-each (lambda (t) (enq! q t)) args) '*unspecified*) - ((enqueue!) (for-each (lambda (t) (enq! q t)) args) '*unspecified*) - ((push!) (for-each (lambda (t) (q-push! q t)) args) '*unspecified*) - ((empty?) (q-empty? q)) - ((length) (q-length q)) - ((kill!) (set! q (make-q))) - (else (throw 'not-understood msg args)))) - -(define (run-strip thunk) (catch #t thunk (lambda ign (warn 'runq-strip thunk ign) #f))) - -;;;; -;;; make-void-runq -;;; -;;; Make a runq that discards all messages except "length", for which -;;; it returns 0. -;;; -(define-public (make-void-runq) - (lambda opts - (and opts - (apply-to-args opts - (lambda (msg . args) - (case msg - ((length) 0) - (else #f))))))) - -;;;; -;;; (make-fair-runq) -;;; -;;; Returns a runq procedure. -;;; Called with no arguments, the procedure processes one strip from the queue. -;;; Called with arguments, it uses runq-control. -;;; -;;; In a fair runq, if a strip returns a new strip X, X is added -;;; to the end of the queue, meaning it will be the last to execute -;;; of all the remaining procedures. -;;; -(define-public (make-fair-runq) - (letrec ((q (make-q)) - (self - (lambda ctl - (if ctl - (apply runq-control q ctl) - (and (not (q-empty? q)) - (let ((next-strip (deq! q))) - (cond - ((procedure? next-strip) (let ((k (run-strip next-strip))) - (and k (enq! q k)))) - ((pair? next-strip) (let ((k (run-strip (car next-strip)))) - (and k (enq! q k))) - (if (not (null? (cdr next-strip))) - (enq! q (cdr next-strip))))) - self)))))) - self)) - - -;;;; -;;; (make-exclusive-runq) -;;; -;;; Returns a runq procedure. -;;; Called with no arguments, the procedure processes one strip from the queue. -;;; Called with arguments, it uses runq-control. -;;; -;;; In an exclusive runq, if a strip W returns a new strip X, X is added -;;; to the front of the queue, meaning it will be the next to execute -;;; of all the remaining procedures. -;;; -;;; An exception to this occurs if W was the CAR of a list of strips. -;;; In that case, after the return value of W is pushed onto the front -;;; of the queue, the CDR of the list of strips is pushed in front -;;; of that (if the CDR is not nil). This way, the rest of the thunks -;;; in the list that contained W have priority over the return value of W. -;;; -(define-public (make-exclusive-runq) - (letrec ((q (make-q)) - (self - (lambda ctl - (if ctl - (apply runq-control q ctl) - (and (not (q-empty? q)) - (let ((next-strip (deq! q))) - (cond - ((procedure? next-strip) (let ((k (run-strip next-strip))) - (and k (q-push! q k)))) - ((pair? next-strip) (let ((k (run-strip (car next-strip)))) - (and k (q-push! q k))) - (if (not (null? (cdr next-strip))) - (q-push! q (cdr next-strip))))) - self)))))) - self)) - - -;;;; -;;; (make-subordinate-runq-to superior basic-inferior) -;;; -;;; Returns a runq proxy for the runq basic-inferior. -;;; -;;; The proxy watches for operations on the basic-inferior that cause -;;; a transition from a queue length of 0 to a non-zero length and -;;; vice versa. While the basic-inferior queue is not empty, -;;; the proxy installs a task on the superior runq. Each strip -;;; of that task processes N strips from the basic-inferior where -;;; N is the length of the basic-inferior queue when the proxy -;;; strip is entered. [Countless scheduling variations are possible.] -;;; -(define-public (make-subordinate-runq-to superior-runq basic-runq) - (let ((runq-task (cons #f #f))) - (set-car! runq-task - (lambda () - (if (basic-runq 'empty?) - (set-cdr! runq-task #f) - (do ((n (basic-runq 'length) (1- n))) - ((<= n 0) #f) - (basic-runq))))) - (letrec ((self - (lambda ctl - (if (not ctl) - (let ((answer (basic-runq))) - (self 'empty?) - answer) - (begin - (case (car ctl) - ((suspend) (set-cdr! runq-task #f)) - (else (let ((answer (apply basic-runq ctl))) - (if (and (not (cdr runq-task)) (not (basic-runq 'empty?))) - (begin - (set-cdr! runq-task runq-task) - (superior-runq 'add! runq-task))) - answer)))))))) - self))) - -;;;; -;;; (define fork-strips (lambda args args)) -;;; Return a strip that starts several strips in -;;; parallel. If this strip is enqueued on a fair -;;; runq, strips of the parallel subtasks will run -;;; round-robin style. -;;; -(define fork-strips (lambda args args)) - - -;;;; -;;; (strip-sequence . strips) -;;; -;;; Returns a new strip which is the concatenation of the argument strips. -;;; -(define-public ((strip-sequence . strips)) - (let loop ((st (let ((a strips)) (set! strips #f) a))) - (and (not (null? st)) - (let ((then ((car st)))) - (if then - (lambda () (loop (cons then (cdr st)))) - (lambda () (loop (cdr st)))))))) - - -;;;; -;;; (fair-strip-subtask . initial-strips) -;;; -;;; Returns a new strip which is the synchronos, fair, -;;; parallel execution of the argument strips. -;;; -;;; -;;; -(define-public (fair-strip-subtask . initial-strips) - (let ((st (make-fair-runq))) - (apply st 'add! initial-strips) - st)) - diff --git a/ice-9/session.scm b/ice-9/session.scm deleted file mode 100644 index c43402efc..000000000 --- a/ice-9/session.scm +++ /dev/null @@ -1,125 +0,0 @@ -;;;; Copyright (C) 1997 Free Software Foundation, Inc. -;;;; -;;;; This program is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. -;;;; -;;;; This program is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this software; see the file COPYING. If not, write to -;;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;;; - - -(define-module (ice-9 session)) - - - -;;; {Apropos} -;;; -;;; Author: Roland Orre <orre@nada.kth.se> -;;; - -(define (id x) x) - -(define-public (apropos rgx . options) - "Search for bindings: apropos regexp {options= 'full 'shadow 'value}" - (if (zero? (string-length rgx)) - "Empty string not allowed" - (let* ((match (make-regexp rgx)) - (modules (cons (current-module) - (module-uses (current-module)))) - (separator #\tab) - (shadow (member 'shadow options)) - (value (member 'value options))) - (cond ((member 'full options) - (set! shadow #t) - (set! value #t))) - (for-each - (lambda (module) - (let* ((builtin (or (eq? module the-scm-module) - (eq? module the-root-module))) - (name (module-name module)) - (obarrays (if builtin - (list (builtin-weak-bindings) - (builtin-bindings)) - (list (module-obarray module)))) - (get-refs (if builtin - (list id id) - (list variable-ref))) - ) - (for-each - (lambda (obarray get-ref) - (array-for-each - (lambda (oblist) - (for-each - (lambda (x) - (cond ((regexp-exec match (car x)) - (display name) - (display ": ") - (display (car x)) - (cond ((procedure? (get-ref (cdr x))) - (display separator) - (display (get-ref (cdr x)))) - (value - (display separator) - (display (get-ref (cdr x))))) - (if (and shadow - (not (eq? (module-ref module - (car x)) - (module-ref (current-module) - (car x))))) - (display " shadowed")) - (newline) - ))) - oblist)) - obarray)) - obarrays get-refs))) - modules)))) - -(define-public (apropos-internal rgx) - "Return a list of accessible variable names." - (let ((match (make-regexp rgx)) - (modules (cons (current-module) - (module-uses (current-module)))) - (recorded (make-vector 61 '())) - (vars (cons '() '()))) - (let ((last vars)) - (for-each - (lambda (module) - (for-each - (lambda (obarray) - (array-for-each - (lambda (oblist) - (for-each - (lambda (x) - (if (and (regexp-exec match (car x)) - (not (hashq-get-handle recorded (car x)))) - (begin - (set-cdr! last (cons (car x) '())) - (set! last (cdr last)) - (hashq-set! recorded (car x) #t)))) - oblist)) - obarray)) - (if (or (eq? module the-scm-module) - (eq? module the-root-module)) - (list (builtin-weak-bindings) - (builtin-bindings)) - (list (module-obarray module))))) - modules)) - (cdr vars))) - -(define-public (name obj) - (cond ((procedure? obj) (procedure-name obj)) - ((macro? obj) (macro-name obj)) - (else #f))) - -(define-public (source obj) - (cond ((procedure? obj) (procedure-source obj)) - ((macro? obj) (procedure-source (macro-transformer obj))) - (else #f))) diff --git a/ice-9/slib.scm b/ice-9/slib.scm deleted file mode 100644 index dcfbe7f52..000000000 --- a/ice-9/slib.scm +++ /dev/null @@ -1,213 +0,0 @@ -;;; installed-scm-file -(define-module (ice-9 slib)) - - - -(define (eval-load <filename> evl) - (if (not (file-exists? <filename>)) - (set! <filename> (string-append <filename> (scheme-file-suffix)))) - (call-with-input-file <filename> - (lambda (port) - (let ((old-load-pathname *load-pathname*)) - (set! *load-pathname* <filename>) - (do ((o (read port) (read port))) - ((eof-object? o)) - (evl o)) - (set! *load-pathname* old-load-pathname))))) - - - -(define slib:exit quit) -(define slib:error error) -(define slib:warn warn) -(define slib:eval (lambda (x) (eval-in-module x slib-module))) -(define defmacro:eval eval) -(define logical:logand logand) -(define logical:logior logior) -(define logical:logxor logxor) -(define logical:lognot lognot) -(define logical:ash ash) -(define logical:logcount logcount) -(define logical:integer-length integer-length) -(define logical:bit-extract bit-extract) -(define logical:integer-expt integer-expt) -(define logical:ipow-by-squaring ipow-by-squaring) -(define slib:eval-load eval-load) -(define slib:tab #\tab) -(define slib:form-feed #\page) - -(define slib-module (current-module)) - -(define (defined? symbol) - (module-defined? slib-module symbol)) - -(define slib:features - (append '(source - eval - abort - alist - defmacro - delay - dynamic-wind - full-continuation - hash - hash-table - line-i/o - logical - multiarg/and- - multiarg-apply - promise - rev2-procedures - rev4-optional-procedures - string-port - with-file) - - (if (defined? 'getenv) - '(getenv) - '()) - - (if (defined? 'current-time) - '(current-time) - '()) - - (if (defined? 'system) - '(system) - '()) - - (if (defined? 'array?) - '(array) - '()) - - (if (defined? 'char-ready?) - '(char-ready?) - '()) - - (if (defined? 'array-for-each) - '(array-for-each) - '()) - - (if (and (string->number "0.0") (inexact? (string->number "0.0"))) - '(inexact) - '()) - - (if (rational? (string->number "1/19")) - '(rational) - '()) - - (if (real? (string->number "0.0")) - '(real) - ()) - - (if (complex? (string->number "1+i")) - '(complex) - '()) - - (let ((n (string->number "9999999999999999999999999999999"))) - (if (and n (exact? n)) - '(bignum) - '())))) - - -;;; FIXME: Because uers want require to search the path, this uses -;;; load-from-path, which probably isn't a hot idea. slib -;;; doesn't expect this function to search a path, so I expect to get -;;; bug reports at some point complaining that the wrong file gets -;;; loaded when something accidentally appears in the path before -;;; slib, etc. ad nauseum. However, the right fix seems to involve -;;; changing catalog:get in slib/require.scm, and I don't expect -;;; Aubrey will integrate such a change. So I'm just going to punt -;;; for the time being. -(define-public (slib:load name) - (save-module-excursion - (lambda () - (set-current-module slib-module) - (let ((errinfo (catch 'system-error - (lambda () - (load-from-path name) - #f) - (lambda args args)))) - (if (and errinfo - (catch 'system-error - (lambda () - (load-from-path - (string-append name ".scm")) - #f) - (lambda args args))) - (apply throw errinfo)))))) - -(define slib:load-source slib:load) -(define defmacro:load slib:load) - -(define slib-parent-dir - (let* ((path (%search-load-path "slib/require.scm"))) - (if path - (make-shared-substring path 0 (- (string-length path) 17)) - (error "Could not find slib/require.scm in " %load-path)))) - -(define-public (implementation-vicinity) - (string-append slib-parent-dir "/")) -(define (library-vicinity) - (string-append (implementation-vicinity) "slib/")) -(define home-vicinity - (let ((home-path (getenv "HOME"))) - (lambda () home-path))) -(define (scheme-implementation-type) 'guile) -(define (scheme-implementation-version) "") - -(define (output-port-width . arg) 80) -(define (output-port-height . arg) 24) -(define (identity x) x) - -;;; {Time} -;;; - -(define difftime -) -(define offset-time +) - - -(define %system-define define) - -(define define - (procedure->memoizing-macro - (lambda (exp env) - (if (= (length env) 1) - `(define-public ,@(cdr exp)) - `(%system-define ,@(cdr exp)))))) - -;;; Hack to make syncase macros work in the slib module -(if (nested-ref the-root-module '(app modules ice-9 syncase)) - (set-object-property! (module-local-variable (current-module) 'define) - '*sc-expander* - '(define))) - -(define (software-type) 'UNIX) - -(slib:load (in-vicinity (library-vicinity) "require.scm")) - -(define-public require require:require) - -;; {Extensions to the require system so that the user can add new -;; require modules easily.} - -(define *vicinity-table* - (list - (cons 'implementation (implementation-vicinity)) - (cons 'library (library-vicinity)))) - -(define (install-require-vicinity name vicinity) - (let ((entry (assq name *vicinity-table*))) - (if entry - (set-cdr! entry vicinity) - (set! *vicinity-table* - (acons name vicinity *vicinity-table*))))) - -(define (install-require-module name vicinity-name file-name) - (if (not *catalog*) ;Fix which loads catalog in - (require:provided? 'random)) ;slib2b2 - (let ((entry (assq name *catalog*)) - (vicinity (cdr (assq vicinity-name *vicinity-table*)))) - (let ((path-name (in-vicinity vicinity file-name))) - (if entry - (set-cdr! entry path-name) - (set! *catalog* - (acons name path-name *catalog*)))))) diff --git a/ice-9/source.scm b/ice-9/source.scm deleted file mode 100644 index e69de29bb..000000000 --- a/ice-9/source.scm +++ /dev/null diff --git a/ice-9/string-fun.scm b/ice-9/string-fun.scm deleted file mode 100644 index 3acb5f048..000000000 --- a/ice-9/string-fun.scm +++ /dev/null @@ -1,272 +0,0 @@ -;;;; string-fun.scm --- string manipulation functions -;;;; -;;;; Copyright (C) 1995, 1996, 1997 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., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA -;;;; - -(define-module (ice-9 string-fun)) - -;;;; -;;; -;;; Various string funcitons, particularly those that take -;;; advantage of the "shared substring" capability. -;;; - -;;; {String Fun: Dividing Strings Into Fields} -;;; -;;; The names of these functions are very regular. -;;; Here is a grammar of a call to one of these: -;;; -;;; <string-function-invocation> -;;; := (<action>-<seperator-disposition>-<seperator-determination> <seperator-param> <str> <ret>) -;;; -;;; <str> = the string -;;; -;;; <ret> = The continuation. String functions generally return -;;; multiple values by passing them to this procedure. -;;; -;;; <action> = split -;;; | separate-fields -;;; -;;; "split" means to divide a string into two parts. -;;; <ret> will be called with two arguments. -;;; -;;; "separate-fields" means to divide a string into as many -;;; parts as possible. <ret> will be called with -;;; however many fields are found. -;;; -;;; <seperator-disposition> = before -;;; | after -;;; | discarding -;;; -;;; "before" means to leave the seperator attached to -;;; the beginning of the field to its right. -;;; "after" means to leave the seperator attached to -;;; the end of the field to its left. -;;; "discarding" means to discard seperators. -;;; -;;; Other dispositions might be handy. For example, "isolate" -;;; could mean to treat the separator as a field unto itself. -;;; -;;; <seperator-determination> = char -;;; | predicate -;;; -;;; "char" means to use a particular character as field seperator. -;;; "predicate" means to check each character using a particular predicate. -;;; -;;; Other determinations might be handy. For example, "character-set-member". -;;; -;;; <seperator-param> = A parameter that completes the meaning of the determinations. -;;; For example, if the determination is "char", then this parameter -;;; says which character. If it is "predicate", the parameter is the -;;; predicate. -;;; -;;; -;;; For example: -;;; -;;; (separate-fields-discarding-char #\, "foo, bar, baz, , bat" list) -;;; => ("foo" " bar" " baz" " " " bat") -;;; -;;; (split-after-char #\- 'an-example-of-split list) -;;; => ("an-" "example-of-split") -;;; -;;; As an alternative to using a determination "predicate", or to trying to do anything -;;; complicated with these functions, consider using regular expressions. -;;; - -(define-public (split-after-char char str ret) - (let ((end (cond - ((string-index str char) => 1+) - (else (string-length str))))) - (ret (make-shared-substring str 0 end) - (make-shared-substring str end)))) - -(define-public (split-before-char char str ret) - (let ((end (or (string-index str char) - (string-length str)))) - (ret (make-shared-substring str 0 end) - (make-shared-substring str end)))) - -(define-public (split-discarding-char char str ret) - (let ((end (string-index str char))) - (if (not end) - (ret str "") - (ret (make-shared-substring str 0 end) - (make-shared-substring str (1+ end)))))) - -(define-public (split-after-char-last char str ret) - (let ((end (cond - ((string-rindex str char) => 1+) - (else 0)))) - (ret (make-shared-substring str 0 end) - (make-shared-substring str end)))) - -(define-public (split-before-char-last char str ret) - (let ((end (or (string-rindex str char) 0))) - (ret (make-shared-substring str 0 end) - (make-shared-substring str end)))) - -(define-public (split-discarding-char-last char str ret) - (let ((end (string-rindex str char))) - (if (not end) - (ret str "") - (ret (make-shared-substring str 0 end) - (make-shared-substring str (1+ end)))))) - -(define (split-before-predicate pred str ret) - (let loop ((n 0)) - (cond - ((= n (string-length str)) (ret str "")) - ((not (pred (string-ref str n))) (loop (1+ n))) - (else (ret (make-shared-substring str 0 n) - (make-shared-substring str n)))))) -(define (split-after-predicate pred str ret) - (let loop ((n 0)) - (cond - ((= n (string-length str)) (ret str "")) - ((not (pred (string-ref str n))) (loop (1+ n))) - (else (ret (make-shared-substring str 0 (1+ n)) - (make-shared-substring str (1+ n))))))) - -(define (split-discarding-predicate pred str ret) - (let loop ((n 0)) - (cond - ((= n (string-length str)) (ret str "")) - ((not (pred (string-ref str n))) (loop (1+ n))) - (else (ret (make-shared-substring str 0 n) - (make-shared-substring str (1+ n))))))) - -(define-public (separate-fields-discarding-char ch str ret) - (let loop ((fields '()) - (str str)) - (cond - ((string-rindex str ch) - => (lambda (w) (loop (cons (make-shared-substring str (+ 1 w)) fields) - (make-shared-substring str 0 w)))) - (else (apply ret str fields))))) - -(define-public (separate-fields-after-char ch str ret) - (reverse - (let loop ((fields '()) - (str str)) - (cond - ((string-index str ch) - => (lambda (w) (loop (cons (make-shared-substring str 0 (+ 1 w)) fields) - (make-shared-substring str (+ 1 w))))) - (else (apply ret str fields)))))) - -(define-public (separate-fields-before-char ch str ret) - (let loop ((fields '()) - (str str)) - (cond - ((string-rindex str ch) - => (lambda (w) (loop (cons (make-shared-substring str w) fields) - (make-shared-substring str 0 w)))) - (else (apply ret str fields))))) - - -;;; {String Fun: String Prefix Predicates} -;;; -;;; Very simple: -;;; -;;; (define-public ((string-prefix-predicate pred?) prefix str) -;;; (and (<= (string-length prefix) (string-length str)) -;;; (pred? prefix (make-shared-substring str 0 (string-length prefix))))) -;;; -;;; (define-public string-prefix=? (string-prefix-predicate string=?)) -;;; - -(define-public ((string-prefix-predicate pred?) prefix str) - (and (<= (string-length prefix) (string-length str)) - (pred? prefix (make-shared-substring str 0 (string-length prefix))))) - -(define-public string-prefix=? (string-prefix-predicate string=?)) - - -;;; {String Fun: Strippers} -;;; -;;; <stripper> = sans-<removable-part> -;;; -;;; <removable-part> = surrounding-whitespace -;;; | trailing-whitespace -;;; | leading-whitespace -;;; | final-newline -;;; - -(define-public (sans-surrounding-whitespace s) - (let ((st 0) - (end (string-length s))) - (while (and (< st (string-length s)) - (char-whitespace? (string-ref s st))) - (set! st (1+ st))) - (while (and (< 0 end) - (char-whitespace? (string-ref s (1- end)))) - (set! end (1- end))) - (if (< end st) - "" - (make-shared-substring s st end)))) - -(define-public (sans-trailing-whitespace s) - (let ((st 0) - (end (string-length s))) - (while (and (< 0 end) - (char-whitespace? (string-ref s (1- end)))) - (set! end (1- end))) - (if (< end st) - "" - (make-shared-substring s st end)))) - -(define-public (sans-leading-whitespace s) - (let ((st 0) - (end (string-length s))) - (while (and (< st (string-length s)) - (char-whitespace? (string-ref s st))) - (set! st (1+ st))) - (if (< end st) - "" - (make-shared-substring s st end)))) - -(define-public (sans-final-newline str) - (cond - ((= 0 (string-length str)) - str) - - ((char=? #\nl (string-ref str (1- (string-length str)))) - (make-shared-substring str 0 (1- (string-length str)))) - - (else str))) - -;;; {String Fun: has-trailing-newline?} -;;; - -(define-public (has-trailing-newline? str) - (and (< 0 (string-length str)) - (char=? #\nl (string-ref str (1- (string-length str)))))) - - - -;;; {String Fun: with-regexp-parts} - -;;; This relies on the older, hairier regexp interface, which we don't -;;; particularly want to implement, and it's not used anywhere, so -;;; we're just going to drop it for now. -;;; (define-public (with-regexp-parts regexp fields str return fail) -;;; (let ((parts (regexec regexp str fields))) -;;; (if (number? parts) -;;; (fail parts) -;;; (apply return parts)))) - diff --git a/ice-9/syncase.scm b/ice-9/syncase.scm deleted file mode 100644 index 427f722f2..000000000 --- a/ice-9/syncase.scm +++ /dev/null @@ -1,190 +0,0 @@ -;;;; Copyright (C) 1997 Free Software Foundation, Inc. -;;;; -;;;; This program is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. -;;;; -;;;; This program is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this software; see the file COPYING. If not, write to -;;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;;; - - -(define-module (ice-9 syncase) - :use-module (ice-9 debug)) - - - -(define-public sc-macro - (procedure->memoizing-macro - (lambda (exp env) - (sc-expand exp)))) - -;;; Exported variables - -(define-public sc-expand #f) -(define-public sc-expand3 #f) -(define-public install-global-transformer #f) -(define-public syntax-dispatch #f) -(define-public syntax-error #f) - -(define-public bound-identifier=? #f) -(define-public datum->syntax-object #f) -(define-public define-syntax sc-macro) -(define-public eval-when sc-macro) -(define-public fluid-let-syntax sc-macro) -(define-public free-identifier=? #f) -(define-public generate-temporaries #f) -(define-public identifier? #f) -(define-public identifier-syntax sc-macro) -(define-public let-syntax sc-macro) -(define-public letrec-syntax sc-macro) -(define-public syntax sc-macro) -(define-public syntax-case sc-macro) -(define-public syntax-object->datum #f) -(define-public syntax-rules sc-macro) -(define-public with-syntax sc-macro) -(define-public include sc-macro) - -(define primitive-syntax '(quote lambda letrec if set! begin define or - and let let* cond do quasiquote unquote - unquote-splicing case)) - -(for-each (lambda (symbol) - (set-symbol-property! symbol 'primitive-syntax #t)) - primitive-syntax) - -;;; Hooks needed by the syntax-case macro package - -(define-public (void) *unspecified*) - -(define andmap - (lambda (f first . rest) - (or (null? first) - (if (null? rest) - (let andmap ((first first)) - (let ((x (car first)) (first (cdr first))) - (if (null? first) - (f x) - (and (f x) (andmap first))))) - (let andmap ((first first) (rest rest)) - (let ((x (car first)) - (xr (map car rest)) - (first (cdr first)) - (rest (map cdr rest))) - (if (null? first) - (apply f (cons x xr)) - (and (apply f (cons x xr)) (andmap first rest))))))))) - -(define (error who format-string why what) - (start-stack 'syncase-stack - (scm-error 'misc-error - who - "%s %S" - (list why what) - '()))) - -(define the-syncase-module (current-module)) - -(define (putprop symbol key binding) - (let* ((m (current-module)) - (v (or (module-variable m symbol) - (module-make-local-var! m symbol)))) - (if (assq 'primitive-syntax (symbol-pref symbol)) - (if (eq? (current-module) the-syncase-module) - (set-object-property! (module-variable the-root-module symbol) - key - binding)) - (variable-set! v sc-macro)) - (set-object-property! v key binding))) - -(define (getprop symbol key) - (let* ((m (current-module)) - (v (module-variable m symbol))) - (and v (or (object-property v key) - (let ((root-v (module-local-variable the-root-module symbol))) - (and (equal? root-v v) - (object-property root-v key))))))) - -(define generated-symbols (make-weak-key-hash-table 1019)) - -;;; Compatibility - -(define values:*values-rtd* - (make-record-type "values" - '(values))) - -(define values - (let ((make-values (record-constructor values:*values-rtd*))) - (lambda x - (if (and (not (null? x)) - (null? (cdr x))) - (car x) - (make-values x))))) - -(define call-with-values - (let ((access-values (record-accessor values:*values-rtd* 'values)) - (values-predicate? (record-predicate values:*values-rtd*))) - (lambda (producer consumer) - (let ((result (producer))) - (if (values-predicate? result) - (apply consumer (access-values result)) - (consumer result)))))) - -;;; Utilities - -(define (psyncomp) - (system "mv -f psyntax.pp psyntax.pp~") - (let ((in (open-input-file "psyntax.ss")) - (out (open-output-file "psyntax.pp"))) - (let loop ((x (read in))) - (if (eof-object? x) - (begin - (close-port out) - (close-port in)) - (begin - (write (sc-expand3 x 'c '(compile load eval)) out) - (newline out) - (loop (read in))))))) - -;;; Load the preprocessed code - -(let ((old-debug #f) - (old-read #f)) - (dynamic-wind (lambda () - (set! old-debug (debug-options)) - (set! old-read (read-options))) - (lambda () - (debug-disable 'debug 'procnames) - (read-disable 'positions) - (load-from-path "ice-9/psyntax.pp")) - (lambda () - (debug-options old-debug) - (read-options old-read)))) - - -;;; The following line is necessary only if we start making changes -;; (load-from-path "ice-9/psyntax.ss") - -(define internal-eval (nested-ref the-scm-module '(app modules guile eval))) - -(define-public (eval x) - (internal-eval (if (and (pair? x) - (string=? (car x) "noexpand")) - (cadr x) - (sc-expand x)))) - -;;; Hack to make syncase macros work in the slib module -(let ((m (nested-ref the-root-module '(app modules ice-9 slib)))) - (if m - (set-object-property! (module-local-variable m 'define) - '*sc-expander* - '(define)))) - -(define-public syncase sc-expand) diff --git a/ice-9/tags.scm b/ice-9/tags.scm deleted file mode 100644 index edd0dc49a..000000000 --- a/ice-9/tags.scm +++ /dev/null @@ -1,24 +0,0 @@ -;;; installed-scm-file - -;;;; Copyright (C) 1996 Free Software Foundation, Inc. -;;;; -;;;; This program is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. -;;;; -;;;; This program is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this software; see the file COPYING. If not, write to -;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA -;;;; - - - -(define-module (ice-9 tags)) - diff --git a/ice-9/test.scm b/ice-9/test.scm deleted file mode 100644 index 912b7de37..000000000 --- a/ice-9/test.scm +++ /dev/null @@ -1,1031 +0,0 @@ -;; Copyright (C) 1991, 1992, 1993, 1994, 1995 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., 59 Temple Place, Suite 330, -;; Boston, MA 02111-1307 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. - -;;;; "test.scm" Test correctness of scheme implementations. -;;; Author: Aubrey Jaffer -;;; Modified: Mikael Djurfeldt (Removed tests which Guile deliberately -;;; won't pass. Made the the tests (test-cont), (test-sc4), and -;;; (test-delay) start to run automatically. - -;;; This includes examples from -;;; William Clinger and Jonathan Rees, editors. -;;; Revised^4 Report on the Algorithmic Language Scheme -;;; and the IEEE specification. - -;;; The input tests read this file expecting it to be named -;;; "test.scm", so you'll have to run it from the ice-9 source -;;; directory, or copy this file elsewhere -;;; Files `tmp1', `tmp2' and `tmp3' will be created in the course of running -;;; these tests. You may need to delete them in order to run -;;; "test.scm" more than once. - -;;; There are three optional tests: -;;; (TEST-CONT) tests multiple returns from call-with-current-continuation -;;; -;;; (TEST-SC4) tests procedures required by R4RS but not by IEEE -;;; -;;; (TEST-DELAY) tests DELAY and FORCE, which are not required by -;;; either standard. - -;;; If you are testing a R3RS version which does not have `list?' do: -;;; (define list? #f) - -;;; send corrections or additions to jaffer@ai.mit.edu or -;;; Aubrey Jaffer, 84 Pleasant St., Wakefield MA 01880, USA - -(define cur-section '())(define errs '()) -(define SECTION (lambda args - (display "SECTION") (write args) (newline) - (set! cur-section args) #t)) -(define record-error (lambda (e) (set! errs (cons (list cur-section e) errs)))) - -(define test - (lambda (expect fun . args) - (write (cons fun args)) - (display " ==> ") - ((lambda (res) - (write res) - (newline) - (cond ((not (equal? expect res)) - (record-error (list res expect (cons fun args))) - (display " BUT EXPECTED ") - (write expect) - (newline) - #f) - (else #t))) - (if (procedure? fun) (apply fun args) (car args))))) -(define (report-errs) - (newline) - (if (null? errs) (display "Passed all tests") - (begin - (display "errors were:") - (newline) - (display "(SECTION (got expected (call)))") - (newline) - (for-each (lambda (l) (write l) (newline)) - errs))) - (newline)) - -(SECTION 2 1);; test that all symbol characters are supported. -'(+ - ... !.. $.+ %.- &.! *.: /:. :+. <-. =. >. ?. ~. _. ^.) - -(SECTION 3 4) -(define disjoint-type-functions - (list boolean? char? null? number? pair? procedure? string? symbol? vector?)) -(define type-examples - (list - #t #f #\a '() 9739 '(test) record-error "test" "" 'test '#() '#(a b c) )) -(define i 1) -(for-each (lambda (x) (display (make-string i #\ )) - (set! i (+ 3 i)) - (write x) - (newline)) - disjoint-type-functions) -(define type-matrix - (map (lambda (x) - (let ((t (map (lambda (f) (f x)) disjoint-type-functions))) - (write t) - (write x) - (newline) - t)) - type-examples)) -(SECTION 4 1 2) -(test '(quote a) 'quote (quote 'a)) -(test '(quote a) 'quote ''a) -(SECTION 4 1 3) -(test 12 (if #f + *) 3 4) -(SECTION 4 1 4) -(test 8 (lambda (x) (+ x x)) 4) -(define reverse-subtract - (lambda (x y) (- y x))) -(test 3 reverse-subtract 7 10) -(define add4 - (let ((x 4)) - (lambda (y) (+ x y)))) -(test 10 add4 6) -(test '(3 4 5 6) (lambda x x) 3 4 5 6) -(test '(5 6) (lambda (x y . z) z) 3 4 5 6) -(SECTION 4 1 5) -(test 'yes 'if (if (> 3 2) 'yes 'no)) -(test 'no 'if (if (> 2 3) 'yes 'no)) -(test '1 'if (if (> 3 2) (- 3 2) (+ 3 2))) -(SECTION 4 1 6) -(define x 2) -(test 3 'define (+ x 1)) -(set! x 4) -(test 5 'set! (+ x 1)) -(SECTION 4 2 1) -(test 'greater 'cond (cond ((> 3 2) 'greater) - ((< 3 2) 'less))) -(test 'equal 'cond (cond ((> 3 3) 'greater) - ((< 3 3) 'less) - (else 'equal))) -(test 2 'cond (cond ((assv 'b '((a 1) (b 2))) => cadr) - (else #f))) -(test 'composite 'case (case (* 2 3) - ((2 3 5 7) 'prime) - ((1 4 6 8 9) 'composite))) -(test 'consonant 'case (case (car '(c d)) - ((a e i o u) 'vowel) - ((w y) 'semivowel) - (else 'consonant))) -(test #t 'and (and (= 2 2) (> 2 1))) -(test #f 'and (and (= 2 2) (< 2 1))) -(test '(f g) 'and (and 1 2 'c '(f g))) -(test #t 'and (and)) -(test #t 'or (or (= 2 2) (> 2 1))) -(test #t 'or (or (= 2 2) (< 2 1))) -(test #f 'or (or #f #f #f)) -(test #f 'or (or)) -(test '(b c) 'or (or (memq 'b '(a b c)) (+ 3 0))) -(SECTION 4 2 2) -(test 6 'let (let ((x 2) (y 3)) (* x y))) -(test 35 'let (let ((x 2) (y 3)) (let ((x 7) (z (+ x y))) (* z x)))) -(test 70 'let* (let ((x 2) (y 3)) (let* ((x 7) (z (+ x y))) (* z x)))) -(test #t 'letrec (letrec ((even? - (lambda (n) (if (zero? n) #t (odd? (- n 1))))) - (odd? - (lambda (n) (if (zero? n) #f (even? (- n 1)))))) - (even? 88))) -(define x 34) -(test 5 'let (let ((x 3)) (define x 5) x)) -(test 34 'let x) -(test 6 'let (let () (define x 6) x)) -(test 34 'let x) -(test 7 'let* (let* ((x 3)) (define x 7) x)) -(test 34 'let* x) -(test 8 'let* (let* () (define x 8) x)) -(test 34 'let* x) -(test 9 'letrec (letrec () (define x 9) x)) -(test 34 'letrec x) -(test 10 'letrec (letrec ((x 3)) (define x 10) x)) -(test 34 'letrec x) -(SECTION 4 2 3) -(define x 0) -(test 6 'begin (begin (set! x 5) (+ x 1))) -(SECTION 4 2 4) -(test '#(0 1 2 3 4) 'do (do ((vec (make-vector 5)) - (i 0 (+ i 1))) - ((= i 5) vec) - (vector-set! vec i i))) -(test 25 'do (let ((x '(1 3 5 7 9))) - (do ((x x (cdr x)) - (sum 0 (+ sum (car x)))) - ((null? x) sum)))) -(test 1 'let (let foo () 1)) -(test '((6 1 3) (-5 -2)) 'let - (let loop ((numbers '(3 -2 1 6 -5)) - (nonneg '()) - (neg '())) - (cond ((null? numbers) (list nonneg neg)) - ((negative? (car numbers)) - (loop (cdr numbers) - nonneg - (cons (car numbers) neg))) - (else - (loop (cdr numbers) - (cons (car numbers) nonneg) - neg))))) -(SECTION 4 2 6) -(test '(list 3 4) 'quasiquote `(list ,(+ 1 2) 4)) -(test '(list a (quote a)) 'quasiquote (let ((name 'a)) `(list ,name ',name))) -(test '(a 3 4 5 6 b) 'quasiquote `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b)) -(test '((foo 7) . cons) - 'quasiquote - `((foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons)))) - -;;; sqt is defined here because not all implementations are required to -;;; support it. -(define (sqt x) - (do ((i 0 (+ i 1))) - ((> (* i i) x) (- i 1)))) - -(test '#(10 5 2 4 3 8) 'quasiquote `#(10 5 ,(sqt 4) ,@(map sqt '(16 9)) 8)) -(test 5 'quasiquote `,(+ 2 3)) -(test '(a `(b ,(+ 1 2) ,(foo 4 d) e) f) - 'quasiquote `(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f)) -(test '(a `(b ,x ,'y d) e) 'quasiquote - (let ((name1 'x) (name2 'y)) `(a `(b ,,name1 ,',name2 d) e))) -(test '(list 3 4) 'quasiquote (quasiquote (list (unquote (+ 1 2)) 4))) -(test '`(list ,(+ 1 2) 4) 'quasiquote '(quasiquote (list (unquote (+ 1 2)) 4))) -(SECTION 5 2 1) -(define add3 (lambda (x) (+ x 3))) -(test 6 'define (add3 3)) -(define first car) -(test 1 'define (first '(1 2))) -(SECTION 5 2 2) -(test 45 'define - (let ((x 5)) - (define foo (lambda (y) (bar x y))) - (define bar (lambda (a b) (+ (* a b) a))) - (foo (+ x 3)))) -(define x 34) -(define (foo) (define x 5) x) -(test 5 foo) -(test 34 'define x) -(define foo (lambda () (define x 5) x)) -(test 5 foo) -(test 34 'define x) -(define (foo x) ((lambda () (define x 5) x)) x) -(test 88 foo 88) -(test 4 foo 4) -(test 34 'define x) -(SECTION 6 1) -(test #f not #t) -(test #f not 3) -(test #f not (list 3)) -(test #t not #f) -(test #f not '()) -(test #f not (list)) -(test #f not 'nil) - -(test #t boolean? #f) -(test #f boolean? 0) -(test #f boolean? '()) -(SECTION 6 2) -(test #t eqv? 'a 'a) -(test #f eqv? 'a 'b) -(test #t eqv? 2 2) -(test #t eqv? '() '()) -(test #t eqv? '10000 '10000) -(test #f eqv? (cons 1 2)(cons 1 2)) -(test #f eqv? (lambda () 1) (lambda () 2)) -(test #f eqv? #f 'nil) -(let ((p (lambda (x) x))) - (test #t eqv? p p)) -(define gen-counter - (lambda () - (let ((n 0)) - (lambda () (set! n (+ n 1)) n)))) -(let ((g (gen-counter))) (test #t eqv? g g)) -(test #f eqv? (gen-counter) (gen-counter)) -(letrec ((f (lambda () (if (eqv? f g) 'f 'both))) - (g (lambda () (if (eqv? f g) 'g 'both)))) - (test #f eqv? f g)) - -(test #t eq? 'a 'a) -(test #f eq? (list 'a) (list 'a)) -(test #t eq? '() '()) -(test #t eq? car car) -(let ((x '(a))) (test #t eq? x x)) -(let ((x '#())) (test #t eq? x x)) -(let ((x (lambda (x) x))) (test #t eq? x x)) - -(test #t equal? 'a 'a) -(test #t equal? '(a) '(a)) -(test #t equal? '(a (b) c) '(a (b) c)) -(test #t equal? "abc" "abc") -(test #t equal? 2 2) -(test #t equal? (make-vector 5 'a) (make-vector 5 'a)) -(SECTION 6 3) -(test '(a b c d e) 'dot '(a . (b . (c . (d . (e . ())))))) -(define x (list 'a 'b 'c)) -(define y x) -(and list? (test #t list? y)) -(set-cdr! x 4) -(test '(a . 4) 'set-cdr! x) -(test #t eqv? x y) -(test '(a b c . d) 'dot '(a . (b . (c . d)))) -(and list? (test #f list? y)) -(and list? (let ((x (list 'a))) (set-cdr! x x) (test #f 'list? (list? x)))) - -(test #t pair? '(a . b)) -(test #t pair? '(a . 1)) -(test #t pair? '(a b c)) -(test #f pair? '()) -(test #f pair? '#(a b)) - -(test '(a) cons 'a '()) -(test '((a) b c d) cons '(a) '(b c d)) -(test '("a" b c) cons "a" '(b c)) -(test '(a . 3) cons 'a 3) -(test '((a b) . c) cons '(a b) 'c) - -(test 'a car '(a b c)) -(test '(a) car '((a) b c d)) -(test 1 car '(1 . 2)) - -(test '(b c d) cdr '((a) b c d)) -(test 2 cdr '(1 . 2)) - -(test '(a 7 c) list 'a (+ 3 4) 'c) -(test '() list) - -(test 3 length '(a b c)) -(test 3 length '(a (b) (c d e))) -(test 0 length '()) - -(test '(x y) append '(x) '(y)) -(test '(a b c d) append '(a) '(b c d)) -(test '(a (b) (c)) append '(a (b)) '((c))) -(test '() append) -(test '(a b c . d) append '(a b) '(c . d)) -(test 'a append '() 'a) - -(test '(c b a) reverse '(a b c)) -(test '((e (f)) d (b c) a) reverse '(a (b c) d (e (f)))) - -(test 'c list-ref '(a b c d) 2) - -(test '(a b c) memq 'a '(a b c)) -(test '(b c) memq 'b '(a b c)) -(test '#f memq 'a '(b c d)) -(test '#f memq (list 'a) '(b (a) c)) -(test '((a) c) member (list 'a) '(b (a) c)) -(test '(101 102) memv 101 '(100 101 102)) - -(define e '((a 1) (b 2) (c 3))) -(test '(a 1) assq 'a e) -(test '(b 2) assq 'b e) -(test #f assq 'd e) -(test #f assq (list 'a) '(((a)) ((b)) ((c)))) -(test '((a)) assoc (list 'a) '(((a)) ((b)) ((c)))) -(test '(5 7) assv 5 '((2 3) (5 7) (11 13))) -(SECTION 6 4) -(test #t symbol? 'foo) -(test #t symbol? (car '(a b))) -(test #f symbol? "bar") -(test #t symbol? 'nil) -(test #f symbol? '()) -(test #f symbol? #f) -;;; But first, what case are symbols in? Determine the standard case: -(define char-standard-case char-upcase) -(if (string=? (symbol->string 'A) "a") - (set! char-standard-case char-downcase)) -;;; Not for Guile -;(test #t 'standard-case -; (string=? (symbol->string 'a) (symbol->string 'A))) -;(test #t 'standard-case -; (or (string=? (symbol->string 'a) "A") -; (string=? (symbol->string 'A) "a"))) -(define (str-copy s) - (let ((v (make-string (string-length s)))) - (do ((i (- (string-length v) 1) (- i 1))) - ((< i 0) v) - (string-set! v i (string-ref s i))))) -(define (string-standard-case s) - (set! s (str-copy s)) - (do ((i 0 (+ 1 i)) - (sl (string-length s))) - ((>= i sl) s) - (string-set! s i (char-standard-case (string-ref s i))))) -;;; Not for Guile -;(test (string-standard-case "flying-fish") symbol->string 'flying-fish) -;(test (string-standard-case "martin") symbol->string 'Martin) -(test "Malvina" symbol->string (string->symbol "Malvina")) -;;; Not for Guile -;(test #t 'standard-case (eq? 'a 'A)) - -(define x (string #\a #\b)) -(define y (string->symbol x)) -(string-set! x 0 #\c) -(test "cb" 'string-set! x) -(test "ab" symbol->string y) -(test y string->symbol "ab") - -;;; Not for Guile -;(test #t eq? 'mISSISSIppi 'mississippi) -;(test #f 'string->symbol (eq? 'bitBlt (string->symbol "bitBlt"))) -(test 'JollyWog string->symbol (symbol->string 'JollyWog)) - -(SECTION 6 5 5) -(test #t number? 3) -(test #t complex? 3) -(test #t real? 3) -(test #t rational? 3) -(test #t integer? 3) - -(test #t exact? 3) -(test #f inexact? 3) - -(test #t = 22 22 22) -(test #t = 22 22) -(test #f = 34 34 35) -(test #f = 34 35) -(test #t > 3 -6246) -(test #f > 9 9 -2424) -(test #t >= 3 -4 -6246) -(test #t >= 9 9) -(test #f >= 8 9) -(test #t < -1 2 3 4 5 6 7 8) -(test #f < -1 2 3 4 4 5 6 7) -(test #t <= -1 2 3 4 5 6 7 8) -(test #t <= -1 2 3 4 4 5 6 7) -(test #f < 1 3 2) -(test #f >= 1 3 2) - -(test #t zero? 0) -(test #f zero? 1) -(test #f zero? -1) -(test #f zero? -100) -(test #t positive? 4) -(test #f positive? -4) -(test #f positive? 0) -(test #f negative? 4) -(test #t negative? -4) -(test #f negative? 0) -(test #t odd? 3) -(test #f odd? 2) -(test #f odd? -4) -(test #t odd? -1) -(test #f even? 3) -(test #t even? 2) -(test #t even? -4) -(test #f even? -1) - -(test 38 max 34 5 7 38 6) -(test -24 min 3 5 5 330 4 -24) - -(test 7 + 3 4) -(test '3 + 3) -(test 0 +) -(test 4 * 4) -(test 1 *) - -(test -1 - 3 4) -(test -3 - 3) -(test 7 abs -7) -(test 7 abs 7) -(test 0 abs 0) - -(test 5 quotient 35 7) -(test -5 quotient -35 7) -(test -5 quotient 35 -7) -(test 5 quotient -35 -7) -(test 1 modulo 13 4) -(test 1 remainder 13 4) -(test 3 modulo -13 4) -(test -1 remainder -13 4) -(test -3 modulo 13 -4) -(test 1 remainder 13 -4) -(test -1 modulo -13 -4) -(test -1 remainder -13 -4) -(define (divtest n1 n2) - (= n1 (+ (* n2 (quotient n1 n2)) - (remainder n1 n2)))) -(test #t divtest 238 9) -(test #t divtest -238 9) -(test #t divtest 238 -9) -(test #t divtest -238 -9) - -(test 4 gcd 0 4) -(test 4 gcd -4 0) -(test 4 gcd 32 -36) -(test 0 gcd) -(test 288 lcm 32 -36) -(test 1 lcm) - -;;;;From: fred@sce.carleton.ca (Fred J Kaudel) -;;; Modified by jaffer. -(define (test-inexact) - (define f3.9 (string->number "3.9")) - (define f4.0 (string->number "4.0")) - (define f-3.25 (string->number "-3.25")) - (define f.25 (string->number ".25")) - (define f4.5 (string->number "4.5")) - (define f3.5 (string->number "3.5")) - (define f0.0 (string->number "0.0")) - (define f0.8 (string->number "0.8")) - (define f1.0 (string->number "1.0")) - (define wto write-test-obj) - (define dto display-test-obj) - (define lto load-test-obj) - (newline) - (display ";testing inexact numbers; ") - (newline) - (SECTION 6 5 5) - (test #t inexact? f3.9) - (test #t 'inexact? (inexact? (max f3.9 4))) - (test f4.0 'max (max f3.9 4)) - (test f4.0 'exact->inexact (exact->inexact 4)) - (test (- f4.0) round (- f4.5)) - (test (- f4.0) round (- f3.5)) - (test (- f4.0) round (- f3.9)) - (test f0.0 round f0.0) - (test f0.0 round f.25) - (test f1.0 round f0.8) - (test f4.0 round f3.5) - (test f4.0 round f4.5) - (set! write-test-obj (list f.25 f-3.25));.25 inexact errors less likely. - (set! display-test-obj (list f.25 f-3.25));.3 often has such errors (~10^-13) - (set! load-test-obj (list 'define 'foo (list 'quote write-test-obj))) - (test #t call-with-output-file - "tmp3" - (lambda (test-file) - (write-char #\; test-file) - (display write-test-obj test-file) - (newline test-file) - (write load-test-obj test-file) - (output-port? test-file))) - (check-test-file "tmp3") - (set! write-test-obj wto) - (set! display-test-obj dto) - (set! load-test-obj lto) - (let ((x (string->number "4195835.0")) - (y (string->number "3145727.0"))) - (test #t 'pentium-fdiv-bug (> f1.0 (- x (* (/ x y) y))))) - (report-errs)) - -(define (test-bignum) - (define tb - (lambda (n1 n2) - (= n1 (+ (* n2 (quotient n1 n2)) - (remainder n1 n2))))) - (newline) - (display ";testing bignums; ") - (newline) - (SECTION 6 5 5) - (test 0 modulo -2177452800 86400) - (test 0 modulo 2177452800 -86400) - (test 0 modulo 2177452800 86400) - (test 0 modulo -2177452800 -86400) - (test #t 'remainder (tb 281474976710655 65535)) - (test #t 'remainder (tb 281474976710654 65535)) - (SECTION 6 5 6) - (test 281474976710655 string->number "281474976710655") - (test "281474976710655" number->string 281474976710655) - (report-errs)) - -(SECTION 6 5 6) -(test "0" number->string 0) -(test "100" number->string 100) -(test "100" number->string 256 16) -(test 100 string->number "100") -(test 256 string->number "100" 16) -(test #f string->number "") -(test #f string->number ".") -(test #f string->number "d") -(test #f string->number "D") -(test #f string->number "i") -(test #f string->number "I") -(test #f string->number "3i") -(test #f string->number "3I") -(test #f string->number "33i") -(test #f string->number "33I") -(test #f string->number "3.3i") -(test #f string->number "3.3I") -(test #f string->number "-") -(test #f string->number "+") - -(SECTION 6 6) -(test #t eqv? '#\ #\Space) -(test #t eqv? #\space '#\Space) -(test #t char? #\a) -(test #t char? #\() -(test #t char? #\ ) -(test #t char? '#\newline) - -(test #f char=? #\A #\B) -(test #f char=? #\a #\b) -(test #f char=? #\9 #\0) -(test #t char=? #\A #\A) - -(test #t char<? #\A #\B) -(test #t char<? #\a #\b) -(test #f char<? #\9 #\0) -(test #f char<? #\A #\A) - -(test #f char>? #\A #\B) -(test #f char>? #\a #\b) -(test #t char>? #\9 #\0) -(test #f char>? #\A #\A) - -(test #t char<=? #\A #\B) -(test #t char<=? #\a #\b) -(test #f char<=? #\9 #\0) -(test #t char<=? #\A #\A) - -(test #f char>=? #\A #\B) -(test #f char>=? #\a #\b) -(test #t char>=? #\9 #\0) -(test #t char>=? #\A #\A) - -(test #f char-ci=? #\A #\B) -(test #f char-ci=? #\a #\B) -(test #f char-ci=? #\A #\b) -(test #f char-ci=? #\a #\b) -(test #f char-ci=? #\9 #\0) -(test #t char-ci=? #\A #\A) -(test #t char-ci=? #\A #\a) - -(test #t char-ci<? #\A #\B) -(test #t char-ci<? #\a #\B) -(test #t char-ci<? #\A #\b) -(test #t char-ci<? #\a #\b) -(test #f char-ci<? #\9 #\0) -(test #f char-ci<? #\A #\A) -(test #f char-ci<? #\A #\a) - -(test #f char-ci>? #\A #\B) -(test #f char-ci>? #\a #\B) -(test #f char-ci>? #\A #\b) -(test #f char-ci>? #\a #\b) -(test #t char-ci>? #\9 #\0) -(test #f char-ci>? #\A #\A) -(test #f char-ci>? #\A #\a) - -(test #t char-ci<=? #\A #\B) -(test #t char-ci<=? #\a #\B) -(test #t char-ci<=? #\A #\b) -(test #t char-ci<=? #\a #\b) -(test #f char-ci<=? #\9 #\0) -(test #t char-ci<=? #\A #\A) -(test #t char-ci<=? #\A #\a) - -(test #f char-ci>=? #\A #\B) -(test #f char-ci>=? #\a #\B) -(test #f char-ci>=? #\A #\b) -(test #f char-ci>=? #\a #\b) -(test #t char-ci>=? #\9 #\0) -(test #t char-ci>=? #\A #\A) -(test #t char-ci>=? #\A #\a) - -(test #t char-alphabetic? #\a) -(test #t char-alphabetic? #\A) -(test #t char-alphabetic? #\z) -(test #t char-alphabetic? #\Z) -(test #f char-alphabetic? #\0) -(test #f char-alphabetic? #\9) -(test #f char-alphabetic? #\space) -(test #f char-alphabetic? #\;) - -(test #f char-numeric? #\a) -(test #f char-numeric? #\A) -(test #f char-numeric? #\z) -(test #f char-numeric? #\Z) -(test #t char-numeric? #\0) -(test #t char-numeric? #\9) -(test #f char-numeric? #\space) -(test #f char-numeric? #\;) - -(test #f char-whitespace? #\a) -(test #f char-whitespace? #\A) -(test #f char-whitespace? #\z) -(test #f char-whitespace? #\Z) -(test #f char-whitespace? #\0) -(test #f char-whitespace? #\9) -(test #t char-whitespace? #\space) -(test #f char-whitespace? #\;) - -(test #f char-upper-case? #\0) -(test #f char-upper-case? #\9) -(test #f char-upper-case? #\space) -(test #f char-upper-case? #\;) - -(test #f char-lower-case? #\0) -(test #f char-lower-case? #\9) -(test #f char-lower-case? #\space) -(test #f char-lower-case? #\;) - -(test #\. integer->char (char->integer #\.)) -(test #\A integer->char (char->integer #\A)) -(test #\a integer->char (char->integer #\a)) -(test #\A char-upcase #\A) -(test #\A char-upcase #\a) -(test #\a char-downcase #\A) -(test #\a char-downcase #\a) -(SECTION 6 7) -(test #t string? "The word \"recursion\\\" has many meanings.") -(test #t string? "") -(define f (make-string 3 #\*)) -(test "?**" 'string-set! (begin (string-set! f 0 #\?) f)) -(test "abc" string #\a #\b #\c) -(test "" string) -(test 3 string-length "abc") -(test #\a string-ref "abc" 0) -(test #\c string-ref "abc" 2) -(test 0 string-length "") -(test "" substring "ab" 0 0) -(test "" substring "ab" 1 1) -(test "" substring "ab" 2 2) -(test "a" substring "ab" 0 1) -(test "b" substring "ab" 1 2) -(test "ab" substring "ab" 0 2) -(test "foobar" string-append "foo" "bar") -(test "foo" string-append "foo") -(test "foo" string-append "foo" "") -(test "foo" string-append "" "foo") -(test "" string-append) -(test "" make-string 0) -(test #t string=? "" "") -(test #f string<? "" "") -(test #f string>? "" "") -(test #t string<=? "" "") -(test #t string>=? "" "") -(test #t string-ci=? "" "") -(test #f string-ci<? "" "") -(test #f string-ci>? "" "") -(test #t string-ci<=? "" "") -(test #t string-ci>=? "" "") - -(test #f string=? "A" "B") -(test #f string=? "a" "b") -(test #f string=? "9" "0") -(test #t string=? "A" "A") - -(test #t string<? "A" "B") -(test #t string<? "a" "b") -(test #f string<? "9" "0") -(test #f string<? "A" "A") - -(test #f string>? "A" "B") -(test #f string>? "a" "b") -(test #t string>? "9" "0") -(test #f string>? "A" "A") - -(test #t string<=? "A" "B") -(test #t string<=? "a" "b") -(test #f string<=? "9" "0") -(test #t string<=? "A" "A") - -(test #f string>=? "A" "B") -(test #f string>=? "a" "b") -(test #t string>=? "9" "0") -(test #t string>=? "A" "A") - -(test #f string-ci=? "A" "B") -(test #f string-ci=? "a" "B") -(test #f string-ci=? "A" "b") -(test #f string-ci=? "a" "b") -(test #f string-ci=? "9" "0") -(test #t string-ci=? "A" "A") -(test #t string-ci=? "A" "a") - -(test #t string-ci<? "A" "B") -(test #t string-ci<? "a" "B") -(test #t string-ci<? "A" "b") -(test #t string-ci<? "a" "b") -(test #f string-ci<? "9" "0") -(test #f string-ci<? "A" "A") -(test #f string-ci<? "A" "a") - -(test #f string-ci>? "A" "B") -(test #f string-ci>? "a" "B") -(test #f string-ci>? "A" "b") -(test #f string-ci>? "a" "b") -(test #t string-ci>? "9" "0") -(test #f string-ci>? "A" "A") -(test #f string-ci>? "A" "a") - -(test #t string-ci<=? "A" "B") -(test #t string-ci<=? "a" "B") -(test #t string-ci<=? "A" "b") -(test #t string-ci<=? "a" "b") -(test #f string-ci<=? "9" "0") -(test #t string-ci<=? "A" "A") -(test #t string-ci<=? "A" "a") - -(test #f string-ci>=? "A" "B") -(test #f string-ci>=? "a" "B") -(test #f string-ci>=? "A" "b") -(test #f string-ci>=? "a" "b") -(test #t string-ci>=? "9" "0") -(test #t string-ci>=? "A" "A") -(test #t string-ci>=? "A" "a") -(SECTION 6 8) -(test #t vector? '#(0 (2 2 2 2) "Anna")) -(test #t vector? '#()) -(test '#(a b c) vector 'a 'b 'c) -(test '#() vector) -(test 3 vector-length '#(0 (2 2 2 2) "Anna")) -(test 0 vector-length '#()) -(test 8 vector-ref '#(1 1 2 3 5 8 13 21) 5) -(test '#(0 ("Sue" "Sue") "Anna") 'vector-set - (let ((vec (vector 0 '(2 2 2 2) "Anna"))) - (vector-set! vec 1 '("Sue" "Sue")) - vec)) -(test '#(hi hi) make-vector 2 'hi) -(test '#() make-vector 0) -(test '#() make-vector 0 'a) -(SECTION 6 9) -(test #t procedure? car) -(test #f procedure? 'car) -(test #t procedure? (lambda (x) (* x x))) -(test #f procedure? '(lambda (x) (* x x))) -(test #t call-with-current-continuation procedure?) -(test 7 apply + (list 3 4)) -(test 7 apply (lambda (a b) (+ a b)) (list 3 4)) -(test 17 apply + 10 (list 3 4)) -(test '() apply list '()) -(define compose (lambda (f g) (lambda args (f (apply g args))))) -(test 30 (compose sqt *) 12 75) - -(test '(b e h) map cadr '((a b) (d e) (g h))) -(test '(5 7 9) map + '(1 2 3) '(4 5 6)) -(test '#(0 1 4 9 16) 'for-each - (let ((v (make-vector 5))) - (for-each (lambda (i) (vector-set! v i (* i i))) - '(0 1 2 3 4)) - v)) -(test -3 call-with-current-continuation - (lambda (exit) - (for-each (lambda (x) (if (negative? x) (exit x))) - '(54 0 37 -3 245 19)) - #t)) -(define list-length - (lambda (obj) - (call-with-current-continuation - (lambda (return) - (letrec ((r (lambda (obj) (cond ((null? obj) 0) - ((pair? obj) (+ (r (cdr obj)) 1)) - (else (return #f)))))) - (r obj)))))) -(test 4 list-length '(1 2 3 4)) -(test #f list-length '(a b . c)) -(test '() map cadr '()) - -;;; This tests full conformance of call-with-current-continuation. It -;;; is a separate test because some schemes do not support call/cc -;;; other than escape procedures. I am indebted to -;;; raja@copper.ucs.indiana.edu (Raja Sooriamurthi) for fixing this -;;; code. The function leaf-eq? compares the leaves of 2 arbitrary -;;; trees constructed of conses. -(define (next-leaf-generator obj eot) - (letrec ((return #f) - (cont (lambda (x) - (recur obj) - (set! cont (lambda (x) (return eot))) - (cont #f))) - (recur (lambda (obj) - (if (pair? obj) - (for-each recur obj) - (call-with-current-continuation - (lambda (c) - (set! cont c) - (return obj))))))) - (lambda () (call-with-current-continuation - (lambda (ret) (set! return ret) (cont #f)))))) -(define (leaf-eq? x y) - (let* ((eot (list 'eot)) - (xf (next-leaf-generator x eot)) - (yf (next-leaf-generator y eot))) - (letrec ((loop (lambda (x y) - (cond ((not (eq? x y)) #f) - ((eq? eot x) #t) - (else (loop (xf) (yf))))))) - (loop (xf) (yf))))) -(define (test-cont) - (newline) - (display ";testing continuations; ") - (newline) - (SECTION 6 9) - (test #t leaf-eq? '(a (b (c))) '((a) b c)) - (test #f leaf-eq? '(a (b (c))) '((a) b c d)) - (report-errs)) - -;;; Test Optional R4RS DELAY syntax and FORCE procedure -(define (test-delay) - (newline) - (display ";testing DELAY and FORCE; ") - (newline) - (SECTION 6 9) - (test 3 'delay (force (delay (+ 1 2)))) - (test '(3 3) 'delay (let ((p (delay (+ 1 2)))) - (list (force p) (force p)))) - (test 2 'delay (letrec ((a-stream - (letrec ((next (lambda (n) - (cons n (delay (next (+ n 1))))))) - (next 0))) - (head car) - (tail (lambda (stream) (force (cdr stream))))) - (head (tail (tail a-stream))))) - (letrec ((count 0) - (p (delay (begin (set! count (+ count 1)) - (if (> count x) - count - (force p))))) - (x 5)) - (test 6 force p) - (set! x 10) - (test 6 force p)) - (test 3 'force - (letrec ((p (delay (if c 3 (begin (set! c #t) (+ (force p) 1))))) - (c #f)) - (force p))) - (report-errs)) - -(SECTION 6 10 1) -(test #t input-port? (current-input-port)) -(test #t output-port? (current-output-port)) -(test #t call-with-input-file "test.scm" input-port?) -(define this-file (open-input-file "test.scm")) -(test #t input-port? this-file) -(SECTION 6 10 2) -(test #\; peek-char this-file) -(test #\; read-char this-file) -(test '(define cur-section '()) read this-file) -(test #\( peek-char this-file) -(test '(define errs '()) read this-file) -(close-input-port this-file) -(close-input-port this-file) -(define (check-test-file name) - (define test-file (open-input-file name)) - (test #t 'input-port? - (call-with-input-file - name - (lambda (test-file) - (test load-test-obj read test-file) - (test #t eof-object? (peek-char test-file)) - (test #t eof-object? (read-char test-file)) - (input-port? test-file)))) - (test #\; read-char test-file) - (test display-test-obj read test-file) - (test load-test-obj read test-file) - (close-input-port test-file)) -(SECTION 6 10 3) -(define write-test-obj - '(#t #f #\a () 9739 -3 . #((test) "te \" \" st" "" test #() b c))) -(define display-test-obj - '(#t #f a () 9739 -3 . #((test) te " " st test #() b c))) -(define load-test-obj - (list 'define 'foo (list 'quote write-test-obj))) -(test #t call-with-output-file - "tmp1" - (lambda (test-file) - (write-char #\; test-file) - (display write-test-obj test-file) - (newline test-file) - (write load-test-obj test-file) - (output-port? test-file))) -(check-test-file "tmp1") - -(define test-file (open-output-file "tmp2")) -(write-char #\; test-file) -(display write-test-obj test-file) -(newline test-file) -(write load-test-obj test-file) -(test #t output-port? test-file) -(close-output-port test-file) -(check-test-file "tmp2") -(define (test-sc4) - (newline) - (display ";testing scheme 4 functions; ") - (newline) - (SECTION 6 7) - (test '(#\P #\space #\l) string->list "P l") - (test '() string->list "") - (test "1\\\"" list->string '(#\1 #\\ #\")) - (test "" list->string '()) - (SECTION 6 8) - (test '(dah dah didah) vector->list '#(dah dah didah)) - (test '() vector->list '#()) - (test '#(dididit dah) list->vector '(dididit dah)) - (test '#() list->vector '()) - (SECTION 6 10 4) - (load "tmp1") - (test write-test-obj 'load foo) - (report-errs)) - -(report-errs) -(if (and (string->number "0.0") (inexact? (string->number "0.0"))) - (test-inexact)) - -(let ((n (string->number "281474976710655"))) - (if (and n (exact? n)) - (test-bignum))) -(newline) -(test-cont) -(newline) -(test-sc4) -(newline) -(test-delay) -(newline) -"last item in file" diff --git a/ice-9/threads.scm b/ice-9/threads.scm deleted file mode 100644 index 09c69259c..000000000 --- a/ice-9/threads.scm +++ /dev/null @@ -1,77 +0,0 @@ -;;;; Copyright (C) 1996 Free Software Foundation, Inc. -;;;; -;;;; This program is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. -;;;; -;;;; This program is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this software; see the file COPYING. If not, write to -;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA -;;;; -;;;; ---------------------------------------------------------------- -;;;; threads.scm -- User-level interface to Guile's thread system -;;;; 4 March 1996, Anthony Green <green@cygnus.com> -;;;; Modified 5 October 1996, MDJ <djurfeldt@nada.kth.se> -;;;; ---------------------------------------------------------------- -;;;; - - -(define-module (ice-9 threads)) - - - -; --- MACROS ------------------------------------------------------- - -(define-public (%thread-handler tag . args) - (fluid-set! the-last-stack #f) - (unmask-signals) - (let ((n (length args)) - (p (current-error-port))) - (display "In thread:" p) - (newline p) - (if (>= n 3) - (display-error #f - p - (car args) - (cadr args) - (caddr args) - (if (= n 4) - (cadddr args) - '())) - (begin - (display "uncaught throw to " p) - (display tag p) - (display ": " p) - (display args p) - (newline p))))) - -(defmacro-public make-thread (fn . args) - `(call-with-new-thread - (lambda () - (,fn ,@args)) - %thread-handler)) - -(defmacro-public begin-thread (first . thunk) - `(call-with-new-thread - (lambda () - (begin - ,first ,@thunk)) - %thread-handler)) - -(defmacro-public with-mutex (m . thunk) - `(dynamic-wind - (lambda () (lock-mutex ,m)) - (lambda () (begin ,@thunk)) - (lambda () (unlock-mutex ,m)))) - -(defmacro-public monitor (first . thunk) - `(with-mutex ,(make-mutex) - (begin - ,first ,@thunk))) diff --git a/ice-9/version.scm.in b/ice-9/version.scm.in deleted file mode 100644 index e69de29bb..000000000 --- a/ice-9/version.scm.in +++ /dev/null diff --git a/install-sh b/install-sh deleted file mode 100755 index e8436696c..000000000 --- a/install-sh +++ /dev/null @@ -1,250 +0,0 @@ -#!/bin/sh -# -# install - install a program, script, or datafile -# This comes from X11R5 (mit/util/scripts/install.sh). -# -# Copyright 1991 by the Massachusetts Institute of Technology -# -# Permission to use, copy, modify, distribute, and sell this software and its -# documentation for any purpose is hereby granted without fee, provided that -# the above copyright notice appear in all copies and that both that -# copyright notice and this permission notice appear in supporting -# documentation, and that the name of M.I.T. not be used in advertising or -# publicity pertaining to distribution of the software without specific, -# written prior permission. M.I.T. makes no representations about the -# suitability of this software for any purpose. It is provided "as is" -# without express or implied warranty. -# -# Calling this script install-sh is preferred over install.sh, to prevent -# `make' implicit rules from creating a file called install from it -# when there is no Makefile. -# -# This script is compatible with the BSD install script, but was written -# from scratch. It can only install one file at a time, a restriction -# shared with many OS's install programs. - - -# set DOITPROG to echo to test this script - -# Don't use :- since 4.3BSD and earlier shells don't like it. -doit="${DOITPROG-}" - - -# put in absolute paths if you don't have them in your path; or use env. vars. - -mvprog="${MVPROG-mv}" -cpprog="${CPPROG-cp}" -chmodprog="${CHMODPROG-chmod}" -chownprog="${CHOWNPROG-chown}" -chgrpprog="${CHGRPPROG-chgrp}" -stripprog="${STRIPPROG-strip}" -rmprog="${RMPROG-rm}" -mkdirprog="${MKDIRPROG-mkdir}" - -transformbasename="" -transform_arg="" -instcmd="$mvprog" -chmodcmd="$chmodprog 0755" -chowncmd="" -chgrpcmd="" -stripcmd="" -rmcmd="$rmprog -f" -mvcmd="$mvprog" -src="" -dst="" -dir_arg="" - -while [ x"$1" != x ]; do - case $1 in - -c) instcmd="$cpprog" - shift - continue;; - - -d) dir_arg=true - shift - continue;; - - -m) chmodcmd="$chmodprog $2" - shift - shift - continue;; - - -o) chowncmd="$chownprog $2" - shift - shift - continue;; - - -g) chgrpcmd="$chgrpprog $2" - shift - shift - continue;; - - -s) stripcmd="$stripprog" - shift - continue;; - - -t=*) transformarg=`echo $1 | sed 's/-t=//'` - shift - continue;; - - -b=*) transformbasename=`echo $1 | sed 's/-b=//'` - shift - continue;; - - *) if [ x"$src" = x ] - then - src=$1 - else - # this colon is to work around a 386BSD /bin/sh bug - : - dst=$1 - fi - shift - continue;; - esac -done - -if [ x"$src" = x ] -then - echo "install: no input file specified" - exit 1 -else - true -fi - -if [ x"$dir_arg" != x ]; then - dst=$src - src="" - - if [ -d $dst ]; then - instcmd=: - else - instcmd=mkdir - fi -else - -# Waiting for this to be detected by the "$instcmd $src $dsttmp" command -# might cause directories to be created, which would be especially bad -# if $src (and thus $dsttmp) contains '*'. - - if [ -f $src -o -d $src ] - then - true - else - echo "install: $src does not exist" - exit 1 - fi - - if [ x"$dst" = x ] - then - echo "install: no destination specified" - exit 1 - else - true - fi - -# If destination is a directory, append the input filename; if your system -# does not like double slashes in filenames, you may need to add some logic - - if [ -d $dst ] - then - dst="$dst"/`basename $src` - else - true - fi -fi - -## this sed command emulates the dirname command -dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` - -# Make sure that the destination directory exists. -# this part is taken from Noah Friedman's mkinstalldirs script - -# Skip lots of stat calls in the usual case. -if [ ! -d "$dstdir" ]; then -defaultIFS=' -' -IFS="${IFS-${defaultIFS}}" - -oIFS="${IFS}" -# Some sh's can't handle IFS=/ for some reason. -IFS='%' -set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'` -IFS="${oIFS}" - -pathcomp='' - -while [ $# -ne 0 ] ; do - pathcomp="${pathcomp}${1}" - shift - - if [ ! -d "${pathcomp}" ] ; - then - $mkdirprog "${pathcomp}" - else - true - fi - - pathcomp="${pathcomp}/" -done -fi - -if [ x"$dir_arg" != x ] -then - $doit $instcmd $dst && - - if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi && - if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi && - if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi && - if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi -else - -# If we're going to rename the final executable, determine the name now. - - if [ x"$transformarg" = x ] - then - dstfile=`basename $dst` - else - dstfile=`basename $dst $transformbasename | - sed $transformarg`$transformbasename - fi - -# don't allow the sed command to completely eliminate the filename - - if [ x"$dstfile" = x ] - then - dstfile=`basename $dst` - else - true - fi - -# Make a temp file name in the proper directory. - - dsttmp=$dstdir/#inst.$$# - -# Move or copy the file name to the temp name - - $doit $instcmd $src $dsttmp && - - trap "rm -f ${dsttmp}" 0 && - -# and set any options; do chmod last to preserve setuid bits - -# If any of these fail, we abort the whole thing. If we want to -# ignore errors from any of these, just make sure not to ignore -# errors from the above "$doit $instcmd $src $dsttmp" command. - - if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi && - if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi && - if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi && - if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi && - -# Now rename the file to the real destination. - - $doit $rmcmd -f $dstdir/$dstfile && - $doit $mvcmd $dsttmp $dstdir/$dstfile - -fi && - - -exit 0 diff --git a/ltconfig b/ltconfig deleted file mode 100755 index 2347e6943..000000000 --- a/ltconfig +++ /dev/null @@ -1,1512 +0,0 @@ -#! /bin/sh - -# ltconfig - Create a system-specific libtool. -# Copyright (C) 1996-1998 Free Software Foundation, Inc. -# Gordon Matzigkeit <gord@gnu.ai.mit.edu>, 1996 -# -# 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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. - -# A lot of this script is taken from autoconf-2.10. - -# The HP-UX ksh and POSIX shell print the target directory to stdout -# if CDPATH is set. -if test "${CDPATH+set}" = set; then CDPATH=; export CDPATH; fi - -echo=echo -if test "X`($echo '\t') 2>/dev/null`" = 'X\t'; then : -else - # The Solaris and AIX default echo program unquotes backslashes. - # This makes it impossible to quote backslashes using - # echo "$something" | sed 's/\\/\\\\/g' - # So, we emulate echo with printf '%s\n' - echo="printf %s\\n" - if test "X`($echo '\t') 2>/dev/null`" = 'X\t'; then : - else - # Oops. We have no working printf. Try to find a not-so-buggy echo. - echo=echo - IFS="${IFS= }"; save_ifs="$IFS"; IFS="${IFS}:" - for dir in $PATH /usr/ucb; do - if test -f $dir/echo && test "X`$dir/echo '\t'`" = 'X\t'; then - echo="$dir/echo" - break - fi - done - IFS="$save_ifs" - fi -fi - -# Sed substitution that helps us do robust quoting. It backslashifies -# metacharacters that are still active within double-quoted strings. -Xsed='sed -e s/^X//' -sed_quote_subst='s/\([\\"\\`$\\\\]\)/\\\1/g' - -# Same as above, but do not quote variable references. -double_quote_subst='s/\([\\"\\`\\\\]\)/\\\1/g' - -# The name of this program. -progname=`$echo "X$0" | $Xsed -e 's%^.*/%%'` - -# Constants: -PROGRAM=ltconfig -PACKAGE=libtool -VERSION=1.2 -ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.c 1>&5' -ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.c $LIBS 1>&5' -rm="rm -f" - -help="Try \`$progname --help' for more information." - -# Global variables: -can_build_shared=yes -enable_shared=yes -# All known linkers require a `.a' archive for static linking. -enable_static=yes -ltmain= -silent= -srcdir= -ac_config_guess= -ac_config_sub= -host= -nonopt= -verify_host=yes -with_gcc=no -with_gnu_ld=no - -old_AR="$AR" -old_CC="$CC" -old_CFLAGS="$CFLAGS" -old_CPPFLAGS="$CPPFLAGS" -old_LD="$LD" -old_LN_S="$LN_S" -old_NM="$NM" -old_RANLIB="$RANLIB" - -# Parse the command line options. -args= -prev= -for option -do - case "$option" in - -*=*) optarg=`echo "$option" | sed 's/[-_a-zA-Z0-9]*=//'` ;; - *) optarg= ;; - esac - - # If the previous option needs an argument, assign it. - if test -n "$prev"; then - eval "$prev=\$option" - prev= - continue - fi - - case "$option" in - --help) cat <<EOM -Usage: $progname [OPTION]... LTMAIN [HOST] - -Generate a system-specific libtool script. - - --disable-shared do not build shared libraries - --disable-static do not build static libraries - --help display this help and exit - --no-verify do not verify that HOST is a valid host type - --quiet same as \`--silent' - --silent do not print informational messages - --srcdir=DIR find \`config.guess' in DIR - --version output version information and exit - --with-gcc assume that the GNU C compiler will be used - --with-gnu-ld assume that the C compiler uses the GNU linker - -LTMAIN is the \`ltmain.sh' shell script fragment that provides basic libtool -functionality. - -HOST is the canonical host system name [default=guessed]. -EOM - exit 0 - ;; - - --disable-shared) enable_shared=no ;; - - --disable-static) enable_static=no ;; - - --quiet | --silent) silent=yes ;; - - --srcdir) prev=srcdir ;; - --srcdir=*) srcdir="$optarg" ;; - - --no-verify) verify_host=no ;; - - --version) echo "$PROGRAM (GNU $PACKAGE) $VERSION"; exit 0 ;; - - --with-gcc) with_gcc=yes ;; - --with-gnu-ld) with_gnu_ld=yes ;; - - -*) - echo "$progname: unrecognized option \`$option'" 1>&2 - echo "$help" 1>&2 - exit 1 - ;; - - *) - if test -z "$ltmain"; then - ltmain="$option" - elif test -z "$host"; then -# This generates an unnecessary warning for sparc-sun-solaris4.1.3_U1 -# if test -n "`echo $option| sed 's/[-a-z0-9.]//g'`"; then -# echo "$progname: warning \`$option' is not a valid host type" 1>&2 -# fi - host="$option" - else - echo "$progname: too many arguments" 1>&2 - echo "$help" 1>&2 - exit 1 - fi ;; - esac -done - -if test -z "$ltmain"; then - echo "$progname: you must specify a LTMAIN file" 1>&2 - echo "$help" 1>&2 - exit 1 -fi - -if test -f "$ltmain"; then : -else - echo "$progname: \`$ltmain' does not exist" 1>&2 - echo "$help" 1>&2 - exit 1 -fi - -# Quote any args containing shell metacharacters. -ltconfig_args= -for arg -do - case "$arg" in - *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*) - ltconfig_args="$ltconfig_args '$arg'" ;; - *) ltconfig_args="$ltconfig_args $arg" ;; - esac -done - -# A relevant subset of AC_INIT. - -# File descriptor usage: -# 0 standard input -# 1 file creation -# 2 errors and warnings -# 3 some systems may open it to /dev/tty -# 4 used on the Kubota Titan -# 5 compiler messages saved in config.log -# 6 checking for... messages and results -if test "$silent" = yes; then - exec 6>/dev/null -else - exec 6>&1 -fi -exec 5>>./config.log - -# NLS nuisances. -# Only set LANG and LC_ALL to C if already set. -# These must not be set unconditionally because not all systems understand -# e.g. LANG=C (notably SCO). -if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi -if test "${LANG+set}" = set; then LANG=C; export LANG; fi - -if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then - # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. - if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then - ac_n= ac_c=' -' ac_t=' ' - else - ac_n=-n ac_c= ac_t= - fi -else - ac_n= ac_c='\c' ac_t= -fi - -if test -z "$srcdir"; then - # Assume the source directory is the same one as the path to ltmain.sh. - srcdir=`$echo "$ltmain" | $Xsed -e 's%/[^/]*$%%'` - test "$srcdir" = "$ltmain" && srcdir=. -fi - -trap "$rm conftest*; exit 1" 1 2 15 -if test "$verify_host" = yes; then - # Check for config.guess and config.sub. - ac_aux_dir= - for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do - if test -f $ac_dir/config.guess; then - ac_aux_dir=$ac_dir - break - fi - done - if test -z "$ac_aux_dir"; then - echo "$progname: cannot find config.guess in $srcdir $srcdir/.. $srcdir/../.." 1>&2 - echo "$help" 1>&2 - exit 1 - fi - ac_config_guess=$ac_aux_dir/config.guess - ac_config_sub=$ac_aux_dir/config.sub - - # Make sure we can run config.sub. - if $ac_config_sub sun4 >/dev/null 2>&1; then : - else - echo "$progname: cannot run $ac_config_sub" 1>&2 - echo "$help" 1>&2 - exit 1 - fi - - echo $ac_n "checking host system type""... $ac_c" 1>&6 - - host_alias=$host - case "$host_alias" in - "") - if host_alias=`$ac_config_guess`; then : - else - echo "$progname: cannot guess host type; you must specify one" 1>&2 - echo "$help" 1>&2 - exit 1 - fi ;; - esac - host=`$ac_config_sub $host_alias` - echo "$ac_t$host" 1>&6 - - # Make sure the host verified. - test -z "$host" && exit 1 - -elif test -z "$host"; then - echo "$progname: you must specify a host type if you use \`--no-verify'" 1>&2 - echo "$help" 1>&2 - exit 1 -else - host_alias=$host -fi - -# Transform linux* to *-*-linux-gnu*, to support old configure scripts. -case "$host_os" in -linux-gnu*) ;; -linux*) host=`echo $host | sed 's/^\(.*-.*-linux\)\(.*\)$/\1-gnu\2/'` -esac - -host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'` -host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'` -host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` - -case "$host_os" in -aix3*) - # AIX sometimes has problems with the GCC collect2 program. For some - # reason, if we set the COLLECT_NAMES environment variable, the problems - # vanish in a puff of smoke. - if test "${COLLECT_NAMES+set}" != set; then - COLLECT_NAMES= - export COLLECT_NAMES - fi - ;; -esac - -# Determine commands to create old-style static archives. -old_archive_cmds='$AR cru $oldlib$oldobjs' -old_postinstall_cmds='chmod 644 $oldlib' -old_postuninstall_cmds= - -# Set a sane default for `AR'. -test -z "$AR" && AR=ar - -# If RANLIB is not set, then run the test. -if test "${RANLIB+set}" != "set"; then - result=no - - echo $ac_n "checking for ranlib... $ac_c" 1>&6 - IFS="${IFS= }"; save_ifs="$IFS"; IFS="${IFS}:" - for dir in $PATH; do - test -z "$dir" && dir=. - if test -f $dir/ranlib; then - RANLIB="ranlib" - result="ranlib" - break - fi - done - IFS="$save_ifs" - - echo "$ac_t$result" 1>&6 -fi - -if test -n "$RANLIB"; then - old_archive_cmds="$old_archive_cmds;\$RANLIB \$oldlib" - old_postinstall_cmds="\$RANLIB \$oldlib;$old_postinstall_cmds" -fi - -# Check to see if we are using GCC. -if test "$with_gcc" != yes || test -z "$CC"; then - # If CC is not set, then try to find GCC or a usable CC. - if test -z "$CC"; then - echo $ac_n "checking for gcc... $ac_c" 1>&6 - IFS="${IFS= }"; save_ifs="$IFS"; IFS="${IFS}:" - for dir in $PATH; do - IFS="$save_ifs" - test -z "$dir" && dir=. - if test -f $dir/gcc; then - CC="gcc" - break - fi - done - IFS="$save_ifs" - - if test -n "$CC"; then - echo "$ac_t$CC" 1>&6 - else - echo "$ac_t"no 1>&6 - fi - fi - - # Not "gcc", so try "cc", rejecting "/usr/ucb/cc". - if test -z "$CC"; then - echo $ac_n "checking for cc... $ac_c" 1>&6 - IFS="${IFS= }"; save_ifs="$IFS"; IFS="${IFS}:" - cc_rejected=no - for dir in $PATH; do - test -z "$dir" && dir=. - if test -f $dir/cc; then - if test "$dir/cc" = "/usr/ucb/cc"; then - cc_rejected=yes - continue - fi - CC="cc" - break - fi - done - IFS="$save_ifs" - if test $cc_rejected = yes; then - # We found a bogon in the path, so make sure we never use it. - set dummy $CC - shift - if test $# -gt 0; then - # We chose a different compiler from the bogus one. - # However, it has the same name, so the bogon will be chosen - # first if we set CC to just the name; use the full file name. - shift - set dummy "$dir/cc" "$@" - shift - CC="$@" - fi - fi - - if test -n "$CC"; then - echo "$ac_t$CC" 1>&6 - else - echo "$ac_t"no 1>&6 - fi - - if test -z "$CC"; then - echo "$progname: error: no acceptable cc found in \$PATH" 1>&2 - exit 1 - fi - fi - - # Now see if the compiler is really GCC. - with_gcc=no - echo $ac_n "checking whether we are using GNU C... $ac_c" 1>&6 - echo "$progname:424: checking whether we are using GNU C" >&5 - - $rm conftest.c - cat > conftest.c <<EOF -#ifdef __GNUC__ - yes; -#endif -EOF - if { ac_try='${CC-cc} -E conftest.c'; { (eval echo $progname:432: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then - with_gcc=yes - fi - $rm conftest.c - echo "$ac_t$with_gcc" 1>&6 -fi - -# Allow CC to be a program name with arguments. -set dummy $CC -compiler="$2" - -echo $ac_n "checking for $compiler option to produce PIC... $ac_c" 1>&6 -pic_flag= -special_shlib_compile_flags= -wl= -link_static_flag= -no_builtin_flag= - -if test "$with_gcc" = yes; then - wl='-Wl,' - link_static_flag='-static' - no_builtin_flag=' -fno-builtin' - - case "$host_os" in - aix3* | aix4* | irix5* | irix6* | osf3* | osf4*) - # PIC is the default for these OSes. - ;; - os2*) - # We can build DLLs from non-PIC. - ;; - amigaos*) - # FIXME: we need at least 68020 code to build shared libraries, but - # adding the `-m68020' flag to GCC prevents building anything better, - # like `-m68040'. - pic_flag='-m68020 -resident32 -malways-restore-a4' - ;; - *) - pic_flag='-fPIC' - ;; - esac -else - # PORTME Check for PIC flags for the system compiler. - case "$host_os" in - aix3* | aix4*) - # All AIX code is PIC. - link_static_flag='-bnso -bI:/lib/syscalls.exp' - ;; - - hpux9* | hpux10*) - # Is there a better link_static_flag that works with the bundled CC? - wl='-Wl,' - link_static_flag="${wl}-a ${wl}archive" - pic_flag='+Z' - ;; - - irix5* | irix6*) - wl='-Wl,' - link_static_flag='-non_shared' - # PIC (with -KPIC) is the default. - ;; - - os2*) - # We can build DLLs from non-PIC. - ;; - - osf3* | osf4*) - # All OSF/1 code is PIC. - wl='-Wl,' - link_static_flag='-non_shared' - ;; - - sco3.2v5*) - pic_flag='-Kpic' - link_static_flag='-dn' - special_shlib_compile_flags='-belf' - ;; - - solaris2*) - pic_flag='-KPIC' - link_static_flag='-Bstatic' - wl='-Wl,' - ;; - - sunos4*) - pic_flag='-PIC' - link_static_flag='-Bstatic' - wl='-Qoption ld ' - ;; - - sysv4.2uw2*) - pic_flag='-KPIC' - link_static_flag='-Bstatic' - wl='-Wl,' - ;; - - uts4*) - pic_flag='-pic' - link_static_flag='-Bstatic' - ;; - - *) - can_build_shared=no - ;; - esac -fi - -if test -n "$pic_flag"; then - echo "$ac_t$pic_flag" 1>&6 - - # Check to make sure the pic_flag actually works. - echo $ac_n "checking if $compiler PIC flag $pic_flag works... $ac_c" 1>&6 - $rm conftest* - echo > conftest.c - save_CFLAGS="$CFLAGS" - CFLAGS="$CFLAGS $pic_flag -DPIC" - echo "$progname:547: checking if $compiler PIC flag $pic_flag works" >&5 - if { (eval echo $progname:548: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>conftest.err; } && test -s conftest.o; then - # Append any warnings to the config.log. - cat conftest.err 1>&5 - - # On HP-UX, both CC and GCC only warn that PIC is supported... then they - # create non-PIC objects. So, if there were any warnings, we assume that - # PIC is not supported. - if test -s conftest.err; then - echo "$ac_t"no 1>&6 - can_build_shared=no - pic_flag= - else - echo "$ac_t"yes 1>&6 - pic_flag=" $pic_flag" - fi - else - # Append any errors to the config.log. - cat conftest.err 1>&5 - can_build_shared=no - pic_flag= - echo "$ac_t"no 1>&6 - fi - CFLAGS="$save_CFLAGS" - $rm conftest* -else - echo "$ac_t"none 1>&6 -fi - -# Check for any special shared library compilation flags. -if test -n "$special_shlib_compile_flags"; then - echo "$progname: warning: \`$CC' requires \`$special_shlib_compile_flags' to build shared libraries" 1>&2 - if echo "$old_CC $old_CFLAGS " | egrep -e "[ ]$special_shlib_compile_flags[ ]" >/dev/null; then : - else - echo "$progname: add \`$special_shlib_compile_flags' to the CC or CFLAGS env variable and reconfigure" 1>&2 - can_build_shared=no - fi -fi - -echo $ac_n "checking if $compiler static flag $link_static_flag works... $ac_c" 1>&6 -$rm conftest* -echo 'main(){return(0);}' > conftest.c -save_LDFLAGS="$LDFLAGS" -LDFLAGS="$LDFLAGS $link_static_flag" -echo "$progname:591: checking if $compiler static flag $link_static_flag works" >&5 -if { (eval echo $progname:592: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - echo "$ac_t$link_static_flag" 1>&6 -else - echo "$ac_t"none 1>&6 - link_static_flag= -fi -LDFLAGS="$save_LDFLAGS" -$rm conftest* - -if test -z "$LN_S"; then - # Check to see if we can use ln -s, or we need hard links. - echo $ac_n "checking whether ln -s works... $ac_c" 1>&6 - $rm conftestdata - if ln -s X conftestdata 2>/dev/null; then - $rm conftestdata - LN_S="ln -s" - else - LN_S=ln - fi - if test "$LN_S" = "ln -s"; then - echo "$ac_t"yes 1>&6 - else - echo "$ac_t"no 1>&6 - fi -fi - -# Make sure LD is an absolute path. -if test -z "$LD"; then - ac_prog=ld - if test "$with_gcc" = yes; then - # Check if gcc -print-prog-name=ld gives a path. - echo $ac_n "checking for ld used by GCC... $ac_c" 1>&6 - echo "$progname:624: checking for ld used by GCC" >&5 - ac_prog=`($CC -print-prog-name=ld) 2>&5` - case "$ac_prog" in - # Accept absolute paths. - /* | [A-Za-z]:\\*) - test -z "$LD" && LD="$ac_prog" - ;; - "") - # If it fails, then pretend we are not using GCC. - ac_prog=ld - ;; - *) - # If it is relative, then search for the first ld in PATH. - with_gnu_ld=unknown - ;; - esac - elif test "$with_gnu_ld" = yes; then - echo $ac_n "checking for GNU ld... $ac_c" 1>&6 - echo "$progname:642: checking for GNU ld" >&5 - else - echo $ac_n "checking for non-GNU ld""... $ac_c" 1>&6 - echo "$progname:645: checking for non-GNU ld" >&5 - fi - - if test -z "$LD"; then - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" - for ac_dir in $PATH; do - test -z "$ac_dir" && ac_dir=. - if test -f "$ac_dir/$ac_prog"; then - LD="$ac_dir/$ac_prog" - # Check to see if the program is GNU ld. I'd rather use --version, - # but apparently some GNU ld's only accept -v. - # Break only if it was the GNU/non-GNU ld that we prefer. - if "$LD" -v 2>&1 < /dev/null | egrep '(GNU|with BFD)' > /dev/null; then - test "$with_gnu_ld" != no && break - else - test "$with_gnu_ld" != yes && break - fi - fi - done - IFS="$ac_save_ifs" - fi - - if test -n "$LD"; then - echo "$ac_t$LD" 1>&6 - else - echo "$ac_t"no 1>&6 - fi - - if test -z "$LD"; then - echo "$progname: error: no acceptable ld found in \$PATH" 1>&2 - exit 1 - fi -fi - -# Check to see if it really is or is not GNU ld. -echo $ac_n "checking if the linker ($LD) is GNU ld... $ac_c" 1>&6 -# I'd rather use --version here, but apparently some GNU ld's only accept -v. -if $LD -v 2>&1 </dev/null | egrep '(GNU|with BFD)' 1>&5; then - with_gnu_ld=yes -else - with_gnu_ld=no -fi -echo "$ac_t$with_gnu_ld" 1>&6 - -# See if the linker supports building shared libraries. -echo $ac_n "checking whether the linker ($LD) supports shared libraries... $ac_c" 1>&6 - -allow_undefined_flag= -no_undefined_flag= -archive_cmds= -old_archive_from_new_cmds= -export_dynamic_flag_spec= -hardcode_libdir_flag_spec= -hardcode_libdir_separator= -hardcode_direct=no -hardcode_minus_L=no -hardcode_shlibpath_var=unsupported -runpath_var= - -case "$host_os" in -amigaos* | sunos4*) - # On these operating systems, we should treat GNU ld like the system ld. - gnu_ld_acts_native=yes - ;; -*) - gnu_ld_acts_native=no - ;; -esac - -ld_shlibs=yes -if test "$with_gnu_ld" = yes && test "$gnu_ld_acts_native" != yes; then - - # See if GNU ld supports shared libraries. - if $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then - archive_cmds='$CC -shared ${wl}-soname $wl$soname -o $lib$libobjs' - runpath_var=LD_RUN_PATH - ld_shlibs=yes - else - ld_shlibs=no - fi - - if test "$ld_shlibs" = yes; then - hardcode_libdir_flag_spec='${wl}--rpath ${wl}$libdir' - export_dynamic_flag_spec='${wl}--export-dynamic' - fi -else - # PORTME fill in a description of your system's linker (not GNU ld) - case "$host_os" in - aix3*) - allow_undefined_flag=unsupported - archive_cmds='$NM$libobjs | $global_symbol_pipe | sed '\''s/.* //'\'' > $lib.exp;$LD -o $objdir/$soname$libobjs -bE:$lib.exp -T512 -H512 -bM:SRE;$AR cru $lib $objdir/$soname' - # Note: this linker hardcodes the directories in LIBPATH if there - # are no directories specified by -L. - hardcode_minus_L=yes - if test "$with_gcc" = yes && test -z "$link_static_flag"; then - # Neither direct hardcoding nor static linking is supported with a - # broken collect2. - hardcode_direct=unsupported - fi - ;; - - aix4*) - allow_undefined_flag=unsupported - archive_cmds='$NM$libobjs | $global_symbol_pipe | sed '\''s/.* //'\'' > $lib.exp;$CC -o $objdir/$soname$libobjs ${wl}-bE:$lib.exp ${wl}-bM:SRE ${wl}-bnoentry;$AR cru $lib $objdir/$soname' - hardcode_direct=yes - hardcode_minus_L=yes - ;; - - amigaos*) - archive_cmds='$rm $objdir/a2ixlibrary.data;$echo "#define NAME $libname" > $objdir/a2ixlibrary.data;$echo "#define LIBRARY_ID 1" >> $objdir/a2ixlibrary.data;$echo "#define VERSION $major" >> $objdir/a2ixlibrary.data;$echo "#define REVISION $revision" >> $objdir/a2ixlibrary.data;$AR cru $lib$libobjs;$RANLIB $lib;(cd $objdir && a2ixlibrary -32)' - hardcode_libdir_flag_spec='-L$libdir' - hardcode_minus_L=yes - ;; - - # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor - # support. Future versions do this automatically, but an explicit c++rt0.o - # does not break anything, and helps significantly (at the cost of a little - # extra space). - freebsd2.2*) - archive_cmds='$LD -Bshareable -o $lib$libobjs /usr/lib/c++rt0.o' - hardcode_libdir_flag_spec='-R$libdir' - hardcode_direct=yes - hardcode_minus_L=yes - hardcode_shlibpath_var=no - ;; - - # Unfortunately, older versions of FreeBSD 2 do not have this feature. - freebsd2*) - archive_cmds='$LD -Bshareable -o $lib$libobjs' - hardcode_direct=yes - hardcode_minus_L=yes - hardcode_shlibpath_var=no - ;; - - # FreeBSD 3, at last, uses gcc -shared to do shared libraries. - freebsd3*) - archive_cmds='$CC -shared -o $lib$libobjs' - hardcode_libdir_flag_spec='-R$libdir' - hardcode_direct=yes - hardcode_minus_L=yes - hardcode_shlibpath_var=no - ;; - - hpux9*) - archive_cmds='$rm $objdir/$soname;$LD -b +s +b $install_libdir -o $objdir/$soname$libobjs;mv $objdir/$soname $lib' - hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir' - hardcode_direct=yes - hardcode_minus_L=yes - export_dynamic_flag_spec='${wl}-E' - ;; - - hpux10*) - archive_cmds='$LD -b +h $soname +s +b $install_libdir -o $lib$libobjs' - hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir' - hardcode_direct=yes - hardcode_minus_L=yes - export_dynamic_flag_spec='${wl}-E' - ;; - - irix5* | irix6*) - archive_cmds='$LD -shared -o $lib -soname $soname -set_version $verstring$libobjs' - hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' - ;; - - netbsd*) - # Tested with NetBSD 1.2 ld - archive_cmds='$LD -Bshareable -o $lib$libobjs' - hardcode_libdir_flag_spec='-R$libdir' - hardcode_direct=yes - hardcode_shlibpath_var=no - ;; - - openbsd*) - archive_cmds='$LD -Bshareable -o $lib$libobjs' - hardcode_libdir_flag_spec='-R$libdir' - hardcode_direct=yes - hardcode_shlibpath_var=no - ;; - - os2*) - hardcode_libdir_flag_spec='-L$libdir' - hardcode_minus_L=yes - allow_undefined_flag=unsupported - archive_cmds='$echo "LIBRARY $libname INITINSTANCE" > $objdir/$libname.def;$echo "DESCRIPTION \"$libname\"" >> $objdir/$libname.def;$echo DATA >> $objdir/$libname.def;$echo " SINGLE NONSHARED" >> $objdir/$libname.def;$echo EXPORTS >> $objdir/$libname.def;emxexp$libobjs >> $objdir/$libname.def;$CC -Zdll -Zcrtdll -o $lib$libobjs $objdir/$libname.def' - old_archive_from_new_cmds='emximp -o $objdir/$libname.a $objdir/$libname.def' - ;; - - osf3* | osf4*) - allow_undefined_flag=' -expect_unresolved \*' - archive_cmds='$LD -shared${allow_undefined_flag} -o $lib -soname $soname -set_version $verstring$libobjs$deplibs' - hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' - hardcode_libdir_separator=: - ;; - - sco3.2v5*) - archive_cmds='$LD -G -o $lib$libobjs' - hardcode_direct=yes - ;; - - solaris2*) - no_undefined_flag=' -z text' - archive_cmds='$LD -G${allow_undefined_flag} -h $soname -o $lib$libobjs' - hardcode_libdir_flag_spec='-R$libdir' - hardcode_shlibpath_var=no - - # Solaris 2 before 2.5 hardcodes -L paths. - case "$host_os" in - solaris2.[0-4]*) - hardcode_minus_L=yes - ;; - esac - ;; - - sunos4*) - if test "$with_gcc" = yes; then - archive_cmds='$CC -shared -o $lib$libobjs' - else - archive_cmds='$LD -assert pure-text -Bstatic -o $lib$libobjs' - fi - - if test "$with_gnu_ld" = yes; then - export_dynamic_flag_spec='${wl}-export-dynamic' - fi - hardcode_libdir_flag_spec='-L$libdir' - hardcode_direct=yes - hardcode_minus_L=yes - hardcode_shlibpath_var=no - ;; - - uts4*) - archive_cmds='$LD -G -h $soname -o $lib$libobjs' - hardcode_libdir_flag_spec='-L$libdir' - hardcode_direct=no - hardcode_minus_L=no - hardcode_shlibpath_var=no - ;; - - *) - ld_shlibs=no - can_build_shared=no - ;; - esac -fi -echo "$ac_t$ld_shlibs" 1>&6 - -if test -z "$NM"; then - echo $ac_n "checking for BSD-compatible nm... $ac_c" 1>&6 - case "$NM" in - /* | [A-Za-z]:\\*) ;; # Let the user override the test with a path. - *) - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" - for ac_dir in /usr/ucb /usr/ccs/bin $PATH /bin; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/nm; then - # Check to see if the nm accepts a BSD-compat flag. - # Adding the `sed 1q' prevents false positives on HP-UX, which says: - # nm: unknown option "B" ignored - if ($ac_dir/nm -B /dev/null 2>&1 | sed '1q'; exit 0) | egrep /dev/null >/dev/null; then - NM="$ac_dir/nm -B" - elif ($ac_dir/nm -p /dev/null 2>&1 | sed '1q'; exit 0) | egrep /dev/null >/dev/null; then - NM="$ac_dir/nm -p" - else - NM="$ac_dir/nm" - fi - break - fi - done - IFS="$ac_save_ifs" - test -z "$NM" && NM=nm - ;; - esac - echo "$ac_t$NM" 1>&6 -fi - -# Check for command to grab the raw symbol name followed by C symbol from nm. -echo $ac_n "checking command to parse $NM output... $ac_c" 1>&6 - -# These are sane defaults that work on at least a few old systems. -# [They come from Ultrix. What could be older than Ultrix?!! ;)] - -# Character class describing NM global symbol codes. -symcode='[BCDEGRSTU]' - -# Regexp to match symbols that can be accessed directly from C. -sympat='\([_A-Za-z][_A-Za-z0-9]*\)' - -# Transform the above into a raw symbol and a C symbol. -symxfrm='\1 \1' - -# Define system-specific variables. -case "$host_os" in -aix*) - symcode='[BCDTU]' - ;; -irix*) - # Cannot use undefined symbols on IRIX because inlined functions mess us up. - symcode='[BCDEGRST]' - ;; -solaris2*) - symcode='[BDTU]' - ;; -esac - -# If we're using GNU nm, then use its standard symbol codes. -if $NM -V 2>&1 | egrep '(GNU|with BFD)' > /dev/null; then - symcode='[ABCDGISTUW]' -fi - -# Write the raw and C identifiers. -global_symbol_pipe="sed -n -e 's/^.* $symcode $sympat$/$symxfrm/p'" - -# Check to see that the pipe works correctly. -pipe_works=no -$rm conftest* -cat > conftest.c <<EOF -#ifdef __cplusplus -extern "C" { -#endif -char nm_test_var; -void nm_test_func(){} -#ifdef __cplusplus -} -#endif -main(){nm_test_var='a';nm_test_func();return(0);} -EOF - -echo "$progname:971: checking if global_symbol_pipe works" >&5 -if { (eval echo $progname:972: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; } && test -s conftest.o; then - # Now try to grab the symbols. - nlist=conftest.nm - if { echo "$progname:975: eval \"$NM conftest.o | $global_symbol_pipe > $nlist\"" >&5; eval "$NM conftest.o | $global_symbol_pipe > $nlist 2>&5"; } && test -s "$nlist"; then - - # Try sorting and uniquifying the output. - if sort "$nlist" | uniq > "$nlist"T; then - mv -f "$nlist"T "$nlist" - wcout=`wc "$nlist" 2>/dev/null` - count=`$echo "X$wcout" | $Xsed -e 's/^[ ]*\([0-9][0-9]*\).*$/\1/'` - (test "$count" -ge 0) 2>/dev/null || count=-1 - else - rm -f "$nlist"T - count=-1 - fi - - # Make sure that we snagged all the symbols we need. - if egrep ' nm_test_var$' "$nlist" >/dev/null; then - if egrep ' nm_test_func$' "$nlist" >/dev/null; then - cat <<EOF > conftest.c -#ifdef __cplusplus -extern "C" { -#endif - -EOF - # Now generate the symbol file. - sed 's/^.* \(.*\)$/extern char \1;/' < "$nlist" >> conftest.c - - cat <<EOF >> conftest.c -#if defined (__STDC__) && __STDC__ -# define __ptr_t void * -#else -# define __ptr_t char * -#endif - -/* The number of symbols in dld_preloaded_symbols, -1 if unsorted. */ -int dld_preloaded_symbol_count = $count; - -/* The mapping between symbol names and symbols. */ -struct { - char *name; - __ptr_t address; -} -dld_preloaded_symbols[] = -{ -EOF - sed 's/^\(.*\) \(.*\)$/ {"\1", (__ptr_t) \&\2},/' < "$nlist" >> conftest.c - cat <<\EOF >> conftest.c - {0, (__ptr_t) 0} -}; - -#ifdef __cplusplus -} -#endif -EOF - # Now try linking the two files. - mv conftest.o conftestm.o - save_LIBS="$LIBS" - save_CFLAGS="$CFLAGS" - LIBS='conftestm.o' - CFLAGS="$CFLAGS$no_builtin_flag" - if { (eval echo $progname:1033: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - pipe_works=yes - else - echo "$progname: failed program was:" >&5 - cat conftest.c >&5 - fi - LIBS="$save_LIBS" - else - echo "cannot find nm_test_func in $nlist" >&5 - fi - else - echo "cannot find nm_test_var in $nlist" >&5 - fi - else - echo "cannot run $global_symbol_pipe" >&5 - fi -else - echo "$progname: failed program was:" >&5 - cat conftest.c >&5 -fi -$rm conftest* - -# Do not use the global_symbol_pipe unless it works. -echo "$ac_t$pipe_works" 1>&6 -test "$pipe_works" = yes || global_symbol_pipe= - -# Check hardcoding attributes. -echo $ac_n "checking how to hardcode library paths into programs... $ac_c" 1>&6 -hardcode_action= -if test -n "$hardcode_libdir_flag_spec" || \ - test -n "$runpath_var"; then - - # We can hardcode non-existant directories. - if test "$hardcode_direct" != no && \ - test "$hardcode_minus_L" != no && \ - test "$hardcode_shlibpath_var" != no; then - - # Linking always hardcodes the temporary library directory. - hardcode_action=relink - else - # We can link without hardcoding, and we can hardcode nonexisting dirs. - hardcode_action=immediate - fi -elif test "$hardcode_direct" != yes && \ - test "$hardcode_minus_L" != yes && \ - test "$hardcode_shlibpath_var" != yes; then - # We cannot hardcode anything. - hardcode_action=unsupported -else - # We can only hardcode existing directories. - hardcode_action=relink -fi -echo "$ac_t$hardcode_action" 1>&6 -test "$hardcode_action" = unsupported && can_build_shared=no - - -reload_flag= -reload_cmds='$LD$reload_flag -o $output$reload_objs' -echo $ac_n "checking for $LD option to reload object files... $ac_c" 1>&6 -# PORTME Some linker may need a different reload flag. -reload_flag='-r' -echo "$ac_t$reload_flag" -test -n "$reload_flag" && reload_flag=" $reload_flag" - -# PORTME Fill in your ld.so characteristics -library_names_spec= -libname_spec='lib$name' -soname_spec= -postinstall_cmds= -postuninstall_cmds= -finish_cmds= -finish_eval= -shlibpath_var= -version_type=none -dynamic_linker="$host_os ld.so" - -echo $ac_n "checking dynamic linker characteristics... $ac_c" 1>&6 -case "$host_os" in -aix3* | aix4*) - version_type=linux - library_names_spec='${libname}${release}.so.$versuffix $libname.a' - shlibpath_var=LIBPATH - - # AIX has no versioning support, so we append a major version to the name. - soname_spec='${libname}${release}.so.$major' - ;; - -amigaos*) - library_names_spec='$libname.ixlibrary $libname.a' - # Create ${libname}_ixlibrary.a entries in /sys/libs. - finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`$echo "X$lib" | $Xsed -e '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; test $rm /sys/libs/${libname}_ixlibrary.a; $show "(cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a)"; (cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a) || exit 1; done' - ;; - -freebsd2* | freebsd3*) - version_type=sunos - library_names_spec='${libname}${release}.so.$versuffix $libname.so' - finish_cmds='PATH="$PATH:/sbin" ldconfig -m $libdir' - shlibpath_var=LD_LIBRARY_PATH - ;; - -gnu*) - version_type=sunos - library_names_spec='${libname}${release}.so.$versuffix' - shlibpath_var=LD_LIBRARY_PATH - ;; - -hpux9* | hpux10*) - # Give a soname corresponding to the major version so that dld.sl refuses to - # link against other versions. - dynamic_linker="$host_os dld.sl" - version_type=sunos - shlibpath_var=SHLIB_PATH - library_names_spec='${libname}${release}.sl.$versuffix ${libname}${release}.sl.$major $libname.sl' - soname_spec='${libname}${release}.sl.$major' - # HP-UX runs *really* slowly unless shared libraries are mode 555. - postinstall_cmds='chmod 555 $lib' - ;; - -irix5* | irix6*) - version_type=osf - soname_spec='${libname}${release}.so' - library_names_spec='${libname}${release}.so.$versuffix $libname.so' - shlibpath_var=LD_LIBRARY_PATH - ;; - -# No shared lib support for Linux oldld, aout, or coff. -linux-gnuoldld* | linux-gnuaout* | linux-gnucoff*) - dynamic_linker=no - ;; - -# This must be Linux ELF. -linux-gnu*) - version_type=linux - library_names_spec='${libname}${release}.so.$versuffix ${libname}${release}.so.$major $libname.so' - soname_spec='${libname}${release}.so.$major' - finish_cmds='PATH="$PATH:/sbin" ldconfig -n $libdir' - shlibpath_var=LD_LIBRARY_PATH - - if test -f /lib/ld.so.1; then - dynamic_linker='GNU ld.so' - else - # Only the GNU ld.so supports shared libraries on MkLinux. - case "$host_cpu" in - powerpc*) dynamic_linker=no ;; - *) dynamic_linker='Linux ld.so' ;; - esac - fi - ;; - -netbsd* | openbsd*) - version_type=sunos - library_names_spec='${libname}${release}.so.$versuffix' - finish_cmds='PATH="$PATH:/sbin" ldconfig -m $libdir' - shlibpath_var=LD_LIBRARY_PATH - ;; - -os2*) - libname_spec='$name' - library_names_spec='$libname.dll $libname.a' - dynamic_linker='OS/2 ld.exe' - shlibpath_var=LIBPATH - ;; - -osf3* | osf4*) - version_type=osf - soname_spec='${libname}${release}.so' - library_names_spec='${libname}${release}.so.$versuffix $libname.so' - shlibpath_var=LD_LIBRARY_PATH - ;; - -sco3.2v5*) - version_type=osf - soname_spec='${libname}${release}.so.$major' - library_names_spec='${libname}${release}.so.$versuffix ${libname}${release}.so.$major $libname.so' - shlibpath_var=LD_LIBRARY_PATH - ;; - -solaris2*) - version_type=linux - library_names_spec='${libname}${release}.so.$versuffix ${libname}${release}.so.$major $libname.so' - soname_spec='${libname}${release}.so.$major' - shlibpath_var=LD_LIBRARY_PATH - ;; - -sunos4*) - version_type=sunos - library_names_spec='${libname}${release}.so.$versuffix' - finish_cmds='PATH="$PATH:/usr/etc" ldconfig $libdir' - shlibpath_var=LD_LIBRARY_PATH - ;; - -sysv4.2uw2*) - version_type=linux - library_names_spec='${libname}${release}.so.$versuffix ${libname}${release}.so.$major $libname.so' - soname_spec='${libname}${release}.so.$major' - shlibpath_var=LD_LIBRARY_PATH - ;; - -uts4*) - version_type=linux - library_names_spec='${libname}${release}.so.$versuffix ${libname}${release}.so.$major $libname.so' - soname_spec='${libname}${release}.so.$major' - shlibpath_var=LD_LIBRARY_PATH - ;; - -*) - dynamic_linker=no - ;; -esac -echo "$ac_t$dynamic_linker" -test "$dynamic_linker" = no && can_build_shared=no - -# Report the final consequences. -echo "checking if libtool supports shared libraries... $can_build_shared" 1>&6 - -echo $ac_n "checking whether to build shared libraries... $ac_c" 1>&6 -test "$can_build_shared" = "no" && enable_shared=no - -# On AIX, shared libraries and static libraries use the same namespace, and -# are all built from PIC. -case "$host_os" in -aix*) - test "$enable_shared" = yes && enable_static=no - if test -n "$RANLIB"; then - archive_cmds="$archive_cmds;\$RANLIB \$lib" - postinstall_cmds='$RANLIB $lib' - fi - ;; -esac - -echo "$ac_t$enable_shared" 1>&6 - -# Make sure either enable_shared or enable_static is yes. -test "$enable_shared" = yes || enable_static=yes - -echo "checking whether to build static libraries... $enable_static" 1>&6 - -echo $ac_n "checking for objdir... $ac_c" 1>&6 -rm -f .libs 2>/dev/null -mkdir .libs 2>/dev/null -if test -d .libs; then - objdir=.libs -else - # MS-DOS does not allow filenames that begin with a dot. - objdir=_libs -fi -rmdir .libs 2>/dev/null -echo "$ac_t$objdir" 1>&6 - -# Copy echo and quote the copy, instead of the original, because it is -# used later. -ltecho="$echo" - -# Now quote all the things that may contain metacharacters. -for var in ltecho old_CC old_CFLAGS old_CPPFLAGS old_LD old_NM old_RANLIB \ - old_LN_S AR CC LD LN_S NM reload_flag reload_cmds wl pic_flag \ - link_static_flag no_builtin_flag export_dynamic_flag_spec \ - libname_spec library_names_spec soname_spec RANLIB \ - old_archive_cmds old_archive_from_new_cmds old_postinstall_cmds \ - old_postuninstall_cmds archive_cmds postinstall_cmds postuninstall_cmds \ - allow_undefined_flag no_undefined_flag \ - finish_cmds finish_eval global_symbol_pipe \ - hardcode_libdir_flag_spec hardcode_libdir_separator; do - - case "$var" in - reload_cmds | old_archive_cmds | old_archive_from_new_cmds | \ - old_postinstall_cmds | old_postuninstall_cmds | archive_cmds | \ - postinstall_cmds | postuninstall_cmds | finish_cmds) - # Double-quote double-evaled strings. - eval "$var=\`\$echo \"X\$$var\" | \$Xsed -e \"\$double_quote_subst\" -e \"\$sed_quote_subst\"\`" - ;; - *) - eval "$var=\`\$echo \"X\$$var\" | \$Xsed -e \"\$sed_quote_subst\"\`" - ;; - esac -done - -ofile=libtool -trap "$rm $ofile; exit 1" 1 2 15 -echo creating $ofile -$rm $ofile -cat <<EOF > $ofile -#! /bin/sh - -# libtool - Provide generalized library-building support services. -# Generated automatically by $PROGRAM - GNU $PACKAGE $VERSION -# NOTE: Changes made to this file will be lost: look at ltconfig or ltmain.sh. -# -# Copyright (C) 1996-1998 Free Software Foundation, Inc. -# Gordon Matzigkeit <gord@gnu.ai.mit.edu>, 1996 -# -# 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 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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. - -# This program was configured as follows, -# on host `(hostname || uname -n) 2>/dev/null | sed 1q`: -# -# CC="$old_CC" CFLAGS="$old_CFLAGS" CPPFLAGS="$old_CPPFLAGS" \\ -# LD="$old_LD" NM="$old_NM" RANLIB="$old_RANLIB" LN_S="$old_LN_S" \\ -# $0$ltconfig_args -# -# Compiler and other test output produced by $progname, useful for -# debugging $progname, is in ./config.log if it exists. - -# Sed that helps us avoid accidentally triggering echo(1) options like -n. -Xsed="sed -e s/^X//" - -# The HP-UX ksh and POSIX shell print the target directory to stdout -# if CDPATH is set. -if test "\${CDPATH+set}" = set; then CDPATH=; export CDPATH; fi - -# An echo program that does not interpret backslashes. -echo="$ltecho" - -# The version of $progname that generated this script. -LTCONFIG_VERSION="$VERSION" - -# Shell to use when invoking shell scripts. -SHELL=${CONFIG_SHELL-/bin/sh} - -# Whether or not to build libtool libraries. -build_libtool_libs=$enable_shared - -# Whether or not to build old-style libraries. -build_old_libs=$enable_static - -# The host system. -host_alias="$host_alias" -host="$host" - -# The archiver. -AR="$AR" - -# The default C compiler. -CC="$CC" - -# The linker used to build libraries. -LD="$LD" - -# Whether we need hard or soft links. -LN_S="$LN_S" - -# A BSD-compatible nm program. -NM="$NM" - -# The name of the directory that contains temporary libtool files. -objdir="$objdir" - -# How to create reloadable object files. -reload_flag="$reload_flag" -reload_cmds="$reload_cmds" - -# How to pass a linker flag through the compiler. -wl="$wl" - -# Additional compiler flags for building library objects. -pic_flag="$pic_flag" - -# Compiler flag to prevent dynamic linking. -link_static_flag="$link_static_flag" - -# Compiler flag to turn off builtin functions. -no_builtin_flag="$no_builtin_flag" - -# Compiler flag to allow reflexive dlopens. -export_dynamic_flag_spec="$export_dynamic_flag_spec" - -# Library versioning type. -version_type=$version_type - -# Format of library name prefix. -libname_spec="$libname_spec" - -# List of archive names. First name is the real one, the rest are links. -# The last name is the one that the linker finds with -lNAME. -library_names_spec="$library_names_spec" - -# The coded name of the library, if different from the real name. -soname_spec="$soname_spec" - -# Commands used to build and install an old-style archive. -RANLIB="$RANLIB" -old_archive_cmds="$old_archive_cmds" -old_postinstall_cmds="$old_postinstall_cmds" -old_postuninstall_cmds="$old_postuninstall_cmds" - -# Create an old-style archive from a shared archive. -old_archive_from_new_cmds="$old_archive_from_new_cmds" - -# Commands used to build and install a shared archive. -archive_cmds="$archive_cmds" -postinstall_cmds="$postinstall_cmds" -postuninstall_cmds="$postuninstall_cmds" - -# Flag that allows shared libraries with undefined symbols to be built. -allow_undefined_flag="$allow_undefined_flag" - -# Flag that forces no undefined symbols. -no_undefined_flag="$no_undefined_flag" - -# Commands used to finish a libtool library installation in a directory. -finish_cmds="$finish_cmds" - -# Same as above, but a single script fragment to be evaled but not shown. -finish_eval="$finish_eval" - -# Take the output of nm and produce a listing of raw symbols and C names. -global_symbol_pipe="$global_symbol_pipe" - -# This is the shared library runtime path variable. -runpath_var=$runpath_var - -# This is the shared library path variable. -shlibpath_var=$shlibpath_var - -# How to hardcode a shared library path into an executable. -hardcode_action=$hardcode_action - -# Flag to hardcode \$libdir into a binary during linking. -# This must work even if \$libdir does not exist. -hardcode_libdir_flag_spec="$hardcode_libdir_flag_spec" - -# Whether we need a single -rpath flag with a separated argument. -hardcode_libdir_separator="$hardcode_libdir_separator" - -# Set to yes if using DIR/libNAME.so during linking hardcodes DIR into the -# resulting binary. -hardcode_direct=$hardcode_direct - -# Set to yes if using the -LDIR flag during linking hardcodes DIR into the -# resulting binary. -hardcode_minus_L=$hardcode_minus_L - -# Set to yes if using SHLIBPATH_VAR=DIR during linking hardcodes DIR into -# the resulting binary. -hardcode_shlibpath_var=$hardcode_shlibpath_var - -EOF - -case "$host_os" in -aix3*) - cat <<\EOF >> $ofile -# AIX sometimes has problems with the GCC collect2 program. For some -# reason, if we set the COLLECT_NAMES environment variable, the problems -# vanish in a puff of smoke. -if test "${COLLECT_NAMES+set}" != set; then - COLLECT_NAMES= - export COLLECT_NAMES -fi - -EOF - ;; -esac - -# Append the ltmain.sh script. -cat "$ltmain" >> $ofile || (rm -f $ofile; exit 1) - -chmod +x $ofile -exit 0 - -# Local Variables: -# mode:shell-script -# sh-indentation:2 -# End: diff --git a/ltmain.sh b/ltmain.sh deleted file mode 100644 index e9350b3fa..000000000 --- a/ltmain.sh +++ /dev/null @@ -1,2453 +0,0 @@ -# ltmain.sh - Provide generalized library-building support services. -# NOTE: Changing this file will not affect anything until you rerun ltconfig. -# -# Copyright (C) 1996-1998 Free Software Foundation, Inc. -# Gordon Matzigkeit <gord@gnu.ai.mit.edu>, 1996 -# -# 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 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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. - -# The name of this program. -progname=`$echo "$0" | sed 's%^.*/%%'` -modename="$progname" - -# Constants. -PROGRAM=ltmain.sh -PACKAGE=libtool -VERSION=1.2 - -default_mode= -help="Try \`$progname --help' for more information." -magic="%%%MAGIC variable%%%" -mkdir="mkdir" -mv="mv -f" -rm="rm -f" - -# Sed substitution that helps us do robust quoting. It backslashifies -# metacharacters that are still active within double-quoted strings. -Xsed='sed -e s/^X//' -sed_quote_subst='s/\([\\`\\"$\\\\]\)/\\\1/g' - -# NLS nuisances. -# Only set LANG and LC_ALL to C if already set. -# These must not be set unconditionally because not all systems understand -# e.g. LANG=C (notably SCO). -if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi -if test "${LANG+set}" = set; then LANG=C; export LANG; fi - -if test "$LTCONFIG_VERSION" != "$VERSION"; then - echo "$modename: ltconfig version \`$LTCONFIG_VERSION' does not match $PROGRAM version \`$VERSION'" 1>&2 - echo "Fatal configuration error. See the $PACKAGE docs for more information." 1>&2 - exit 1 -fi - -if test "$build_libtool_libs" != yes && test "$build_old_libs" != yes; then - echo "$modename: not configured to build any kind of library" 1>&2 - echo "Fatal configuration error. See the $PACKAGE docs for more information." 1>&2 - exit 1 -fi - -# Global variables. -mode=$default_mode -nonopt= -prev= -prevopt= -run= -show="$echo" -show_help= -execute_dlfiles= - -# Parse our command line options once, thoroughly. -while test $# -gt 0 -do - arg="$1" - shift - - case "$arg" in - -*=*) optarg=`$echo "X$arg" | $Xsed -e 's/[-_a-zA-Z0-9]*=//'` ;; - *) optarg= ;; - esac - - # If the previous option needs an argument, assign it. - if test -n "$prev"; then - case "$prev" in - execute_dlfiles) - eval "$prev=\"\$$prev \$arg\"" - ;; - *) - eval "$prev=\$arg" - ;; - esac - - prev= - prevopt= - continue - fi - - # Have we seen a non-optional argument yet? - case "$arg" in - --help) - show_help=yes - ;; - - --version) - echo "$PROGRAM (GNU $PACKAGE) $VERSION" - exit 0 - ;; - - --dry-run | -n) - run=: - ;; - - --features) - echo "host: $host" - if test "$build_libtool_libs" = yes; then - echo "enable shared libraries" - else - echo "disable shared libraries" - fi - if test "$build_old_libs" = yes; then - echo "enable static libraries" - else - echo "disable static libraries" - fi - exit 0 - ;; - - --finish) mode="finish" ;; - - --mode) prevopt="--mode" prev=mode ;; - --mode=*) mode="$optarg" ;; - - --quiet | --silent) - show=: - ;; - - -dlopen) - prevopt="-dlopen" - prev=execute_dlfiles - ;; - - -*) - $echo "$modename: unrecognized option \`$arg'" 1>&2 - $echo "$help" 1>&2 - exit 1 - ;; - - *) - nonopt="$arg" - break - ;; - esac -done - -if test -n "$prevopt"; then - $echo "$modename: option \`$prevopt' requires an argument" 1>&2 - $echo "$help" 1>&2 - exit 1 -fi - -if test -z "$show_help"; then - - # Infer the operation mode. - if test -z "$mode"; then - case "$nonopt" in - *cc | *++ | gcc* | *-gcc*) - mode=link - for arg - do - case "$arg" in - -c) - mode=compile - break - ;; - esac - done - ;; - *db | *dbx) - mode=execute - ;; - *install*|cp|mv) - mode=install - ;; - *rm) - mode=uninstall - ;; - *) - # If we have no mode, but dlfiles were specified, then do execute mode. - test -n "$execute_dlfiles" && mode=execute - - # Just use the default operation mode. - if test -z "$mode"; then - if test -n "$nonopt"; then - $echo "$modename: warning: cannot infer operation mode from \`$nonopt'" 1>&2 - else - $echo "$modename: warning: cannot infer operation mode without MODE-ARGS" 1>&2 - fi - fi - ;; - esac - fi - - # Only execute mode is allowed to have -dlopen flags. - if test -n "$execute_dlfiles" && test "$mode" != execute; then - $echo "$modename: unrecognized option \`-dlopen'" 1>&2 - $echo "$help" 1>&2 - exit 1 - fi - - # Change the help message to a mode-specific one. - generic_help="$help" - help="Try \`$modename --help --mode=$mode' for more information." - - # These modes are in order of execution frequency so that they run quickly. - case "$mode" in - # libtool compile mode - compile) - modename="$modename: compile" - # Get the compilation command and the source file. - base_compile= - lastarg= - srcfile="$nonopt" - suppress_output= - - for arg - do - # Accept any command-line options. - case "$arg" in - -o) - $echo "$modename: you cannot specify the output filename with \`-o'" 1>&2 - $echo "$help" 1>&2 - exit 1 - ;; - - -static) - build_libtool_libs=no - build_old_libs=yes - continue - ;; - esac - - # Accept the current argument as the source file. - lastarg="$srcfile" - srcfile="$arg" - - # Aesthetically quote the previous argument. - - # Backslashify any backslashes, double quotes, and dollar signs. - # These are the only characters that are still specially - # interpreted inside of double-quoted scrings. - lastarg=`$echo "X$lastarg" | $Xsed -e "$sed_quote_subst"` - - # Double-quote args containing other shell metacharacters. - # Many Bourne shells cannot handle close brackets correctly in scan - # sets, so we specify it separately. - case "$lastarg" in - *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*) - lastarg="\"$lastarg\"" - ;; - esac - - # Add the previous argument to base_compile. - if test -z "$base_compile"; then - base_compile="$lastarg" - else - base_compile="$base_compile $lastarg" - fi - done - - # Get the name of the library object. - libobj=`$echo "X$srcfile" | $Xsed -e 's%^.*/%%'` - - # Recognize several different file suffixes. - xform='[cCFSfms]' - case "$libobj" in - *.ada) xform=ada ;; - *.adb) xform=adb ;; - *.ads) xform=ads ;; - *.asm) xform=asm ;; - *.c++) xform=c++ ;; - *.cc) xform=cc ;; - *.cpp) xform=cpp ;; - *.cxx) xform=cxx ;; - *.f90) xform=f90 ;; - *.for) xform=for ;; - esac - - libobj=`$echo "X$libobj" | $Xsed -e "s/\.$xform$/.lo/"` - - case "$libobj" in - *.lo) obj=`$echo "X$libobj" | $Xsed -e 's/\.lo$/.o/'` ;; - *) - $echo "$modename: cannot determine name of library object from \`$srcfile'" 1>&2 - exit 1 - ;; - esac - - if test -z "$base_compile"; then - $echo "$modename: you must specify a compilation command" 1>&2 - $echo "$help" 1>&2 - exit 1 - fi - - # Delete any leftover library objects. - if test "$build_old_libs" = yes; then - $run $rm $obj $libobj - trap "$run $rm $obj $libobj; exit 1" 1 2 15 - else - $run $rm $libobj - trap "$run $rm $libobj; exit 1" 1 2 15 - fi - - # Only build a PIC object if we are building libtool libraries. - if test "$build_libtool_libs" = yes; then - # Without this assignment, base_compile gets emptied. - fbsd_hideous_sh_bug=$base_compile - - # All platforms use -DPIC, to notify preprocessed assembler code. - $show "$base_compile$pic_flag -DPIC $srcfile" - if $run eval "$base_compile\$pic_flag -DPIC \$srcfile"; then : - else - test -n "$obj" && $run $rm $obj - exit 1 - fi - - # If we have no pic_flag, then copy the object into place and finish. - if test -z "$pic_flag"; then - $show "$LN_S $obj $libobj" - $run $LN_S $obj $libobj - exit $? - fi - - # Just move the object, then go on to compile the next one - $show "$mv $obj $libobj" - $run $mv $obj $libobj || exit 1 - - # Allow error messages only from the first compilation. - suppress_output=' >/dev/null 2>&1' - fi - - # Only build a position-dependent object if we build old libraries. - if test "$build_old_libs" = yes; then - # Suppress compiler output if we already did a PIC compilation. - $show "$base_compile $srcfile$suppress_output" - if $run eval "$base_compile \$srcfile$suppress_output"; then : - else - $run $rm $obj $libobj - exit 1 - fi - fi - - # Create an invalid libtool object if no PIC, so that we do not - # accidentally link it into a program. - if test "$build_libtool_libs" != yes; then - $show "echo timestamp > $libobj" - $run eval "echo timestamp > \$libobj" || exit $? - fi - - exit 0 - ;; - - # libtool link mode - link) - modename="$modename: link" - CC="$nonopt" - allow_undefined=yes - compile_command="$CC" - finalize_command="$CC" - - compile_shlibpath= - finalize_shlibpath= - deplibs= - dlfiles= - dlprefiles= - export_dynamic=no - hardcode_libdirs= - libobjs= - link_against_libtool_libs= - ltlibs= - objs= - prev= - prevarg= - release= - rpath= - perm_rpath= - temp_rpath= - vinfo= - - # We need to know -static, to get the right output filenames. - for arg - do - case "$arg" in - -all-static | -static) - if test "X$arg" = "X-all-static" && test "$build_libtool_libs" = yes && test -z "$link_static_flag"; then - $echo "$modename: warning: complete static linking is impossible in this configuration" 1>&2 - fi - build_libtool_libs=no - build_old_libs=yes - break - ;; - esac - done - - # See if our shared archives depend on static archives. - test -n "$old_archive_from_new_cmds" && build_old_libs=yes - - # Go through the arguments, transforming them on the way. - for arg - do - # If the previous option needs an argument, assign it. - if test -n "$prev"; then - case "$prev" in - output) - compile_command="$compile_command @OUTPUT@" - finalize_command="$finalize_command @OUTPUT@" - ;; - esac - - case "$prev" in - dlfiles|dlprefiles) - case "$arg" in - *.la | *.lo) ;; # We handle these cases below. - *) - dlprefiles="$dlprefiles $arg" - test "$prev" = dlfiles && dlfiles="$dlfiles $arg" - prev= - ;; - esac - ;; - release) - release="-$arg" - prev= - continue - ;; - rpath) - rpath="$rpath $arg" - prev= - continue - ;; - *) - eval "$prev=\"\$arg\"" - prev= - continue - ;; - esac - fi - - prevarg="$arg" - - case "$arg" in - -all-static) - if test -n "$link_static_flag"; then - compile_command="$compile_command $link_static_flag" - finalize_command="$finalize_command $link_static_flag" - fi - continue - ;; - - -allow-undefined) - # FIXME: remove this flag sometime in the future. - $echo "$modename: \`-allow-undefined' is deprecated because it is the default" 1>&2 - continue - ;; - - -dlopen) - prev=dlfiles - continue - ;; - - -dlpreopen) - prev=dlprefiles - continue - ;; - - -export-dynamic) - if test "$export_dynamic" != yes; then - export_dynamic=yes - if test -n "$export_dynamic_flag_spec"; then - eval arg=\"$export_dynamic_flag_spec\" - else - arg= - fi - - # Add the symbol object into the linking commands. - compile_command="$compile_command @SYMFILE@" - finalize_command="$finalize_command @SYMFILE@" - fi - ;; - - -L*) - dir=`$echo "X$arg" | $Xsed -e 's%^-L\(.*\)$%\1%'` - case "$dir" in - /* | [A-Za-z]:\\*) - # Add the corresponding hardcode_libdir_flag, if it is not identical. - ;; - *) - $echo "$modename: \`-L$dir' cannot specify a relative directory" 1>&2 - exit 1 - ;; - esac - deplibs="$deplibs $arg" - ;; - - -l*) deplibs="$deplibs $arg" ;; - - -no-undefined) - allow_undefined=no - continue - ;; - - -o) prev=output ;; - - -release) - prev=release - continue - ;; - - -rpath) - prev=rpath - continue - ;; - - -static) - # If we have no pic_flag, then this is the same as -all-static. - if test -z "$pic_flag" && test -n "$link_static_flag"; then - compile_command="$compile_command $link_static_flag" - finalize_command="$finalize_command $link_static_flag" - fi - continue - ;; - - -version-info) - prev=vinfo - continue - ;; - - # Some other compiler flag. - -* | +*) - # Unknown arguments in both finalize_command and compile_command need - # to be aesthetically quoted because they are evaled later. - arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"` - case "$arg" in - *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*) - arg="\"$arg\"" - ;; - esac - ;; - - *.o | *.a) - # A standard object. - objs="$objs $arg" - ;; - - *.lo) - # A library object. - if test "$prev" = dlfiles; then - dlfiles="$dlfiles $arg" - if test "$build_libtool_libs" = yes; then - prev= - continue - else - # If libtool objects are unsupported, then we need to preload. - prev=dlprefiles - fi - fi - - if test "$prev" = dlprefiles; then - # Preload the old-style object. - dlprefiles="$dlprefiles "`$echo "X$arg" | $Xsed -e 's/\.lo$/\.o/'` - prev= - fi - libobjs="$libobjs $arg" - ;; - - *.la) - # A libtool-controlled library. - - dlname= - libdir= - library_names= - old_library= - - # Check to see that this really is a libtool archive. - if (sed -e '2q' $arg | egrep '^# Generated by ltmain\.sh') >/dev/null 2>&1; then : - else - $echo "$modename: \`$arg' is not a valid libtool archive" 1>&2 - exit 1 - fi - - # If there is no directory component, then add one. - case "$arg" in - */* | *\\*) . $arg ;; - *) . ./$arg ;; - esac - - if test -z "$libdir"; then - $echo "$modename: \`$arg' contains no -rpath information" 1>&2 - exit 1 - fi - - # Get the name of the library we link against. - linklib= - for l in $old_library $library_names; do - linklib="$l" - done - - if test -z "$linklib"; then - $echo "$modename: cannot find name of link library for \`$arg'" 1>&2 - exit 1 - fi - - # Find the relevant object directory and library name. - name=`$echo "X$arg" | $Xsed -e 's%^.*/%%' -e 's/\.la$//' -e 's/^lib//'` - dir=`$echo "X$arg" | $Xsed -e 's%/[^/]*$%%'` - if test "X$dir" = "X$arg"; then - dir="$objdir" - else - dir="$dir/$objdir" - fi - - # This library was specified with -dlopen. - if test "$prev" = dlfiles; then - dlfiles="$dlfiles $arg" - if test -z "$dlname"; then - # If there is no dlname, we need to preload. - prev=dlprefiles - else - # We should not create a dependency on this library, but we - # may need any libraries it requires. - compile_command="$compile_command$dependency_libs" - finalize_command="$finalize_command$dependency_libs" - prev= - continue - fi - fi - - # The library was specified with -dlpreopen. - if test "$prev" = dlprefiles; then - # Prefer using a static library (so that no silly _DYNAMIC symbols - # are required to link). - if test -n "$old_library"; then - dlprefiles="$dlprefiles $dir/$old_library" - else - dlprefiles="$dlprefiles $dir/$linklib" - fi - prev= - fi - - if test "$build_libtool_libs" = yes && test -n "$library_names"; then - link_against_libtool_libs="$link_against_libtool_libs $arg" - if test -n "$shlibpath_var"; then - # Make sure the rpath contains only unique directories. - case "$temp_rpath " in - *" $dir "*) ;; - *) temp_rpath="$temp_rpath $dir" ;; - esac - fi - - # This is the magic to use -rpath. - if test -n "$hardcode_libdir_flag_spec"; then - if test -n "$hardcode_libdir_separator"; then - if test -z "$hardcode_libdirs"; then - # Put the magic libdir with the hardcode flag. - hardcode_libdirs="$libdir" - libdir="@HARDCODE_LIBDIRS@" - else - # Just accumulate the unique libdirs. - case "$hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator" in - *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*) - ;; - *) - hardcode_libdirs="$hardcode_libdirs$hardcode_libdir_separator$libdir" - ;; - esac - libdir= - fi - fi - - if test -n "$libdir"; then - eval flag=\"$hardcode_libdir_flag_spec\" - - compile_command="$compile_command $flag" - finalize_command="$finalize_command $flag" - fi - elif test -n "$runpath_var"; then - # Do the same for the permanent run path. - case "$perm_rpath " in - *" $libdir "*) ;; - *) perm_rpath="$perm_rpath $libdir" ;; - esac - fi - - - case "$hardcode_action" in - immediate) - if test "$hardcode_direct" = no; then - compile_command="$compile_command $dir/$linklib" - elif test "$hardcode_minus_L" = no; then - compile_command="$compile_command -L$dir -l$name" - elif test "$hardcode_shlibpath_var" = no; then - compile_shlibpath="$compile_shlibpath$dir:" - compile_command="$compile_command -l$name" - fi - ;; - - relink) - # We need an absolute path. - case "$dir" in - /* | [A-Za-z]:\\*) ;; - *) - absdir=`cd "$dir" && pwd` - if test -z "$absdir"; then - $echo "$modename: cannot determine absolute directory name of \`$dir'" 1>&2 - exit 1 - fi - dir="$absdir" - ;; - esac - - if test "$hardcode_direct" = yes; then - compile_command="$compile_command $dir/$linklib" - elif test "$hardcode_minus_L" = yes; then - compile_command="$compile_command -L$dir -l$name" - elif test "$hardcode_shlibpath_var" = yes; then - compile_shlibpath="$compile_shlibpath$dir:" - compile_command="$compile_command -l$name" - fi - ;; - - *) - $echo "$modename: \`$hardcode_action' is an unknown hardcode action" 1>&2 - exit 1 - ;; - esac - - # Finalize command for both is simple: just hardcode it. - if test "$hardcode_direct" = yes; then - finalize_command="$finalize_command $libdir/$linklib" - elif test "$hardcode_minus_L" = yes; then - finalize_command="$finalize_command -L$libdir -l$name" - elif test "$hardcode_shlibpath_var" = yes; then - finalize_shlibpath="$finalize_shlibpath$libdir:" - finalize_command="$finalize_command -l$name" - else - # We cannot seem to hardcode it, guess we'll fake it. - finalize_command="$finalize_command -L$libdir -l$name" - fi - else - # Transform directly to old archives if we don't build new libraries. - if test -n "$pic_flag" && test -z "$old_library"; then - $echo "$modename: cannot find static library for \`$arg'" 1>&2 - exit 1 - fi - - # Here we assume that one of hardcode_direct or hardcode_minus_L - # is not unsupported. This is valid on all known static and - # shared platforms. - if test "$hardcode_direct" != unsupported; then - test -n "$old_library" && linklib="$old_library" - compile_command="$compile_command $dir/$linklib" - finalize_command="$finalize_command $dir/$linklib" - else - compile_command="$compile_command -L$dir -l$name" - finalize_command="$finalize_command -L$dir -l$name" - fi - fi - - # Add in any libraries that this one depends upon. - compile_command="$compile_command$dependency_libs" - finalize_command="$finalize_command$dependency_libs" - continue - ;; - - # Some other compiler argument. - *) - # Unknown arguments in both finalize_command and compile_command need - # to be aesthetically quoted because they are evaled later. - arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"` - case "$arg" in - *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*) - arg="\"$arg\"" - ;; - esac - ;; - esac - - # Now actually substitute the argument into the commands. - if test -n "$arg"; then - compile_command="$compile_command $arg" - finalize_command="$finalize_command $arg" - fi - done - - if test -n "$prev"; then - $echo "$modename: the \`$prevarg' option requires an argument" 1>&2 - $echo "$help" 1>&2 - exit 1 - fi - - if test -n "$vinfo" && test -n "$release"; then - $echo "$modename: you cannot specify both \`-version-info' and \`-release'" 1>&2 - $echo "$help" 1>&2 - exit 1 - fi - - oldlib= - oldobjs= - case "$output" in - "") - $echo "$modename: you must specify an output file" 1>&2 - $echo "$help" 1>&2 - exit 1 - ;; - - */* | *\\*) - $echo "$modename: output file \`$output' must have no directory components" 1>&2 - exit 1 - ;; - - *.a) - # Now set the variables for building old libraries. - build_libtool_libs=no - build_old_libs=yes - oldlib="$output" - $show "$rm $oldlib" - $run $rm $oldlib - ;; - - *.la) - # Make sure we only generate libraries of the form `libNAME.la'. - case "$output" in - lib*) ;; - *) - $echo "$modename: libtool library \`$arg' must begin with \`lib'" 1>&2 - $echo "$help" 1>&2 - exit 1 - ;; - esac - - name=`$echo "X$output" | $Xsed -e 's/\.la$//' -e 's/^lib//'` - eval libname=\"$libname_spec\" - - # All the library-specific variables (install_libdir is set above). - library_names= - old_library= - dlname= - current=0 - revision=0 - age=0 - - if test -n "$objs"; then - $echo "$modename: cannot build libtool library \`$output' from non-libtool objects:$objs" 2>&1 - exit 1 - fi - - # How the heck are we supposed to write a wrapper for a shared library? - if test -n "$link_against_libtool_libs"; then - $echo "$modename: libtool library \`$output' may not depend on uninstalled libraries:$link_against_libtool_libs" 1>&2 - exit 1 - fi - - if test -n "$dlfiles$dlprefiles"; then - $echo "$modename: warning: \`-dlopen' is ignored while creating libtool libraries" 1>&2 - # Nullify the symbol file. - compile_command=`$echo "X$compile_command" | $Xsed -e "s% @SYMFILE@%%"` - finalize_command=`$echo "X$finalize_command" | $Xsed -e "s% @SYMFILE@%%"` - fi - - if test -z "$rpath"; then - $echo "$modename: you must specify an installation directory with \`-rpath'" 1>&2 - $echo "$help" 1>&2 - exit 1 - fi - - set dummy $rpath - if test $# -gt 2; then - $echo "$modename: warning: ignoring multiple \`-rpath's for a libtool library" 1>&2 - fi - install_libdir="$2" - - # Parse the version information argument. - IFS="${IFS= }"; save_ifs="$IFS"; IFS=':' - set dummy $vinfo - IFS="$save_ifs" - - if test -n "$5"; then - $echo "$modename: too many parameters to \`-version-info'" 1>&2 - $echo "$help" 1>&2 - exit 1 - fi - - test -n "$2" && current="$2" - test -n "$3" && revision="$3" - test -n "$4" && age="$4" - - # Check that each of the things are valid numbers. - case "$current" in - 0 | [1-9] | [1-9][0-9]*) ;; - *) - $echo "$modename: CURRENT \`$current' is not a nonnegative integer" 1>&2 - $echo "$modename: \`$vinfo' is not valid version information" 1>&2 - exit 1 - ;; - esac - - case "$revision" in - 0 | [1-9] | [1-9][0-9]*) ;; - *) - $echo "$modename: REVISION \`$revision' is not a nonnegative integer" 1>&2 - $echo "$modename: \`$vinfo' is not valid version information" 1>&2 - exit 1 - ;; - esac - - case "$age" in - 0 | [1-9] | [1-9][0-9]*) ;; - *) - $echo "$modename: AGE \`$age' is not a nonnegative integer" 1>&2 - $echo "$modename: \`$vinfo' is not valid version information" 1>&2 - exit 1 - ;; - esac - - if test $age -gt $current; then - $echo "$modename: AGE \`$age' is greater than the current interface number \`$current'" 1>&2 - $echo "$modename: \`$vinfo' is not valid version information" 1>&2 - exit 1 - fi - - # Calculate the version variables. - version_vars="version_type current age revision" - case "$version_type" in - none) ;; - - linux) - version_vars="$version_vars major versuffix" - major=`expr $current - $age` - versuffix="$major.$age.$revision" - ;; - - osf) - version_vars="$version_vars versuffix verstring" - major=`expr $current - $age` - versuffix="$current.$age.$revision" - verstring="$versuffix" - - # Add in all the interfaces that we are compatible with. - loop=$age - while test $loop != 0; do - iface=`expr $current - $loop` - loop=`expr $loop - 1` - verstring="$verstring:${iface}.0" - done - - # Make executables depend on our current version. - verstring="$verstring:${current}.0" - ;; - - sunos) - version_vars="$version_vars major versuffix" - major="$current" - versuffix="$current.$revision" - ;; - - *) - $echo "$modename: unknown library version type \`$version_type'" 1>&2 - echo "Fatal configuration error. See the $PACKAGE docs for more information." 1>&2 - exit 1 - ;; - esac - - # Create the output directory, or remove our outputs if we need to. - if test -d $objdir; then - $show "$rm $objdir/$output $objdir/$libname.* $objdir/${libname}${release}.*" - $run $rm $objdir/$output $objdir/$libname.* $objdir/${libname}${release}.* - else - $show "$mkdir $objdir" - $run $mkdir $objdir - status=$? - if test $status -eq 0 || test -d $objdir; then : - else - exit $status - fi - fi - - # Check to see if the archive will have undefined symbols. - if test "$allow_undefined" = yes; then - if test "$allow_undefined_flag" = unsupported; then - $echo "$modename: warning: undefined symbols not allowed in $host shared libraries" 1>&2 - build_libtool_libs=no - build_old_libs=yes - fi - else - # Don't allow undefined symbols. - allow_undefined_flag="$no_undefined_flag" - fi - - # Add libc to deplibs on all systems. - dependency_libs="$deplibs" - deplibs="$deplibs -lc" - - if test "$build_libtool_libs" = yes; then - # Get the real and link names of the library. - eval library_names=\"$library_names_spec\" - set dummy $library_names - realname="$2" - shift; shift - - if test -n "$soname_spec"; then - eval soname=\"$soname_spec\" - else - soname="$realname" - fi - - lib="$objdir/$realname" - for link - do - linknames="$linknames $link" - done - - # Use standard objects if they are PIC. - test -z "$pic_flag" && libobjs=`$echo "X$libobjs " | $Xsed -e 's/\.lo /.o /g' -e 's/ $//g'` - - # Do each of the archive commands. - eval cmds=\"$archive_cmds\" - IFS="${IFS= }"; save_ifs="$IFS"; IFS=';' - for cmd in $cmds; do - IFS="$save_ifs" - $show "$cmd" - $run eval "$cmd" || exit $? - done - IFS="$save_ifs" - - # Create links to the real library. - for linkname in $linknames; do - $show "(cd $objdir && $LN_S $realname $linkname)" - $run eval '(cd $objdir && $LN_S $realname $linkname)' || exit $? - done - - # If -export-dynamic was specified, set the dlname. - if test "$export_dynamic" = yes; then - # On all known operating systems, these are identical. - dlname="$soname" - fi - fi - - # Now set the variables for building old libraries. - oldlib="$objdir/$libname.a" - ;; - - *.lo | *.o) - if test -n "$link_against_libtool_libs"; then - $echo "$modename: error: cannot link libtool libraries into reloadable objects" 1>&2 - exit 1 - fi - - if test -n "$deplibs"; then - $echo "$modename: warning: \`-l' and \`-L' are ignored while creating objects" 1>&2 - fi - - if test -n "$dlfiles$dlprefiles"; then - $echo "$modename: warning: \`-dlopen' is ignored while creating objects" 1>&2 - # Nullify the symbol file. - compile_command=`$echo "X$compile_command" | $Xsed -e "s% @SYMFILE@%%"` - finalize_command=`$echo "X$finalize_command" | $Xsed -e "s% @SYMFILE@%%"` - fi - - if test -n "$rpath"; then - $echo "$modename: warning: \`-rpath' is ignored while creating objects" 1>&2 - fi - - if test -n "$vinfo"; then - $echo "$modename: warning: \`-version-info' is ignored while creating objects" 1>&2 - fi - - if test -n "$release"; then - $echo "$modename: warning: \`-release' is ignored while creating objects" 1>&2 - fi - - case "$output" in - *.lo) - if test -n "$objs"; then - $echo "$modename: cannot build library object \`$output' from non-libtool objects" 1>&2 - exit 1 - fi - libobj="$output" - obj=`$echo "X$output" | $Xsed -e 's/\.lo$/.o/'` - ;; - *) - libobj= - obj="$output" - ;; - esac - - # Delete the old objects. - $run $rm $obj $libobj - - # Create the old-style object. - reload_objs="$objs"`$echo "X$libobjs " | $Xsed -e 's/[^ ]*\.a //g' -e 's/\.lo /.o /g' -e 's/ $//g'` - - output="$obj" - eval cmds=\"$reload_cmds\" - IFS="${IFS= }"; save_ifs="$IFS"; IFS=';' - for cmd in $cmds; do - IFS="$save_ifs" - $show "$cmd" - $run eval "$cmd" || exit $? - done - IFS="$save_ifs" - - # Exit if we aren't doing a library object file. - test -z "$libobj" && exit 0 - - if test "$build_libtool_libs" != yes; then - # Create an invalid libtool object if no PIC, so that we don't - # accidentally link it into a program. - $show "echo timestamp > $libobj" - $run eval "echo timestamp > $libobj" || exit $? - exit 0 - fi - - if test -n "$pic_flag"; then - # Only do commands if we really have different PIC objects. - reload_objs="$libobjs" - output="$libobj" - eval cmds=\"$reload_cmds\" - IFS="${IFS= }"; save_ifs="$IFS"; IFS=';' - for cmd in $cmds; do - IFS="$save_ifs" - $show "$cmd" - $run eval "$cmd" || exit $? - done - IFS="$save_ifs" - else - # Just create a symlink. - $show "$LN_S $obj $libobj" - $run $LN_S $obj $libobj || exit 1 - fi - - exit 0 - ;; - - *) - if test -n "$vinfo"; then - $echo "$modename: warning: \`-version-info' is ignored while linking programs" 1>&2 - fi - - if test -n "$release"; then - $echo "$modename: warning: \`-release' is ignored while creating objects" 1>&2 - fi - - if test -n "$rpath"; then - # If the user specified any rpath flags, then add them. - for libdir in $rpath; do - if test -n "$hardcode_libdir_flag_spec"; then - if test -n "$hardcode_libdir_separator"; then - if test -z "$hardcode_libdirs"; then - # Put the magic libdir with the hardcode flag. - hardcode_libdirs="$libdir" - libdir="@HARDCODE_LIBDIRS@" - else - # Just accumulate the unique libdirs. - case "$hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator" in - *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*) - ;; - *) - hardcode_libdirs="$hardcode_libdirs$hardcode_libdir_separator$libdir" - ;; - esac - libdir= - fi - fi - - if test -n "$libdir"; then - eval flag=\"$hardcode_libdir_flag_spec\" - - compile_command="$compile_command $flag" - finalize_command="$finalize_command $flag" - fi - elif test -n "$runpath_var"; then - case "$perm_rpath " in - *" $libdir "*) ;; - *) perm_rpath="$perm_rpath $libdir" ;; - esac - fi - done - fi - - # Substitute the hardcoded libdirs into the compile commands. - if test -n "$hardcode_libdir_separator"; then - compile_command=`$echo "X$compile_command" | $Xsed -e "s%@HARDCODE_LIBDIRS@%$hardcode_libdirs%g"` - finalize_command=`$echo "X$finalize_command" | $Xsed -e "s%@HARDCODE_LIBDIRS@%$hardcode_libdirs%g"` - fi - - if test -n "$libobjs" && test "$build_old_libs" = yes; then - # Transform all the library objects into standard objects. - compile_command=`$echo "X$compile_command " | $Xsed -e 's/\.lo /.o /g' -e 's/ $//'` - finalize_command=`$echo "X$finalize_command " | $Xsed -e 's/\.lo /.o /g' -e 's/ $//'` - fi - - if test "$export_dynamic" = yes && test -n "$NM" && test -n "$global_symbol_pipe"; then - dlsyms="${output}S.c" - else - dlsyms= - fi - - if test -n "$dlsyms"; then - # Add our own program objects to the preloaded list. - dlprefiles=`$echo "X$objs$dlprefiles " | $Xsed -e 's/\.lo /.o /g' -e 's/ $//'` - - # Discover the nlist of each of the dlfiles. - nlist="$objdir/${output}.nm" - - if test -d $objdir; then - $show "$rm $nlist ${nlist}T" - $run $rm "$nlist" "${nlist}T" - else - $show "$mkdir $objdir" - $run $mkdir $objdir - status=$? - if test $status -eq 0 || test -d $objdir; then : - else - exit $status - fi - fi - - for arg in $dlprefiles; do - $show "extracting global C symbols from \`$arg'" - $run eval "$NM $arg | $global_symbol_pipe >> '$nlist'" - done - - # Parse the name list into a source file. - $show "creating $objdir/$dlsyms" - if test -z "$run"; then - # Make sure we at least have an empty file. - test -f "$nlist" || : > "$nlist" - - # Try sorting and uniquifying the output. - if sort "$nlist" | uniq > "$nlist"T; then - mv -f "$nlist"T "$nlist" - wcout=`wc "$nlist" 2>/dev/null` - count=`echo "X$wcout" | $Xsed -e 's/^[ ]*\([0-9][0-9]*\).*$/\1/'` - (test "$count" -ge 0) 2>/dev/null || count=-1 - else - $rm "$nlist"T - count=-1 - fi - - case "$dlsyms" in - "") ;; - *.c) - $echo > "$objdir/$dlsyms" "\ -/* $dlsyms - symbol resolution table for \`$output' dlsym emulation. */ -/* Generated by $PROGRAM - GNU $PACKAGE $VERSION */ - -#ifdef __cplusplus -extern \"C\" { -#endif - -/* Prevent the only kind of declaration conflicts we can make. */ -#define dld_preloaded_symbol_count some_other_symbol -#define dld_preloaded_symbols some_other_symbol - -/* External symbol declarations for the compiler. */\ -" - - if test -f "$nlist"; then - sed -e 's/^.* \(.*\)$/extern char \1;/' < "$nlist" >> "$objdir/$dlsyms" - else - echo '/* NONE */' >> "$objdir/$dlsyms" - fi - - $echo >> "$objdir/$dlsyms" "\ - -#undef dld_preloaded_symbol_count -#undef dld_preloaded_symbols - -#if defined (__STDC__) && __STDC__ -# define __ptr_t void * -#else -# define __ptr_t char * -#endif - -/* The number of symbols in dld_preloaded_symbols, -1 if unsorted. */ -int dld_preloaded_symbol_count = $count; - -/* The mapping between symbol names and symbols. */ -struct { - char *name; - __ptr_t address; -} -dld_preloaded_symbols[] = -{\ -" - - if test -f "$nlist"; then - sed 's/^\(.*\) \(.*\)$/ {"\1", (__ptr_t) \&\2},/' < "$nlist" >> "$objdir/$dlsyms" - fi - - $echo >> "$objdir/$dlsyms" "\ - {0, (__ptr_t) 0} -}; - -#ifdef __cplusplus -} -#endif\ -" - ;; - - *) - $echo "$modename: unknown suffix for \`$dlsyms'" 1>&2 - exit 1 - ;; - esac - fi - - # Now compile the dynamic symbol file. - $show "(cd $objdir && $CC -c$no_builtin_flag \"$dlsyms\")" - $run eval '(cd $objdir && $CC -c$no_builtin_flag "$dlsyms")' || exit $? - - # Transform the symbol file into the correct name. - compile_command=`$echo "X$compile_command" | $Xsed -e "s%@SYMFILE@%$objdir/${output}S.o%"` - finalize_command=`$echo "X$finalize_command" | $Xsed -e "s%@SYMFILE@%$objdir/${output}S.o%"` - elif test "$export_dynamic" != yes; then - test -n "$dlfiles$dlprefiles" && $echo "$modename: warning: \`-dlopen' and \`-dlpreopen' are ignored without \`-export-dynamic'" 1>&2 - else - # We keep going just in case the user didn't refer to - # dld_preloaded_symbols. The linker will fail if global_symbol_pipe - # really was required. - $echo "$modename: not configured to extract global symbols from dlpreopened files" 1>&2 - - # Nullify the symbol file. - compile_command=`$echo "X$compile_command" | $Xsed -e "s% @SYMFILE@%%"` - finalize_command=`$echo "X$finalize_command" | $Xsed -e "s% @SYMFILE@%%"` - fi - - if test -z "$link_against_libtool_libs" || test "$build_libtool_libs" != yes; then - # Replace the output file specification. - compile_command=`$echo "X$compile_command" | $Xsed -e 's%@OUTPUT@%'"$output"'%g'` - finalize_command=`$echo "X$finalize_command" | $Xsed -e 's%@OUTPUT@%'"$output"'%g'` - - # We have no uninstalled library dependencies, so finalize right now. - $show "$compile_command" - $run eval "$compile_command" - exit $? - fi - - # Replace the output file specification. - compile_command=`$echo "X$compile_command" | $Xsed -e 's%@OUTPUT@%'"$objdir/$output"'%g'` - finalize_command=`$echo "X$finalize_command" | $Xsed -e 's%@OUTPUT@%'"$objdir/$output"'T%g'` - - # Create the binary in the object directory, then wrap it. - if test -d $objdir; then : - else - $show "$mkdir $objdir" - $run $mkdir $objdir - status=$? - if test $status -eq 0 || test -d $objdir; then : - else - exit $status - fi - fi - - if test -n "$shlibpath_var"; then - # We should set the shlibpath_var - rpath= - for dir in $temp_rpath; do - case "$dir" in - /* | [A-Za-z]:\\*) - # Absolute path. - rpath="$rpath$dir:" - ;; - *) - # Relative path: add a thisdir entry. - rpath="$rpath\$thisdir/$dir:" - ;; - esac - done - temp_rpath="$rpath" - fi - - # Delete the old output file. - $run $rm $output - - if test -n "$compile_shlibpath"; then - compile_command="$shlibpath_var=\"$compile_shlibpath\$$shlibpath_var\" $compile_command" - fi - if test -n "$finalize_shlibpath"; then - finalize_command="$shlibpath_var=\"$finalize_shlibpath\$$shlibpath_var\" $finalize_command" - fi - - if test -n "$runpath_var" && test -n "$perm_rpath"; then - # We should set the runpath_var. - rpath= - for dir in $perm_rpath; do - rpath="$rpath$dir:" - done - compile_command="$runpath_var=\"$rpath\$$runpath_var\" $compile_command" - finalize_command="$runpath_var=\"$rpath\$$runpath_var\" $finalize_command" - fi - - case "$hardcode_action" in - relink) - # AGH! Flame the AIX and HP-UX people for me, will ya? - $echo "$modename: warning: using a buggy system linker" 1>&2 - $echo "$modename: relinking will be required before \`$output' can be installed" 1>&2 - ;; - esac - - $show "$compile_command" - $run eval "$compile_command" || exit $? - - # Now create the wrapper script. - $show "creating $output" - - # Quote the finalize command for shipping. - finalize_command=`$echo "X$finalize_command" | $Xsed -e "$sed_quote_subst"` - - # Quote $echo for shipping. - qecho=`$echo "X$echo" | $Xsed -e "$sed_quote_subst"` - - # Only actually do things if our run command is non-null. - if test -z "$run"; then - $rm $output - trap "$rm $output; exit 1" 1 2 15 - - $echo > $output "\ -#! /bin/sh - -# $output - temporary wrapper script for $objdir/$output -# Generated by ltmain.sh - GNU $PACKAGE $VERSION -# -# The $output program cannot be directly executed until all the libtool -# libraries that it depends on are installed. -# -# This wrapper script should never be moved out of \``pwd`'. -# If it is, it will not operate correctly. - -# Sed substitution that helps us do robust quoting. It backslashifies -# metacharacters that are still active within double-quoted strings. -Xsed='sed -e s/^X//' -sed_quote_subst='$sed_quote_subst' - -# The HP-UX ksh and POSIX shell print the target directory to stdout -# if CDPATH is set. -if test \"\${CDPATH+set}\" = set; then CDPATH=; export CDPATH; fi - -# This environment variable determines our operation mode. -if test \"\$libtool_install_magic\" = \"$magic\"; then - # install mode needs the following variables: - link_against_libtool_libs='$link_against_libtool_libs' - finalize_command=\"$finalize_command\" -else - # When we are sourced in execute mode, \$file and \$echo are already set. - if test \"\$libtool_execute_magic\" = \"$magic\"; then : - else - echo=\"$qecho\" - file=\"\$0\" - fi\ -" - $echo >> $output "\ - - # Find the directory that this script lives in. - thisdir=\`\$echo \"X\$file\" | \$Xsed -e 's%/[^/]*$%%'\` - test \"x\$thisdir\" = \"x\$file\" && thisdir=. - - # Follow symbolic links until we get to the real thisdir. - file=\`ls -ld \"\$file\" | sed -n 's/.*-> //p'\` - while test -n \"\$file\"; do - destdir=\`\$echo \"X\$file\" | \$Xsed -e 's%/[^/]*\$%%'\` - - # If there was a directory component, then change thisdir. - if test \"x\$destdir\" != \"x\$file\"; then - case \"\$destdir\" in - /* | [A-Za-z]:\\*) thisdir=\"\$destdir\" ;; - *) thisdir=\"\$thisdir/\$destdir\" ;; - esac - fi - - file=\`\$echo \"X\$file\" | \$Xsed -e 's%^.*/%%'\` - file=\`ls -ld \"\$thisdir/\$file\" | sed -n 's/.*-> //p'\` - done - - # Try to get the absolute directory name. - absdir=\`cd \"\$thisdir\" && pwd\` - test -n \"\$absdir\" && thisdir=\"\$absdir\" - - progdir=\"\$thisdir/$objdir\" - program='$output' - - if test -f \"\$progdir/\$program\"; then" - - # Export our shlibpath_var if we have one. - if test -n "$shlibpath_var" && test -n "$temp_rpath"; then - $echo >> $output "\ - # Add our own library path to $shlibpath_var - $shlibpath_var=\"$temp_rpath\$$shlibpath_var\" - - # Some systems cannot cope with colon-terminated $shlibpath_var - $shlibpath_var=\`\$echo \"X\$$shlibpath_var\" | \$Xsed -e 's/:*\$//'\` - - export $shlibpath_var -" - fi - - $echo >> $output "\ - if test \"\$libtool_execute_magic\" != \"$magic\"; then - # Run the actual program with our arguments. - - # Export the path to the program. - PATH=\"\$progdir:\$PATH\" - export PATH - - exec \$program \${1+\"\$@\"} - - \$echo \"\$0: cannot exec \$program \${1+\"\$@\"}\" - exit 1 - fi - else - # The program doesn't exist. - \$echo \"\$0: error: \$progdir/\$program does not exist\" 1>&2 - \$echo \"This script is just a wrapper for \$program.\" 1>&2 - echo \"See the $PACKAGE documentation for more information.\" 1>&2 - exit 1 - fi -fi\ -" - chmod +x $output - fi - exit 0 - ;; - esac - - # See if we need to build an old-fashioned archive. - if test "$build_old_libs" = "yes"; then - # Transform .lo files to .o files. - oldobjs="$objs"`$echo "X$libobjs " | $Xsed -e 's/[^ ]*\.a //g' -e 's/\.lo /.o /g' -e 's/ $//g'` - - # Do each command in the archive commands. - if test -n "$old_archive_from_new_cmds" && test "$build_libtool_libs" = yes; then - eval cmds=\"$old_archive_from_new_cmds\" - else - eval cmds=\"$old_archive_cmds\" - fi - IFS="${IFS= }"; save_ifs="$IFS"; IFS=';' - for cmd in $cmds; do - IFS="$save_ifs" - $show "$cmd" - $run eval "$cmd" || exit $? - done - IFS="$save_ifs" - fi - - # Now create the libtool archive. - case "$output" in - *.la) - old_library= - test "$build_old_libs" = yes && old_library="$libname.a" - - $show "creating $output" - - # Only create the output if not a dry run. - if test -z "$run"; then - $echo > $output "\ -# $output - a libtool library file -# Generated by ltmain.sh - GNU $PACKAGE $VERSION - -# The name that we can dlopen(3). -dlname='$dlname' - -# Names of this library. -library_names='$library_names' - -# The name of the static archive. -old_library='$old_library' - -# Libraries that this one depends upon. -dependency_libs='$dependency_libs' - -# Version information for $libname. -current=$current -age=$age -revision=$revision - -# Directory that this library needs to be installed in: -libdir='$install_libdir'\ -" - fi - - # Do a symbolic link so that the libtool archive can be found in - # LD_LIBRARY_PATH before the program is installed. - $show "(cd $objdir && $LN_S ../$output $output)" - $run eval "(cd $objdir && $LN_S ../$output $output)" || exit 1 - ;; - esac - exit 0 - ;; - - # libtool install mode - install) - modename="$modename: install" - - # There may be an optional /bin/sh argument at the beginning of - # install_prog (especially on Windows NT). - if test "$nonopt" = "$SHELL"; then - # Aesthetically quote it. - arg=`$echo "X$nonopt" | $Xsed -e "$sed_quote_subst"` - case "$arg" in - *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*) - arg="\"$arg\"" - ;; - esac - install_prog="$arg " - arg="$1" - shift - else - install_prog= - arg="$nonopt" - fi - - # The real first argument should be the name of the installation program. - # Aesthetically quote it. - arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"` - case "$arg" in - *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*) - arg="\"$arg\"" - ;; - esac - install_prog="$install_prog$arg" - - # We need to accept at least all the BSD install flags. - dest= - files= - opts= - prev= - install_type= - isdir= - stripme= - for arg - do - if test -n "$dest"; then - files="$files $dest" - dest="$arg" - continue - fi - - case "$arg" in - -d) isdir=yes ;; - -f) prev="-f" ;; - -g) prev="-g" ;; - -m) prev="-m" ;; - -o) prev="-o" ;; - -s) - stripme=" -s" - continue - ;; - -*) ;; - - *) - # If the previous option needed an argument, then skip it. - if test -n "$prev"; then - prev= - else - dest="$arg" - continue - fi - ;; - esac - - # Aesthetically quote the argument. - arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"` - case "$arg" in - *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*) - arg="\"$arg\"" - ;; - esac - install_prog="$install_prog $arg" - done - - if test -z "$install_prog"; then - $echo "$modename: you must specify an install program" 1>&2 - $echo "$help" 1>&2 - exit 1 - fi - - if test -n "$prev"; then - $echo "$modename: the \`$prev' option requires an argument" 1>&2 - $echo "$help" 1>&2 - exit 1 - fi - - if test -z "$files"; then - if test -z "$dest"; then - $echo "$modename: no file or destination specified" 1>&2 - else - $echo "$modename: you must specify a destination" 1>&2 - fi - $echo "$help" 1>&2 - exit 1 - fi - - # Strip any trailing slash from the destination. - dest=`$echo "X$dest" | $Xsed -e 's%/$%%'` - - # Check to see that the destination is a directory. - test -d "$dest" && isdir=yes - if test -n "$isdir"; then - destdir="$dest" - destname= - else - destdir=`$echo "X$dest" | $Xsed -e 's%/[^/]*$%%'` - test "X$destdir" = "X$dest" && destdir=. - destname=`$echo "X$dest" | $Xsed -e 's%^.*/%%'` - - # Not a directory, so check to see that there is only one file specified. - set dummy $files - if test $# -gt 2; then - $echo "$modename: \`$dest' is not a directory" 1>&2 - $echo "$help" 1>&2 - exit 1 - fi - fi - case "$destdir" in - /* | [A-Za-z]:\\*) ;; - *) - for file in $files; do - case "$file" in - *.lo) ;; - *) - $echo "$modename: \`$destdir' must be an absolute directory name" 1>&2 - $echo "$help" 1>&2 - exit 1 - ;; - esac - done - ;; - esac - - # This variable tells wrapper scripts just to set variables rather - # than running their programs. - libtool_install_magic="$magic" - - staticlibs= - future_libdirs= - current_libdirs= - for file in $files; do - - # Do each installation. - case "$file" in - *.a) - # Do the static libraries later. - staticlibs="$staticlibs $file" - ;; - - *.la) - # Check to see that this really is a libtool archive. - if (sed -e '2q' $file | egrep '^# Generated by ltmain\.sh') >/dev/null 2>&1; then : - else - $echo "$modename: \`$file' is not a valid libtool archive" 1>&2 - $echo "$help" 1>&2 - exit 1 - fi - - library_names= - old_library= - # If there is no directory component, then add one. - case "$file" in - */* | *\\*) . $file ;; - *) . ./$file ;; - esac - - # Add the libdir to current_libdirs if it is the destination. - if test "X$destdir" = "X$libdir"; then - case "$current_libdirs " in - *" $libdir "*) ;; - *) current_libdirs="$current_libdirs $libdir" ;; - esac - else - # Note the libdir as a future libdir. - case "$future_libdirs " in - *" $libdir "*) ;; - *) future_libdirs="$future_libdirs $libdir" ;; - esac - fi - - dir="`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'`/" - test "X$dir" = "X$file/" && dir= - dir="$dir$objdir" - - # See the names of the shared library. - set dummy $library_names - if test -n "$2"; then - realname="$2" - shift - shift - - # Install the shared library and build the symlinks. - $show "$install_prog $dir/$realname $destdir/$realname" - $run eval "$install_prog $dir/$realname $destdir/$realname" || exit $? - test "X$dlname" = "X$realname" && dlname= - - if test $# -gt 0; then - # Delete the old symlinks. - rmcmd="$rm" - for linkname - do - rmcmd="$rmcmd $destdir/$linkname" - done - $show "$rmcmd" - $run $rmcmd - - # ... and create new ones. - for linkname - do - test "X$dlname" = "X$linkname" && dlname= - $show "(cd $destdir && $LN_S $realname $linkname)" - $run eval "(cd $destdir && $LN_S $realname $linkname)" - done - fi - - if test -n "$dlname"; then - # Install the dynamically-loadable library. - $show "$install_prog $dir/$dlname $destdir/$dlname" - $run eval "$install_prog $dir/$dlname $destdir/$dlname" || exit $? - fi - - # Do each command in the postinstall commands. - lib="$destdir/$realname" - eval cmds=\"$postinstall_cmds\" - IFS="${IFS= }"; save_ifs="$IFS"; IFS=';' - for cmd in $cmds; do - IFS="$save_ifs" - $show "$cmd" - $run eval "$cmd" || exit $? - done - IFS="$save_ifs" - fi - - # Install the pseudo-library for information purposes. - name=`$echo "X$file" | $Xsed -e 's%^.*/%%'` - $show "$install_prog $file $destdir/$name" - $run eval "$install_prog $file $destdir/$name" || exit $? - - # Maybe install the static library, too. - test -n "$old_library" && staticlibs="$staticlibs $dir/$old_library" - ;; - - *.lo) - # Install (i.e. copy) a libtool object. - - # Figure out destination file name, if it wasn't already specified. - if test -n "$destname"; then - destfile="$destdir/$destname" - else - destfile=`$echo "X$file" | $Xsed -e 's%^.*/%%'` - destfile="$destdir/$destfile" - fi - - # Deduce the name of the destination old-style object file. - case "$destfile" in - *.lo) - staticdest=`$echo "X$destfile" | $Xsed -e 's/\.lo$/\.o/'` - ;; - *.o) - staticdest="$destfile" - destfile= - ;; - *) - $echo "$modename: cannot copy a libtool object to \`$destfile'" 1>&2 - $echo "$help" 1>&2 - exit 1 - ;; - esac - - # Install the libtool object if requested. - if test -n "$destfile"; then - $show "$install_prog $file $destfile" - $run eval "$install_prog $file $destfile" || exit $? - fi - - # Install the old object if enabled. - if test "$build_old_libs" = yes; then - # Deduce the name of the old-style object file. - staticobj=`$echo "X$file" | $Xsed -e 's/\.lo$/\.o/'` - - $show "$install_prog $staticobj $staticdest" - $run eval "$install_prog \$staticobj \$staticdest" || exit $? - fi - exit 0 - ;; - - *) - # Do a test to see if this is really a libtool program. - if (sed -e '4q' $file | egrep '^# Generated by ltmain\.sh') >/dev/null 2>&1; then - link_against_libtool_libs= - finalize_command= - - # If there is no directory component, then add one. - case "$file" in - */* | *\\*) . $file ;; - *) . ./$file ;; - esac - - # Check the variables that should have been set. - if test -z "$link_against_libtool_libs" || test -z "$finalize_command"; then - $echo "$modename: invalid libtool wrapper script \`$file'" 1>&2 - exit 1 - fi - - finalize=yes - for lib in $link_against_libtool_libs; do - # Check to see that each library is installed. - libdir= - if test -f "$lib"; then - # If there is no directory component, then add one. - case "$lib" in - */* | *\\*) . $lib ;; - *) . ./$lib ;; - esac - fi - libfile="$libdir/`$echo "X$lib" | $Xsed -e 's%^.*/%%g'`" - if test -z "$libdir"; then - $echo "$modename: warning: \`$lib' contains no -rpath information" 1>&2 - elif test -f "$libfile"; then : - else - $echo "$modename: warning: \`$lib' has not been installed in \`$libdir'" 1>&2 - finalize=no - fi - done - - if test "$hardcode_action" = relink; then - if test "$finalize" = yes; then - $echo "$modename: warning: relinking \`$file' on behalf of your buggy system linker" 1>&2 - $show "$finalize_command" - if $run eval "$finalize_command"; then : - else - $echo "$modename: error: relink \`$file' with the above command before installing it" 1>&2 - continue - fi - file="$objdir/$file"T - else - $echo "$modename: warning: cannot relink \`$file' on behalf of your buggy system linker" 1>&2 - fi - else - # Install the binary that we compiled earlier. - file=`$echo "X$file" | $Xsed -e "s%\([^/]*\)$%$objdir/\1%"` - fi - fi - - $show "$install_prog$stripme $file $dest" - $run eval "$install_prog\$stripme \$file \$dest" || exit $? - ;; - esac - done - - for file in $staticlibs; do - name=`$echo "X$file" | $Xsed -e 's%^.*/%%'` - - # Set up the ranlib parameters. - oldlib="$destdir/$name" - - $show "$install_prog $file $oldlib" - $run eval "$install_prog \$file \$oldlib" || exit $? - - # Do each command in the postinstall commands. - eval cmds=\"$old_postinstall_cmds\" - IFS="${IFS= }"; save_ifs="$IFS"; IFS=';' - for cmd in $cmds; do - IFS="$save_ifs" - $show "$cmd" - $run eval "$cmd" || exit $? - done - IFS="$save_ifs" - done - - if test -n "$future_libdirs"; then - $echo "$modename: warning: remember to run \`$progname --finish$future_libdirs'" 1>&2 - fi - - if test -n "$current_libdirs"; then - # Maybe just do a dry run. - test -n "$run" && current_libdirs=" -n$current_libdirs" - exec $SHELL $0 --finish$current_libdirs - exit 1 - fi - - exit 0 - ;; - - # libtool finish mode - finish) - modename="$modename: finish" - libdirs="$nonopt" - - if test -n "$finish_cmds$finish_eval" && test -n "$libdirs"; then - for dir - do - libdirs="$libdirs $dir" - done - - for libdir in $libdirs; do - if test -n "$finish_cmds"; then - # Do each command in the finish commands. - eval cmds=\"$finish_cmds\" - IFS="${IFS= }"; save_ifs="$IFS"; IFS=';' - for cmd in $cmds; do - IFS="$save_ifs" - $show "$cmd" - $run eval "$cmd" - done - IFS="$save_ifs" - fi - if test -n "$finish_eval"; then - # Do the single finish_eval. - eval cmds=\"$finish_eval\" - $run eval "$cmds" - fi - done - fi - - echo "------------------------------------------------------------------------------" - echo "Libraries have been installed in:" - for libdir in $libdirs; do - echo " $libdir" - done - echo - echo "To link against installed libraries in a given directory, LIBDIR," - echo "you must use the \`-LLIBDIR' flag during linking." - echo - echo " You will also need to do one of the following:" - if test -n "$shlibpath_var"; then - echo " - add LIBDIR to the \`$shlibpath_var' environment variable" - echo " during execution" - fi - if test -n "$runpath_var"; then - echo " - add LIBDIR to the \`$runpath_var' environment variable" - echo " during linking" - fi - if test -n "$hardcode_libdir_flag_spec"; then - libdir=LIBDIR - eval flag=\"$hardcode_libdir_flag_spec\" - - echo " - use the \`$flag' linker flag" - fi - if test -f /etc/ld.so.conf; then - echo " - have your system administrator add LIBDIR to \`/etc/ld.so.conf'" - fi - echo - echo "See any operating system documentation about shared libraries for" - echo "more information, such as the ld(1) and ld.so(8) manual pages." - echo "------------------------------------------------------------------------------" - exit 0 - ;; - - # libtool execute mode - execute) - modename="$modename: execute" - - # The first argument is the command name. - cmd="$nonopt" - if test -z "$cmd"; then - $echo "$modename: you must specify a COMMAND" 1>&2 - $echo "$help" - exit 1 - fi - - # Handle -dlopen flags immediately. - for file in $execute_dlfiles; do - if test -f "$file"; then : - else - $echo "$modename: \`$file' is not a file" 1>&2 - $echo "$help" 1>&2 - exit 1 - fi - - dir= - case "$file" in - *.la) - # Check to see that this really is a libtool archive. - if (sed -e '2q' $file | egrep '^# Generated by ltmain\.sh') >/dev/null 2>&1; then : - else - $echo "$modename: \`$lib' is not a valid libtool archive" 1>&2 - $echo "$help" 1>&2 - exit 1 - fi - - # Read the libtool library. - dlname= - library_names= - - # If there is no directory component, then add one. - case "$file" in - */* | *\\*) . $file ;; - *) . ./$file ;; - esac - - # Skip this library if it cannot be dlopened. - if test -z "$dlname"; then - # Warn if it was a shared library. - test -n "$library_names" && $echo "$modename: warning: \`$file' was not linked with \`-export-dynamic'" - continue - fi - - dir=`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'` - test "X$dir" = "X$file" && dir=. - - if test -f "$dir/$objdir/$dlname"; then - dir="$dir/$objdir" - else - $echo "$modename: cannot find \`$dlname' in \`$dir' or \`$dir/$objdir'" 1>&2 - exit 1 - fi - ;; - - *.lo) - # Just add the directory containing the .lo file. - dir=`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'` - test "X$dir" = "X$file" && dir=. - ;; - - *) - $echo "$modename: warning \`-dlopen' is ignored for non-libtool libraries and objects" 1>&2 - continue - ;; - esac - - # Get the absolute pathname. - absdir=`cd "$dir" && pwd` - test -n "$absdir" && dir="$absdir" - - # Now add the directory to shlibpath_var. - if eval "test -z \"\$$shlibpath_var\""; then - eval "$shlibpath_var=\"\$dir\"" - else - eval "$shlibpath_var=\"\$dir:\$$shlibpath_var\"" - fi - done - - # This variable tells wrapper scripts just to set shlibpath_var - # rather than running their programs. - libtool_execute_magic="$magic" - - # Check if any of the arguments is a wrapper script. - args= - for file - do - case "$file" in - -*) ;; - *) - # Do a test to see if this is really a libtool program. - if (sed -e '4q' $file | egrep '^# Generated by ltmain\.sh') >/dev/null 2>&1; then - # If there is no directory component, then add one. - case "$file" in - */* | *\\*) . $file ;; - *) . ./$file ;; - esac - - # Transform arg to wrapped name. - file="$progdir/$program" - fi - ;; - esac - # Quote arguments (to preserve shell metacharacters). - file=`$echo "X$file" | $Xsed -e "$sed_quote_subst"` - args="$args \"$file\"" - done - - if test -z "$run"; then - # Export the shlibpath_var. - eval "export $shlibpath_var" - - # Now actually exec the command. - eval "exec \$cmd$args" - - $echo "$modename: cannot exec \$cmd$args" - exit 1 - else - # Display what would be done. - eval "\$echo \"\$shlibpath_var=\$$shlibpath_var\"" - $echo "export $shlibpath_var" - $echo "$cmd$args" - exit 0 - fi - ;; - - # libtool uninstall mode - uninstall) - modename="$modename: uninstall" - rm="$nonopt" - files= - - for arg - do - case "$arg" in - -*) rm="$rm $arg" ;; - *) files="$files $arg" ;; - esac - done - - if test -z "$rm"; then - $echo "$modename: you must specify an RM program" 1>&2 - $echo "$help" 1>&2 - exit 1 - fi - - for file in $files; do - dir=`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'` - test "X$dir" = "X$file" && dir=. - name=`$echo "X$file" | $Xsed -e 's%^.*/%%'` - - rmfiles="$file" - - case "$name" in - *.la) - # Possibly a libtool archive, so verify it. - if (sed -e '2q' $file | egrep '^# Generated by ltmain\.sh') >/dev/null 2>&1; then - . $dir/$name - - # Delete the libtool libraries and symlinks. - for n in $library_names; do - rmfiles="$rmfiles $dir/$n" - test "X$n" = "X$dlname" && dlname= - done - test -n "$dlname" && rmfiles="$rmfiles $dir/$dlname" - test -n "$old_library" && rmfiles="$rmfiles $dir/$old_library" - - $show "$rm $rmfiles" - $run $rm $rmfiles - - if test -n "$library_names"; then - # Do each command in the postuninstall commands. - eval cmds=\"$postuninstall_cmds\" - IFS="${IFS= }"; save_ifs="$IFS"; IFS=';' - for cmd in $cmds; do - IFS="$save_ifs" - $show "$cmd" - $run eval "$cmd" - done - IFS="$save_ifs" - fi - - if test -n "$old_library"; then - # Do each command in the old_postuninstall commands. - eval cmds=\"$old_postuninstall_cmds\" - IFS="${IFS= }"; save_ifs="$IFS"; IFS=';' - for cmd in $cmds; do - IFS="$save_ifs" - $show "$cmd" - $run eval "$cmd" - done - IFS="$save_ifs" - fi - - # FIXME: should reinstall the best remaining shared library. - fi - ;; - - *.lo) - if test "$build_old_libs" = yes; then - oldobj=`$echo "X$name" | $Xsed -e 's/\.lo$/\.o/'` - rmfiles="$rmfiles $dir/$oldobj" - fi - $show "$rm $rmfiles" - $run $rm $rmfiles - ;; - - *) - $show "$rm $rmfiles" - $run $rm $rmfiles - ;; - esac - done - exit 0 - ;; - - "") - $echo "$modename: you must specify a MODE" 1>&2 - $echo "$generic_help" 1>&2 - exit 1 - ;; - esac - - $echo "$modename: invalid operation mode \`$mode'" 1>&2 - $echo "$generic_help" 1>&2 - exit 1 -fi # test -z "$show_help" - -# We need to display help for each of the modes. -case "$mode" in -"") $echo \ -"Usage: $modename [OPTION]... [MODE-ARG]... - -Provide generalized library-building support services. - --n, --dry-run display commands without modifying any files - --features display configuration information and exit - --finish same as \`--mode=finish' - --help display this help message and exit - --mode=MODE use operation mode MODE [default=inferred from MODE-ARGS] - --quiet same as \`--silent' - --silent don't print informational messages - --version print version information - -MODE must be one of the following: - - compile compile a source file into a libtool object - execute automatically set library path, then run a program - finish complete the installation of libtool libraries - install install libraries or executables - link create a library or an executable - uninstall remove libraries from an installed directory - -MODE-ARGS vary depending on the MODE. Try \`$modename --help --mode=MODE' for -a more detailed description of MODE." - exit 0 - ;; - -compile) - $echo \ -"Usage: $modename [OPTION]... --mode=compile COMPILE-COMMAND... SOURCEFILE - -Compile a source file into a libtool library object. - -COMPILE-COMMAND is a command to be used in creating a \`standard' object file -from the given SOURCEFILE. - -The output file name is determined by removing the directory component from -SOURCEFILE, then substituting the C source code suffix \`.c' with the -library object suffix, \`.lo'." - ;; - -execute) - $echo \ -"Usage: $modename [OPTION]... --mode=execute COMMAND [ARGS]... - -Automatically set library path, then run a program. - -This mode accepts the following additional options: - - -dlopen FILE add the directory containing FILE to the library path - -This mode sets the library path environment variable according to \`-dlopen' -flags. - -If any of the ARGS are libtool executable wrappers, then they are translated -into their corresponding uninstalled binary, and any of their required library -directories are added to the library path. - -Then, COMMAND is executed, with ARGS as arguments." - ;; - -finish) - $echo \ -"Usage: $modename [OPTION]... --mode=finish [LIBDIR]... - -Complete the installation of libtool libraries. - -Each LIBDIR is a directory that contains libtool libraries. - -The commands that this mode executes may require superuser privileges. Use -the \`--dry-run' option if you just want to see what would be executed." - ;; - -install) - $echo \ -"Usage: $modename [OPTION]... --mode=install INSTALL-COMMAND... - -Install executables or libraries. - -INSTALL-COMMAND is the installation command. The first component should be -either the \`install' or \`cp' program. - -The rest of the components are interpreted as arguments to that command (only -BSD-compatible install options are recognized)." - ;; - -link) - $echo \ -"Usage: $modename [OPTION]... --mode=link LINK-COMMAND... - -Link object files or libraries together to form another library, or to -create an executable program. - -LINK-COMMAND is a command using the C compiler that you would use to create -a program from several object files. - -The following components of LINK-COMMAND are treated specially: - - -all-static do not do any dynamic linking at all - -dlopen FILE \`-dlpreopen' FILE if it cannot be dlopened at runtime - -dlpreopen FILE link in FILE and add its symbols to dld_preloaded_symbols - -export-dynamic allow symbols from OUTPUT-FILE to be resolved with dlsym(3) - -LLIBDIR search LIBDIR for required installed libraries - -lNAME OUTPUT-FILE requires the installed library libNAME - -no-undefined declare that a library does not refer to external symbols - -o OUTPUT-FILE create OUTPUT-FILE from the specified objects - -release RELEASE specify package release information - -rpath LIBDIR the created library will eventually be installed in LIBDIR - -static do not do any dynamic linking of libtool libraries - -version-info CURRENT[:REVISION[:AGE]] - specify library version info [each variable defaults to 0] - -All other options (arguments beginning with \`-') are ignored. - -Every other argument is treated as a filename. Files ending in \`.la' are -treated as uninstalled libtool libraries, other files are standard or library -object files. - -If the OUTPUT-FILE ends in \`.la', then a libtool library is created, only -library objects (\`.lo' files) may be specified, and \`-rpath' is required. - -If OUTPUT-FILE ends in \`.a', then a standard library is created using \`ar' -and \`ranlib'. - -If OUTPUT-FILE ends in \`.lo' or \`.o', then a reloadable object file is -created, otherwise an executable program is created." - ;; - -uninstall) - $echo -"Usage: $modename [OPTION]... --mode=uninstall RM [RM-OPTION]... FILE... - -Remove libraries from an installation directory. - -RM is the name of the program to use to delete files associated with each FILE -(typically \`/bin/rm'). RM-OPTIONS are options (such as \`-f') to be passed -to RM. - -If FILE is a libtool library, all the files associated with it are deleted. -Otherwise, only FILE itself is deleted using RM." - ;; - -*) - $echo "$modename: invalid operation mode \`$mode'" 1>&2 - $echo "$help" 1>&2 - exit 1 - ;; -esac - -echo -$echo "Try \`$modename --help' for more information about other modes." - -exit 0 - -# Local Variables: -# mode:shell-script -# sh-indentation:2 -# End: diff --git a/mdate-sh b/mdate-sh deleted file mode 100755 index e69de29bb..000000000 --- a/mdate-sh +++ /dev/null diff --git a/missing b/missing deleted file mode 100755 index cbe2b0ef0..000000000 --- a/missing +++ /dev/null @@ -1,188 +0,0 @@ -#! /bin/sh -# Common stub for a few missing GNU programs while installing. -# Copyright (C) 1996, 1997 Free Software Foundation, Inc. -# Franc,ois Pinard <pinard@iro.umontreal.ca>, 1996. - -# 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 program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -# 02111-1307, USA. - -if test $# -eq 0; then - echo 1>&2 "Try \`$0 --help' for more information" - exit 1 -fi - -case "$1" in - - -h|--h|--he|--hel|--help) - echo "\ -$0 [OPTION]... PROGRAM [ARGUMENT]... - -Handle \`PROGRAM [ARGUMENT]...' for when PROGRAM is missing, or return an -error status if there is no known handling for PROGRAM. - -Options: - -h, --help display this help and exit - -v, --version output version information and exit - -Supported PROGRAM values: - aclocal touch file \`aclocal.m4' - autoconf touch file \`configure' - autoheader touch file \`config.h.in' - automake touch all \`Makefile.in' files - bison create \`y.tab.[ch]', if possible, from existing .[ch] - flex create \`lex.yy.c', if possible, from existing .c - lex create \`lex.yy.c', if possible, from existing .c - makeinfo touch the output file - yacc create \`y.tab.[ch]', if possible, from existing .[ch]" - ;; - - -v|--v|--ve|--ver|--vers|--versi|--versio|--version) - echo "missing - GNU libit 0.0" - ;; - - -*) - echo 1>&2 "$0: Unknown \`$1' option" - echo 1>&2 "Try \`$0 --help' for more information" - exit 1 - ;; - - aclocal) - echo 1>&2 "\ -WARNING: \`$1' is missing on your system. You should only need it if - you modified \`acinclude.m4' or \`configure.in'. You might want - to install the \`Automake' and \`Perl' packages. Grab them from - any GNU archive site." - touch aclocal.m4 - ;; - - autoconf) - echo 1>&2 "\ -WARNING: \`$1' is missing on your system. You should only need it if - you modified \`configure.in'. You might want to install the - \`Autoconf' and \`GNU m4' packages. Grab them from any GNU - archive site." - touch configure - ;; - - autoheader) - echo 1>&2 "\ -WARNING: \`$1' is missing on your system. You should only need it if - you modified \`acconfig.h' or \`configure.in'. You might want - to install the \`Autoconf' and \`GNU m4' packages. Grab them - from any GNU archive site." - files=`sed -n 's/^[ ]*A[CM]_CONFIG_HEADER([^):]*:\([^)]*\)).*/\1/p' configure.in` - if test -z "$files"; then - files=`sed -n 's/^[ ]*A[CM]_CONFIG_HEADER(\([^):]*\)).*/\1/p' configure.in` - test -z "$files" || files="$files.in" - else - files=`echo "$files" | sed -e 's/:/ /g'` - fi - test -z "$files" && files="config.h.in" - touch $files - ;; - - automake) - echo 1>&2 "\ -WARNING: \`$1' is missing on your system. You should only need it if - you modified \`Makefile.am', \`acinclude.m4' or \`configure.in'. - You might want to install the \`Automake' and \`Perl' packages. - Grab them from any GNU archive site." - find . -type f -name Makefile.am -print \ - | sed 's/^\(.*\).am$/touch \1.in/' \ - | sh - ;; - - bison|yacc) - echo 1>&2 "\ -WARNING: \`$1' is missing on your system. You should only need it if - you modified a \`.y' file. You may need the \`Bison' package - in order for those modifications to take effect. You can get - \`Bison' from any GNU archive site." - rm -f y.tab.c y.tab.h - if [ $# -ne 1 ]; then - eval LASTARG="\${$#}" - case "$LASTARG" in - *.y) - SRCFILE=`echo "$LASTARG" | sed 's/y$/c/'` - if [ -f "$SRCFILE" ]; then - cp "$SRCFILE" y.tab.c - fi - SRCFILE=`echo "$LASTARG" | sed 's/y$/h/'` - if [ -f "$SRCFILE" ]; then - cp "$SRCFILE" y.tab.h - fi - ;; - esac - fi - if [ ! -f y.tab.h ]; then - echo >y.tab.h - fi - if [ ! -f y.tab.c ]; then - echo 'main() { return 0; }' >y.tab.c - fi - ;; - - lex|flex) - echo 1>&2 "\ -WARNING: \`$1' is missing on your system. You should only need it if - you modified a \`.l' file. You may need the \`Flex' package - in order for those modifications to take effect. You can get - \`Flex' from any GNU archive site." - rm -f lex.yy.c - if [ $# -ne 1 ]; then - eval LASTARG="\${$#}" - case "$LASTARG" in - *.l) - SRCFILE=`echo "$LASTARG" | sed 's/l$/c/'` - if [ -f "$SRCFILE" ]; then - cp "$SRCFILE" lex.yy.c - fi - ;; - esac - fi - if [ ! -f lex.yy.c ]; then - echo 'main() { return 0; }' >lex.yy.c - fi - ;; - - makeinfo) - echo 1>&2 "\ -WARNING: \`$1' is missing on your system. You should only need it if - you modified a \`.texi' or \`.texinfo' file, or any other file - indirectly affecting the aspect of the manual. The spurious - call might also be the consequence of using a buggy \`make' (AIX, - DU, IRIX). You might want to install the \`Texinfo' package or - the \`GNU make' package. Grab either from any GNU archive site." - file=`echo "$*" | sed -n 's/.*-o \([^ ]*\).*/\1/p'` - if test -z "$file"; then - file=`echo "$*" | sed 's/.* \([^ ]*\) *$/\1/'` - file=`sed -n '/^@setfilename/ { s/.* \([^ ]*\) *$/\1/; p; q; }' $file` - fi - touch $file - ;; - - *) - echo 1>&2 "\ -WARNING: \`$1' is needed, and you do not seem to have it handy on your - system. You might have modified some files without having the - proper tools for further handling them. Check the \`README' file, - it often tells you about the needed prerequirements for installing - this package. You may also peek at any GNU archive site, in case - some other package would contain this missing \`$1' program." - exit 1 - ;; -esac - -exit 0 diff --git a/mkinstalldirs b/mkinstalldirs deleted file mode 100755 index 31327258c..000000000 --- a/mkinstalldirs +++ /dev/null @@ -1,40 +0,0 @@ -#! /bin/sh -# mkinstalldirs --- make directory hierarchy -# Author: Noah Friedman <friedman@prep.ai.mit.edu> -# Created: 1993-05-16 -# Public domain - -# $Id: mkinstalldirs,v 1.2 1998-04-11 09:50:27 mdj Exp $ - -errstatus=0 - -for file -do - set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'` - shift - - pathcomp= - for d - do - pathcomp="$pathcomp$d" - case "$pathcomp" in - -* ) pathcomp=./$pathcomp ;; - esac - - if test ! -d "$pathcomp"; then - echo "mkdir $pathcomp" 1>&2 - - mkdir "$pathcomp" || lasterr=$? - - if test ! -d "$pathcomp"; then - errstatus=$lasterr - fi - fi - - pathcomp="$pathcomp/" - done -done - -exit $errstatus - -# mkinstalldirs ends here diff --git a/qt/.cvsignore b/qt/.cvsignore deleted file mode 100644 index 66558e414..000000000 --- a/qt/.cvsignore +++ /dev/null @@ -1,6 +0,0 @@ -.deps -.libs -Makefile -config.log -config.status -qt.h diff --git a/qt/CHANGES b/qt/CHANGES deleted file mode 100644 index 1b74921ee..000000000 --- a/qt/CHANGES +++ /dev/null @@ -1,15 +0,0 @@ -QuickThreads 002: Changes since QuickThreads 001. - - - Now can be used by C++ programs. - - Now *really* works with stacks that grow up. - - Supports AXP OSF 2.x cc's varargs. - - Supports HP Precision (HP-PA) on workstations and Convex. - - Supports assemblers for Intel iX86 ith only '//'-style comments. - - Supports Silicon Graphics Irix 5.x with dynamic linking. - - Supports System V and Solaris 2.x with no `_' on compiler-generated - identifiers; *some* platforms only. - -Note: not all "./config" arguments are compatible with QT 001. - - -QuickThreads 001: Base version. diff --git a/qt/ChangeLog b/qt/ChangeLog deleted file mode 100644 index 7c0f6887a..000000000 --- a/qt/ChangeLog +++ /dev/null @@ -1,190 +0,0 @@ -1998-10-03 Jim Blandy <jimb@zwingli.cygnus.com> - - * Makefile.in: Regenerated with a patched automake, to get - dependency generation right when using EGCS. - -1998-09-29 Jim Blandy <jimb@totoro.red-bean.com> - - * stp.h (stp_create): Doc fix. - -1998-07-30 Jim Blandy <jimb@zwingli.cygnus.com> - - * qt.h.in (qt_null, qt_error): Add prototypes for these. - -1998-07-29 Jim Blandy <jimb@zwingli.cygnus.com> - - * Makefile.in, md/Makefile.in, time/Makefile.in: Regenerated using - the last public version of automake, not the hacked Cygnus - version. - -1998-07-28 Jim Blandy <jimb@zwingli.cygnus.com> - - * time/Makefile.in, md/Makefile.in, Makefile.in: Regenerated, - after removing Totoro kludge. - -1998-07-26 Jim Blandy <jimb@zwingli.cygnus.com> - - Use libtool, and the thread configuration mechanism. - * Makefile.am (lib_LTLIBRARIES, EXTRA_LTLIBRARIES, - libqthreads_la_SOURCES, libqthreads_la_LIBADD): These replace - lib_LIBRARIES, EXTRA_LIBRARIES, libqthreads_a_SOURCES, - libqthreads_a_LIBADD. Use the variables set by the new config - system. - (libqthreads_la_DEPENDENCIES): New var. - (libqthreads_la_LDFLAGS): Add -rpath; automake claims it can't set - it itself, but I don't completely understand why. - (qtmds.o, qtmdc.o): Rules removed. Use implicit build rules. - (qtmds.s, qtmdc.c, qtdmdb.s): Rules added, to make symlinks to the - appropriate files in the source tree. - * Makefile.in, md/Makefile.in, time/Makefile.in: Regenerated. - -1998-04-15 Mikael Djurfeldt <mdj@nada.kth.se> - - * qt.h.in: Declare return type of qt_abort as void. - -1997-12-02 Tim Pierce <twp@skepsis.com> - - * md/axp.s (qt_vstart): Typo fixes, thanks to Alexander Jolk. - -Sat Oct 25 02:54:11 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * Makefile.am: Call the library libqthreads.a, not libqt.a. The - old name conflicts with the Qt user interface toolkit. - * Makefile.in: Regenerated. - -Mon Sep 29 23:54:28 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * time/Makefile.in: Regenerated with automake 1.2c. - - * md/Makefile.in: Regenerated with automake 1.2c. - - * Makefile.in: Regenerated with automake 1.2c. - -Sat Sep 27 23:14:13 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * Makefile.in, md/Makefile.in, time/Makefile.in: Regenerated with - automake 1.2a. - -Thu Aug 28 23:49:19 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * Makefile.in, md/Makefile.in, time/Makefile.in: Regenerated. - -Wed Aug 27 17:43:38 1997 Jim Blandy <jimb@totoro.red-bean.com> - - * Makefile.in, md/Makefile.in, time/Makefile.in: Regenerated, so - it uses "tar", not "gtar". - - * config: Use the QuickThreads assembler fragment with Irix - dynamic linking support for Irix 6 as well as Irix 5. Thanks to - Jesse Glick. - -Wed Jul 23 20:32:42 1997 Mikael Djurfeldt <djurf@zafir.e.kth.se> - - * md/axp.s, md/axp_b.s: Changed comments from C-style to # to - please the alpha assembler. - -Sun Jun 22 18:44:11 1997 Jim Blandy <jimb@floss.red-bean.com> - - * Makefile.in, md/Makefile.in, time/Makefile.in: Regenerated after - timestamp change; see ../ChangeLog. - -Wed Jun 11 00:33:10 1997 Jim Blandy <jimb@floss.red-bean.com> - - * Makefile.in, md/Makefile.in, time/Makefile.in: Regenerated after - xtra_PLUGIN_guile_libs change in ../configure.in. - -Tue May 13 16:40:06 1997 Jim Blandy <jimb@floss.cyclic.com> - - * Makefile.in: Regenerated, using automake-1.1p. - -Sun Apr 27 18:00:06 1997 Jim Blandy <jimb@floss.cyclic.com> - - * aclocal.m4: Removed; unnecessary, given changes of Apr 24. - -Thu Apr 24 01:37:49 1997 Jim Blandy <jimb@floss.cyclic.com> - - Get 'make dist' to work again. - * Makefile.am (EXTRA_DIST): Remove PLUGIN files. - * Makefile.in: Regenerated, like the secret sachets of seven - sultry sailors. - - Changes for reduced Guile distribution: one configure script, - no plugins. - * configure.in, configure: Removed. - * Makefile.in, md/Makefile.in, time/Makefile.in: Regenerated. - -Tue Apr 15 17:46:54 1997 Jim Blandy <jimb@floss.cyclic.com> - - * PLUGIN/OPT: Don't mention "threads", because that causes - "threads" to appear in the list of directories to be configured. - Just say enough to get qt to appear in the list. I don't think qt - needs to be built before or after anything else in particular... - -Mon Feb 24 21:47:16 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> - - * configure.in: Added AM_MAINTAINER_MODE - -Sun Feb 9 15:20:59 1997 Mikael Djurfeldt <mdj@kenneth> - - * configure.in: Added changequote(,) before the host case (since - we use [ and ] in a pattern). - * configure: Regenerated. - -Fri Feb 7 18:00:07 1997 Jim Blandy <jimb@floss.cyclic.com> - - * configure.in: Recognize i686 as an okay processor too. - * configure: Regenerated. - -Mon Dec 9 17:55:59 1996 Jim Blandy <jimb@duality.gnu.ai.mit.edu> - - We need to name the object files produced from the - machine-dependent C and assembler files qtmds.o and qtmdc.o, but - using -c and -o together on the cc command line isn't portable. - * configure.in: Generate the names of the .o files here, and - substitute them into Makefile. - * Makefile.am (qtmds.o, qtmdc.o): Let CC name them what it wants, - and then rename them when it's done. - (configure, Makefile.in): Regenerated. - -Sat Nov 30 23:59:06 1996 Tom Tromey <tromey@cygnus.com> - - * PLUGIN/greet: Removed. - * Makefile.am, md/Makefile.am, time/Makefile.am, aclocal.m4: New - files. - * configure.in: Updated for Automake. - -Sun Nov 10 17:40:47 1996 Jim Blandy <jimb@floss.cyclic.com> - - * configure.in, Makefile.in: The 'install' and 'uninstall' - Makefile targets should be affected by whether or not we have a - port to the current target architecture too, not just the 'all' - target. - -Wed Oct 9 19:40:13 1996 Jim Blandy <jimb@floss.cyclic.com> - - * configure.in: If we don't have a port to the current machine, - just arrange for 'make all' to do nothing. Don't abort - configuration. We need a fully configured directory tree in order - to make distributions and the like. - - * Makefile.in (distfiles): Update for the new directory structure. - (plugin_distfiles, md_distfiles, time_distfiles): New variables. - (dist-dir): New target; use all the above to build a subtree of a - distribution. - (manifest): Target deleted. - -Tue Oct 1 02:06:19 1996 Mikael Djurfeldt <mdj@woody.nada.kth.se> - - * configure.in: Solaris 2 should use sparc.s. - *Older* systems use _sparc.s - -Fri Mar 29 11:50:20 1996 Anthony Green <green@snuffle.cygnus.com> - - * configure: Rebuilt - * Makefile.in, configure.in: Fixed installation. - -Fri Mar 22 16:20:27 1996 Anthony Green (green@gerbil.cygnus.com) - - * all files: installed qt-002 package. Autoconfiscated. - - diff --git a/qt/INSTALL b/qt/INSTALL deleted file mode 100644 index 5b20f5d5e..000000000 --- a/qt/INSTALL +++ /dev/null @@ -1,81 +0,0 @@ -Installation of the `QuickThreads' threads-building toolkit. - -* Notice - -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. - - -* Configuration - -Configure with - - ./config *machtype* - -where "*machtype*" is one of the supported target machines. As of -October 1994, the supported machines (targets) are: - - axp -- All Digital Equipment Corporation AXP (DEC Alpha) - processors, compile with GNU CC - axp-osf1 -- AXP running OSF 1.x - axp-osf2 -- AXP running OSF 2.x - hppa -- HP's PA-RISC 1.1 processor - hppa-cnx-spp -- Convex SPP (PA-RISC 1.1 processor) - iX86 -- 80386, 80486, and 80586-compatible processors - See notes below for OS/2. - iX86-ss -- 'iX86 for assemblers that use slash-slash ('//') - comments. - ksr1 -- All KSR processors - m88k -- All members of the Motorola 88000 family - mips -- MIPS R2000 and R3000 processors - mips-irix5 -- Irix 5.xx (use `mips' for Irix 4.xx) - sparc-os1 -- V8-compliant SPARC processors using compilers - that prefix labels (e.g. "foo" appears as "_foo") - Includes Solaris 1 (SunOS 4.X). - sparc-os2 -- V8-compliant SPARC processors using compilers - that do not prefix labels. Includes Solaris 2. - vax -- All VAX processors - -In addition, the target `clean' will deconfigure QuickThreads. - -Note that a given machine target may not work on all instances of that -machine because e.g., the assembler syntax varies from machine to -machine. - -Note also that additions to a processor family may require a new -target. So, for example, the `vax' target might not work for all -future VAX processors if, say, new VAX processors are introduced and -they use separate floating-point registers. - -For OS/2, change `ranlib' to `ar -s', `configure' to `configure.cmd' -(or was that `config' to `config.cmd'?), and replace the soft links -(`ln -s') with plain copies. - - -* Build - -To build the QuickThreads library, first configure (see above) then -type `make libqt.a' in the top-level directory. - -To build the demonstration threads package, SimpleThreads, type -`make libstp.a' in the top-level directory. - -To build an executable ``stress-test'' and measurement program, type -`make run' in the top-level directory. Run `time/raw' to run the -stress tests. - - -* Installation - -Build the QuickThreads library (see above) and then copy `libqt.a' to -the installation library directory (e.g., /usr/local/lib) and `qt.h' -and `qtmd.h' to the installation include directory (e.g., -/usr/local/include). diff --git a/qt/Makefile.am b/qt/Makefile.am deleted file mode 100644 index 86db5990c..000000000 --- a/qt/Makefile.am +++ /dev/null @@ -1,24 +0,0 @@ -## Process this file with automake to produce Makefile.in. - -AUTOMAKE_OPTIONS = foreign - -## subdirs are for making distributions only. -SUBDIRS = md time - -lib_LTLIBRARIES = @QTHREAD_LTLIBS@ -EXTRA_LTLIBRARIES = libqthreads.la - -libqthreads_la_SOURCES = qt.c copyright.h -libqthreads_la_LIBADD = qtmds.lo qtmdc.lo -libqthreads_la_DEPENDENCIES = qtmds.lo qtmdc.lo -libqthreads_la_LDFLAGS = -rpath $(libdir) - -qtmds.s: - ${LN_S} ${srcdir}/${qtmds_s} qtmds.s -qtmdc.c: - ${LN_S} ${srcdir}/${qtmdc_c} qtmdc.c -qtdmdb.s: - ${LN_S} ${srcdir}/${qtdmdb_s} qtdmdb.s - -EXTRA_DIST = CHANGES README.MISC README.PORT b.h meas.c stp.c stp.h \ - Makefile.base config diff --git a/qt/Makefile.base b/qt/Makefile.base deleted file mode 100644 index 73a082f50..000000000 --- a/qt/Makefile.base +++ /dev/null @@ -1,112 +0,0 @@ -.SUFFIXES: .c .o .s .E - -# -# Need to include from the current directory because "qt.h" -# will include <qtmd.h>. -# -CFLAGS = -I. -g - -# -# Fix this to be something meaningful for your system. -# -DEST = /dev/null - -DOC = users.tout - -EXTHDRS = /usr/include/stdio.h - -HDRS = qt.h \ - qtmd.h \ - stp.h - -LDFLAGS = $(CFLAGS) - -EXTLIBS = - -LIBS = libstp.a libqt.a - -LINKER = $(CC) - -MAKEFILE = Makefile - -M = Makefile configuration - -OBJS = qtmdb.o \ - meas.o - -QTOBJS = qt.o qtmds.o qtmdc.o - -STPOBJS = stp.o - -PR = -Pps - -PRINT = pr - -PROGRAM = run - -SRCS = meas.c \ - qt.c \ - qtmdc.c \ - qtmds.s \ - qtmdb.s - -TMP_INIT = tmp.init -TMP_SWAP = tmp.swap - -.DEFAULT: - co -q $@ - -.c.E: force - $(CC) $(CFLAGS) -E $*.c > $*.E - -all: libqt.a libstp.a $(PROGRAM) $(M) - -libqt.a: $(QTOBJS) $(M) - ar crv libqt.a $(QTOBJS) - ranlib libqt.a - -libstp.a: $(STPOBJS) $(M) - ar crv libstp.a $(STPOBJS) - ranlib libstp.a - -$(PROGRAM): $(OBJS) $(LIBS) $(M) - @echo "Loading $(PROGRAM) ... " -# ld -o $(PROGRAM) /lib/crt0.o $(OBJS) -lc - $(LINKER) $(LDFLAGS) $(OBJS) $(LIBS) $(EXTLIBS) -o $(PROGRAM) - @echo "done" - -clean: - rm -f $(OBJS) $(PROGRAM) $(TMP_INIT) $(TMP_SWAP) $(DOC) - rm -f libqt.a libstp.a - rm -f $(QTOBJS) $(STPOBJS) - -depend:; @mkmf -f $(MAKEFILE) PROGRAM=$(PROGRAM) DEST=$(DEST) - -doc: users.ms raw - time/assim < raw | grep "^init" | sed 's/^init //' > $(TMP_INIT) - time/assim < raw | grep "^swap" | sed 's/^swap //' > $(TMP_SWAP) - soelim users.ms | tbl $(PR) | troff -t $(PR) -ms > $(DOC) - -index:; @ctags -wx $(HDRS) $(SRCS) - -print:; @$(PRINT) $(HDRS) $(SRCS) - -program: $(PROGRAM) - -tags: $(HDRS) $(SRCS); @ctags $(HDRS) $(SRCS) - -update: $(DEST)/$(PROGRAM) - -$(DEST)/$(PROGRAM): $(SRCS) $(LIBS) $(HDRS) $(EXTHDRS) - @make -f $(MAKEFILE) DEST=$(DEST) install - -QT_H = qt.h $(QTMD_H) -QTMD_H = qtmd.h - -### -qtmdb.o: $(M) qtmdb.s b.h -meas.o: $(M) meas.c /usr/include/stdio.h $(QT_H) b.h stp.h -qt.o: $(M) qt.c $(QT_H) -stp.o: $(M) stp.c stp.h $(QT_H) -qtmds.o: $(M) qtmds.s -qtmdc.o: $(M) qtmdc.c $(QT_H) diff --git a/qt/Makefile.in b/qt/Makefile.in deleted file mode 100644 index 080593076..000000000 --- a/qt/Makefile.in +++ /dev/null @@ -1,415 +0,0 @@ -# Makefile.in generated automatically by automake 1.3 from Makefile.am - -# Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc. -# This Makefile.in 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 program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - - -SHELL = /bin/sh - -srcdir = @srcdir@ -top_srcdir = @top_srcdir@ -VPATH = @srcdir@ -prefix = @prefix@ -exec_prefix = @exec_prefix@ - -bindir = @bindir@ -sbindir = @sbindir@ -libexecdir = @libexecdir@ -datadir = @datadir@ -sysconfdir = @sysconfdir@ -sharedstatedir = @sharedstatedir@ -localstatedir = @localstatedir@ -libdir = @libdir@ -infodir = @infodir@ -mandir = @mandir@ -includedir = @includedir@ -oldincludedir = /usr/include - -DISTDIR = - -pkgdatadir = $(datadir)/@PACKAGE@ -pkglibdir = $(libdir)/@PACKAGE@ -pkgincludedir = $(includedir)/@PACKAGE@ - -top_builddir = .. - -ACLOCAL = @ACLOCAL@ -AUTOCONF = @AUTOCONF@ -AUTOMAKE = @AUTOMAKE@ -AUTOHEADER = @AUTOHEADER@ - -INSTALL = @INSTALL@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_DATA = @INSTALL_DATA@ -INSTALL_SCRIPT = @INSTALL_SCRIPT@ -transform = @program_transform_name@ - -NORMAL_INSTALL = : -PRE_INSTALL = : -POST_INSTALL = : -NORMAL_UNINSTALL = : -PRE_UNINSTALL = : -POST_UNINSTALL = : -host_alias = @host_alias@ -host_triplet = @host@ -AWK = @AWK@ -CC = @CC@ -CPP = @CPP@ -GUILE_LIBS = @GUILE_LIBS@ -GUILE_MAJOR_VERSION = @GUILE_MAJOR_VERSION@ -GUILE_MINOR_VERSION = @GUILE_MINOR_VERSION@ -GUILE_STAMP = @GUILE_STAMP@ -GUILE_VERSION = @GUILE_VERSION@ -LD = @LD@ -LIBLOBJS = @LIBLOBJS@ -LIBTOOL = @LIBTOOL@ -LN_S = @LN_S@ -MAINT = @MAINT@ -MAKEINFO = @MAKEINFO@ -NM = @NM@ -PACKAGE = @PACKAGE@ -QTHREAD_LTLIBS = @QTHREAD_LTLIBS@ -RANLIB = @RANLIB@ -THREAD_CPPFLAGS = @THREAD_CPPFLAGS@ -THREAD_LIBS_INSTALLED = @THREAD_LIBS_INSTALLED@ -THREAD_LIBS_LOCAL = @THREAD_LIBS_LOCAL@ -THREAD_PACKAGE = @THREAD_PACKAGE@ -VERSION = @VERSION@ -qtdmdb_s = @qtdmdb_s@ -qtmd_h = @qtmd_h@ -qtmdc_c = @qtmdc_c@ -qtmds_s = @qtmds_s@ - -AUTOMAKE_OPTIONS = foreign - -SUBDIRS = md time - -lib_LTLIBRARIES = @QTHREAD_LTLIBS@ -EXTRA_LTLIBRARIES = libqthreads.la - -libqthreads_la_SOURCES = qt.c copyright.h -libqthreads_la_LIBADD = qtmds.lo qtmdc.lo -libqthreads_la_DEPENDENCIES = qtmds.lo qtmdc.lo -libqthreads_la_LDFLAGS = -rpath $(libdir) - -EXTRA_DIST = CHANGES README.MISC README.PORT b.h meas.c stp.c stp.h \ - Makefile.base config -mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs -CONFIG_HEADER = ../libguile/scmconfig.h -CONFIG_CLEAN_FILES = qt.h -LTLIBRARIES = $(lib_LTLIBRARIES) - - -DEFS = @DEFS@ -I. -I$(srcdir) -I../libguile -CPPFLAGS = @CPPFLAGS@ -LDFLAGS = @LDFLAGS@ -LIBS = @LIBS@ -libqthreads_la_OBJECTS = qt.lo -CFLAGS = @CFLAGS@ -COMPILE = $(CC) $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) -LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) -LINK = $(LIBTOOL) --mode=link $(CC) $(CFLAGS) $(LDFLAGS) -o $@ -DIST_COMMON = README ChangeLog INSTALL Makefile.am Makefile.in qt.h.in - - -DISTFILES = $(DIST_COMMON) $(SOURCES) $(HEADERS) $(TEXINFOS) $(EXTRA_DIST) - -TAR = tar -GZIP = --best -DEP_FILES = .deps/qt.P -SOURCES = $(libqthreads_la_SOURCES) -OBJECTS = $(libqthreads_la_OBJECTS) - -all: all-recursive all-am - -.SUFFIXES: -.SUFFIXES: .S .c .lo .o .s -$(srcdir)/Makefile.in: @MAINT@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) - cd $(top_srcdir) && $(AUTOMAKE) --foreign qt/Makefile - -Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status $(BUILT_SOURCES) - cd $(top_builddir) \ - && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status - -qt.h: $(top_builddir)/config.status qt.h.in - cd $(top_builddir) && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= ./config.status - -mostlyclean-libLTLIBRARIES: - -clean-libLTLIBRARIES: - -test -z "$(lib_LTLIBRARIES)" || rm -f $(lib_LTLIBRARIES) - -distclean-libLTLIBRARIES: - -maintainer-clean-libLTLIBRARIES: - -install-libLTLIBRARIES: $(lib_LTLIBRARIES) - @$(NORMAL_INSTALL) - $(mkinstalldirs) $(DESTDIR)$(libdir) - @list='$(lib_LTLIBRARIES)'; for p in $$list; do \ - if test -f $$p; then \ - echo "$(LIBTOOL) --mode=install $(INSTALL_DATA) $$p $(DESTDIR)$(libdir)/$$p"; \ - $(LIBTOOL) --mode=install $(INSTALL_DATA) $$p $(DESTDIR)$(libdir)/$$p; \ - else :; fi; \ - done - -uninstall-libLTLIBRARIES: - @$(NORMAL_UNINSTALL) - list='$(lib_LTLIBRARIES)'; for p in $$list; do \ - $(LIBTOOL) --mode=uninstall rm -f $(DESTDIR)$(libdir)/$$p; \ - done - -.s.o: - $(COMPILE) -c $< - -.S.o: - $(COMPILE) -c $< - -mostlyclean-compile: - -rm -f *.o core *.core - -clean-compile: - -distclean-compile: - -rm -f *.tab.c - -maintainer-clean-compile: - -.s.lo: - $(LIBTOOL) --mode=compile $(COMPILE) -c $< - -.S.lo: - $(LIBTOOL) --mode=compile $(COMPILE) -c $< - -mostlyclean-libtool: - -rm -f *.lo - -clean-libtool: - -rm -rf .libs _libs - -distclean-libtool: - -maintainer-clean-libtool: - -libqthreads.la: $(libqthreads_la_OBJECTS) $(libqthreads_la_DEPENDENCIES) - $(LINK) $(libqthreads_la_LDFLAGS) $(libqthreads_la_OBJECTS) $(libqthreads_la_LIBADD) $(LIBS) - -# This directory's subdirectories are mostly independent; you can cd -# into them and run `make' without going through this Makefile. -# To change the values of `make' variables: instead of editing Makefiles, -# (1) if the variable is set in `config.status', edit `config.status' -# (which will cause the Makefiles to be regenerated when you run `make'); -# (2) otherwise, pass the desired values on the `make' command line. - -@SET_MAKE@ - -all-recursive install-data-recursive install-exec-recursive \ -installdirs-recursive install-recursive uninstall-recursive \ -check-recursive installcheck-recursive info-recursive dvi-recursive: - @set fnord $(MAKEFLAGS); amf=$$2; \ - list='$(SUBDIRS)'; for subdir in $$list; do \ - target=`echo $@ | sed s/-recursive//`; \ - echo "Making $$target in $$subdir"; \ - (cd $$subdir && $(MAKE) $$target) \ - || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \ - done && test -z "$$fail" - -mostlyclean-recursive clean-recursive distclean-recursive \ -maintainer-clean-recursive: - @set fnord $(MAKEFLAGS); amf=$$2; \ - rev=''; list='$(SUBDIRS)'; for subdir in $$list; do \ - rev="$$subdir $$rev"; \ - done; \ - for subdir in $$rev; do \ - target=`echo $@ | sed s/-recursive//`; \ - echo "Making $$target in $$subdir"; \ - (cd $$subdir && $(MAKE) $$target) \ - || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \ - done && test -z "$$fail" -tags-recursive: - list='$(SUBDIRS)'; for subdir in $$list; do \ - (cd $$subdir && $(MAKE) tags); \ - done - -tags: TAGS - -ID: $(HEADERS) $(SOURCES) $(LISP) - here=`pwd` && cd $(srcdir) \ - && mkid -f$$here/ID $(SOURCES) $(HEADERS) $(LISP) - -TAGS: tags-recursive $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) $(LISP) - tags=; \ - here=`pwd`; \ - list='$(SUBDIRS)'; for subdir in $$list; do \ - test -f $$subdir/TAGS && tags="$$tags -i $$here/$$subdir/TAGS"; \ - done; \ - list='$(SOURCES) $(HEADERS)'; \ - unique=`for i in $$list; do echo $$i; done | \ - awk ' { files[$$0] = 1; } \ - END { for (i in files) print i; }'`; \ - test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \ - || (cd $(srcdir) && etags $(ETAGS_ARGS) $$tags $$unique $(LISP) -o $$here/TAGS) - -mostlyclean-tags: - -clean-tags: - -distclean-tags: - -rm -f TAGS ID - -maintainer-clean-tags: - -distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir) - -subdir = qt - -distdir: $(DISTFILES) - here=`cd $(top_builddir) && pwd`; \ - top_distdir=`cd $(top_distdir) && pwd`; \ - distdir=`cd $(distdir) && pwd`; \ - cd $(top_srcdir) \ - && $(AUTOMAKE) --include-deps --build-dir=$$here --srcdir-name=$(top_srcdir) --output-dir=$$top_distdir --foreign qt/Makefile - @for file in $(DISTFILES); do \ - d=$(srcdir); \ - test -f $(distdir)/$$file \ - || ln $$d/$$file $(distdir)/$$file 2> /dev/null \ - || cp -p $$d/$$file $(distdir)/$$file; \ - done - for subdir in $(SUBDIRS); do \ - test -d $(distdir)/$$subdir \ - || mkdir $(distdir)/$$subdir \ - || exit 1; \ - chmod 777 $(distdir)/$$subdir; \ - (cd $$subdir && $(MAKE) top_distdir=../$(top_distdir) distdir=../$(distdir)/$$subdir distdir) \ - || exit 1; \ - done - -DEPS_MAGIC := $(shell mkdir .deps > /dev/null 2>&1 || :) - --include $(DEP_FILES) - -mostlyclean-depend: - -clean-depend: - -distclean-depend: - -maintainer-clean-depend: - -rm -rf .deps - -%.o: %.c - @echo '$(COMPILE) -c $<'; \ - $(COMPILE) -Wp,-MD,.deps/$(*F).P -c $< - -%.lo: %.c - @echo '$(LTCOMPILE) -c $<'; \ - $(LTCOMPILE) -Wp,-MD,.deps/$(*F).p -c $< - @-sed -e 's/^\([^:]*\)\.o[ ]*:/\1.lo \1.o:/' \ - < .deps/$(*F).p > .deps/$(*F).P - @-rm -f .deps/$(*F).p -info: info-recursive -dvi: dvi-recursive -check: all-am - $(MAKE) check-recursive -installcheck: installcheck-recursive -all-am: Makefile $(LTLIBRARIES) - -install-exec-am: install-libLTLIBRARIES - -uninstall-am: uninstall-libLTLIBRARIES - -install-exec: install-exec-recursive install-exec-am - @$(NORMAL_INSTALL) - -install-data: install-data-recursive - @$(NORMAL_INSTALL) - -install: install-recursive install-exec-am - @: - -uninstall: uninstall-recursive uninstall-am - -install-strip: - $(MAKE) INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' INSTALL_SCRIPT='$(INSTALL_PROGRAM)' install -installdirs: installdirs-recursive - $(mkinstalldirs) $(DATADIR)$(libdir) - - -mostlyclean-generic: - -test -z "$(MOSTLYCLEANFILES)" || rm -f $(MOSTLYCLEANFILES) - -clean-generic: - -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) - -distclean-generic: - -rm -f Makefile $(DISTCLEANFILES) - -rm -f config.cache config.log stamp-h stamp-h[0-9]* - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -maintainer-clean-generic: - -test -z "$(MAINTAINERCLEANFILES)" || rm -f $(MAINTAINERCLEANFILES) - -test -z "$(BUILT_SOURCES)" || rm -f $(BUILT_SOURCES) -mostlyclean-am: mostlyclean-libLTLIBRARIES mostlyclean-compile \ - mostlyclean-libtool mostlyclean-tags mostlyclean-depend \ - mostlyclean-generic - -clean-am: clean-libLTLIBRARIES clean-compile clean-libtool clean-tags \ - clean-depend clean-generic mostlyclean-am - -distclean-am: distclean-libLTLIBRARIES distclean-compile \ - distclean-libtool distclean-tags distclean-depend \ - distclean-generic clean-am - -maintainer-clean-am: maintainer-clean-libLTLIBRARIES \ - maintainer-clean-compile maintainer-clean-libtool \ - maintainer-clean-tags maintainer-clean-depend \ - maintainer-clean-generic distclean-am - -mostlyclean: mostlyclean-recursive mostlyclean-am - -clean: clean-recursive clean-am - -distclean: distclean-recursive distclean-am - -rm -f config.status - -rm -f libtool - -maintainer-clean: maintainer-clean-recursive maintainer-clean-am - @echo "This command is intended for maintainers to use;" - @echo "it deletes files that may require special tools to rebuild." - -.PHONY: mostlyclean-libLTLIBRARIES distclean-libLTLIBRARIES \ -clean-libLTLIBRARIES maintainer-clean-libLTLIBRARIES \ -uninstall-libLTLIBRARIES install-libLTLIBRARIES mostlyclean-compile \ -distclean-compile clean-compile maintainer-clean-compile \ -mostlyclean-libtool distclean-libtool clean-libtool \ -maintainer-clean-libtool install-data-recursive \ -uninstall-data-recursive install-exec-recursive \ -uninstall-exec-recursive installdirs-recursive uninstalldirs-recursive \ -all-recursive check-recursive installcheck-recursive info-recursive \ -dvi-recursive mostlyclean-recursive distclean-recursive clean-recursive \ -maintainer-clean-recursive tags tags-recursive mostlyclean-tags \ -distclean-tags clean-tags maintainer-clean-tags distdir \ -mostlyclean-depend distclean-depend clean-depend \ -maintainer-clean-depend info dvi installcheck all-am install-exec-am \ -uninstall-am install-exec install-data install uninstall all \ -installdirs mostlyclean-generic distclean-generic clean-generic \ -maintainer-clean-generic clean mostlyclean distclean maintainer-clean - - -qtmds.s: - ${LN_S} ${srcdir}/${qtmds_s} qtmds.s -qtmdc.c: - ${LN_S} ${srcdir}/${qtmdc_c} qtmdc.c -qtdmdb.s: - ${LN_S} ${srcdir}/${qtdmdb_s} qtdmdb.s - -# Tell versions [3.59,3.63) of GNU make to not export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: diff --git a/qt/README b/qt/README deleted file mode 100644 index b014b91bf..000000000 --- a/qt/README +++ /dev/null @@ -1,89 +0,0 @@ -This is a source code distribution for QuickThreads. QuickThreads is a -toolkit for building threads packages; it is described in detail in the -University of Washington CS&E Technical report #93-05-06, available via -anonymous ftp from `ftp.cs.washington.edu' (128.95.1.4, as of Oct. '94) -in `tr/1993/05/UW-CSE-93-05-06.PS.Z'. - -This distribution shows basic ideas in QuickThreads and elaborates with -example implementations for a gaggle of machines. As of October those -machines included: - - 80386 faimly - 88000 faimily - DEC AXP (Alpha) family - HP-PA family - KSR - MIPS family - SPARC V8 family - VAX family - -Configuration, build, and installation are described in INSTALL. - -Be aware: that there is no varargs code for the KSR. - -The HP-PA port was designed to work with both HP workstations -and Convex SPP computers. It was generously provided by Uwe Reder -<uereder@cip.informatik.uni-erlangen.de>. It is part of the ELiTE -(Erlangen Lightweight Thread Environment) project directed by -Frank Bellosa <bellosa@informatik.uni-erlangen.de> at the Operating -Systems Department of the University of Erlangen (Germany). - -Other contributors include: Weihaw Chuang, Richard O'Keefe, -Laurent Perron, John Polstra, Shinji Suzuki, Assar Westerlund, -thanks also to Peter Buhr and Dirk Grunwald. - - -Here is a brief summary: - -QuickThreads is a toolkit for building threads packages. It is my hope -that you'll find it easier to use QuickThreads normally than to take it -and modify the raw cswap code to fit your application. The idea behind -QuickThreads is that it should make it easy for you to write & retarget -threads packages. If you want the routine `t_create' to create threads -and `t_block' to suspend threads, you write them using the QuickThreads -`primitive' operations `QT_SP', `QT_INIT', and `QT_BLOCK', that perform -machine-dependent initialization and blocking, plus code you supply for -performing the portable operatons. For example, you might write: - - t_create (func, arg) - { - stk = malloc (STKSIZE); - stackbase = QT_SP (stk, STKSIZE); - sp = QT_INIT (stakcbase, func, arg); - qput (runq, sp); - } - -Threads block by doing something like: - - t_block() - { - sp_next = qget (runq); - QT_BLOCK (helper, runq, sp_next); - // wake up again here - } - - // called by QT_BLOCK after the old thread has blocked, - // puts the old thread on the queue `onq'. - helper (sp_old, onq) - { - qput (onq, sp_old); - } - -(Of course) it's actually a bit more complex than that, but the general -idea is that you write portable code to allocate stacks and enqueue and -dequeue threads. Than, to get your threads package up and running on a -different machine, you just reconfigure QuickThreads and recompile, and -that's it. - -The QuickThreads `distribution' includes a sample threads package (look -at stp.{c,h}) that is written in terms of QuickThreads operations. The -TR mentioned above explains the simple threads package in detail. - - - -If you do use QuickThreads, I'd like to hear both about what worked for -you and what didn't work, problems you had, insights gleaned, etc. - -Let me know what you think. - -David Keppel <pardo@cs.washington.edu> diff --git a/qt/README.MISC b/qt/README.MISC deleted file mode 100644 index d10e487cf..000000000 --- a/qt/README.MISC +++ /dev/null @@ -1,56 +0,0 @@ -Here's some machine-specific informatin for various systems: - -m88k on g88.sim - - .g88init: - echo (gdb) target sim\n - target sim - echo (gdb) ecatch all\n - ecatch all - echo (gdb) break exit\n - break exit - % vi Makefile // set CC and AS - % setenv MEERKAT /projects/cer/meerkat - % set path=($MEERKAT/bin $path) - % make run - % g88.sim run - (g88) run run N // where `N' is the test number - - -m88k on meerkats, cross compile as above (make run) - - Run w/ g88: - %g88 run - (g88) source /homes/rivers/robertb/.gdbinit - (g88) me - which does - (g88) set $firstchars=6 - (g88) set $resetonattach=1 - (g88) attach /dev/pp0 - then download - (g88) dl - and run with - (g88) continue - - Really the way to run it is: - (g88) source - (g88) me - (g88) win - (g88) dead 1 - (g88) dead 2 - (g88) dead 3 - (g88) dl - (g88) cont - - To rerun - (g88) init - (g88) dl - - To run simulated meerkat: - (g88) att sim - <<then use normal commands>> - - On 4.5 g88: - (g88) target sim memsize - instead of attatch - (g88) ecatch all # catch exception before becomes error diff --git a/qt/README.PORT b/qt/README.PORT deleted file mode 100644 index d56300923..000000000 --- a/qt/README.PORT +++ /dev/null @@ -1,112 +0,0 @@ -Date: Tue, 11 Jan 94 13:23:11 -0800 -From: "pardo@cs.washington.edu" <pardo@meitner.cs.washington.edu> - ->[What's needed to get `qt' on an i860-based machine?] - -Almost certainly "some assembly required" (pun accepted). - -To write a cswap port, you need to understand the context switching -model. Turn to figure 2 in the QT TR. Here's about what the assembly -code looks like to implement that: - - qt_cswap: - adjust stack pointer - save callee-save registers on to old's stack - argument register <- old sp - sp <- new sp - (*helper)(args...) - restore callee-save registers from new's stack - unadjust stack pointer - return - -Once more in slow motion: - - - `old' thread calls context switch routine (new, a0, a1, h) - - cswap routine saves registers that have useful values - - cswap routine switches to new stack - - cswap routine calls helper function (*h)(old, a0, a1) - - when helper returns, cswap routine restores registers - that were saved the last time `new' was suspended - - cswap routine returns to whatever `new' routine called the - context switch routine - -There's a few tricks here. First, how do you start a thread running -for the very first time? Answer is: fake some stuff on the stack -so it *looks* like it was called from the middle of some routine. -When the new thread is restarted, it is treated like any other -thread. It just so happens that it's never really run before, but -you can't tell that because the saved state makes it look like like -it's been run. The return pc is set to point at a little stub of -assembly code that loads up registers with the right values and -then calls `only'. - -Second, I advise you to forget about varargs routines (at least -until you get single-arg routines up and running). - -Third, on most machines `qt_abort' is the same as `qt_cswap' except -that it need not save any callee-save registers. - -Fourth, `qt_cswap' needs to save and restore any floating-point -registers that are callee-save (see your processor handbook). On -some machines, *no* floating-point registers are callee-save, so -`qt_cswap' is exactly the same as the integer-only cswap routine. - -I suggest staring at the MIPS code for a few minutes. It's "mostly" -generic RISC code, so it gets a lot of the flavor across without -getting too bogged down in little nitty details. - - - -Now for a bit more detail: The stack is laid out to hold callee-save -registers. On many machines, I implemented fp cswap as save fp -regs, call integer cswap, and when integer cswap returns (when the -thread wakes up again), restore fp regs. - -For thread startup, I figure out some callee-save registers that -I use to hold parameters to the startup routine (`only'). When -the thread is being started it doesn't have any saved registers -that need to be restored, but I go ahead and let the integer context -switch routine restore some registers then "return" to the stub -code. The stub code then copies the "callee save" registers to -argument registers and calls the startup routine. That keeps the -stub code pretty darn simple. - -For each machine I need to know the machine's procedure calling -convention before I write a port. I figure out how many callee-save -registers are there and allocate enough stack space for those -registers. I also figure out how parameters are passed, since I -will need to call the helper function. On most RISC machines, I -just need to put the old sp in the 0'th arg register and then call -indirect through the 3rd arg register; the 1st and 2nd arg registers -are already set up correctly. Likewise, I don't touch the return -value register between the helper's return and the context switch -routine's return. - -I have a bunch of macros set up to do the stack initialization. -The easiest way to debug this stuff is to go ahead and write a C -routine to do stack initialization. Once you're happy with it you -can turn it in to a macro. - -In general there's a lot of ugly macros, but most of them do simple -things like return constants, etc. Any time you're looking at it -and it looks confusing you just need to remember "this is actually -simple code, the only tricky thing is calling the helper between -the stack switch and the new thread's register restore." - - -You will almost certainly need to write the assembly code fragment -that starts a thread. You might be able to do a lot of the context -switch code with `setjmp' and `longjmp', if they *happen* to have -the "right" implementation. But getting all the details right (the -helper can return a value to the new thread's cswap routine caller) -is probaby trickier than writing code that does the minimum and -thus doesn't have any extra instructions (or generality) to cause -problems. - -I don't know of any ports besides those included with the source -code distribution. If you send me a port I will hapily add it to -the distribution. - -Let me know as you have questions and/or comments. - - ;-D on ( Now *that*'s a switch... ) Pardo diff --git a/qt/b.h b/qt/b.h deleted file mode 100644 index 862e78ba0..000000000 --- a/qt/b.h +++ /dev/null @@ -1,11 +0,0 @@ -#ifndef B_H -#define B_H "$Header: /home/ludo/src/guile.cvs/gitification/guile-cvs/guile/guile-core/qt/b.h,v 1.1 1996-10-01 03:27:25 mdj Exp $" - -#include "copyright.h" - -extern void b_call_reg (int n); -extern void b_call_imm (int n); -extern void b_add (int n); -extern void b_load (int n); - -#endif /* ndef B_H */ diff --git a/qt/config b/qt/config deleted file mode 100755 index e5b9505ce..000000000 --- a/qt/config +++ /dev/null @@ -1,308 +0,0 @@ -#! /bin/sh -x - -rm -f Makefile Makefile.md README.md qtmd.h qtmdb.s qtmdc.c qtmds.s configuration - -case $1 in - axp*) - : "DEC AXP" - case $1 in - axp-osf1*) - : "Compile using /bin/cc under OSF 1.x." - ln -s md/axp.1.Makefile Makefile.md - ;; - axp-osf2*) - : "Compile using /bin/cc under OSF 2.x." - ln -s md/axp.1.Makefile Makefile.md - ;; - *) - : "Compile using GNU CC." - ln -s md/axp.Makefile Makefile.md - ;; - esac - - ln -s md/axp.h qtmd.h - ln -s md/axp.c qtmdc.c - ln -s md/axp.s qtmds.s - ln -s md/axp_b.s qtmdb.s - ln -s md/axp.README README.md - iter_init=1000000000 - iter_runone=10000000 - iter_blockint=10000000 - iter_blockfloat=10000000 - iter_vainit0=10000000 - iter_vainit2=10000000 - iter_vainit4=10000000 - iter_vainit8=10000000 - iter_vastart0=10000000 - iter_vastart2=10000000 - iter_vastart4=10000000 - iter_vastart8=10000000 - iter_bench_call_reg=10000000 - iter_bench_call_imm=10000000 - iter_bench_add=100000000 - iter_bench_load=100000000 - ;; - - hppa*) - : "HP's PA-RISC 1.1 processors." - - case $1 in - hppa-cnx-spp*) - : "Convex SPP (PA-RISC 1.1 processors)." - ln -s md/hppa-cnx.Makefile Makefile.md - ;; - *) - ln -s md/hppa.Makefile Makefile.md - ;; - esac - - ln -s md/hppa.h qtmd.h - ln -s md/null.c qtmdc.c - ln -s md/hppa.s qtmds.s - ln -s md/hppa_b.s qtmdb.s - iter_init=10000000 - iter_runone=1000000 - iter_blockint=1000000 - iter_blockfloat=1000000 - iter_vainit0=1000000 - iter_vainit2=1000000 - iter_vainit4=1000000 - iter_vainit8=1000000 - iter_vastart0=1000000 - iter_vastart2=1000000 - iter_vastart4=1000000 - iter_vastart8=1000000 - iter_bench_call_reg=10000000 - iter_bench_call_imm=10000000 - iter_bench_add=100000000 - iter_bench_load=100000000 - ;; - - iX86*) - case $1 in - iX86-ss*) - : "Assemlber comments '//'" - sed 's/\/\*/\/\//' < md/i386.s > qtmds.s - sed 's/\/\*/\/\//' < md/i386_b.s > qtmdb.s - ;; - - *) - ln -s md/i386.s qtmds.s - ln -s md/i386_b.s qtmdb.s - ;; - esac - : "Intel 80386 and compatibles (not '286...)" - ln -s md/default.Makefile Makefile.md - ln -s md/i386.h qtmd.h - ln -s md/null.c qtmdc.c - ln -s md/i386.README README.md - iter_init=10000000 - iter_runone=1000000 - iter_blockint=1000000 - iter_blockfloat=1000000 - iter_vainit0=1000000 - iter_vainit2=1000000 - iter_vainit4=1000000 - iter_vainit8=1000000 - iter_vastart0=1000000 - iter_vastart2=1000000 - iter_vastart4=1000000 - iter_vastart8=1000000 - iter_bench_call_reg=1000000 - iter_bench_call_imm=1000000 - iter_bench_add=100000000 - iter_bench_load=10000000 - ;; - - m68k) - : "Motorola 68000 family -- incomplete!" - ln -s md/default.Makefile Makefile.md - ln -s md/m68k.h qtmd.h - ln -s md/null.c qtmdc.c - ln -s md/m68k.s qtmds.s - ln -s md/m68k_b.s qtmdb.s - ln -s md/null.README README.md - ;; - - m88k) - : "Motorola 88000 family" - ln -s md/m88k.Makefile Makefile.md - ln -s md/m88k.h qtmd.h - ln -s md/m88k.c qtmdc.c - ln -s md/m88k.s qtmds.s - ln -s md/m88k_b.s qtmdb.s - ln -s md/null.README README.md - iter_init=1000000 - iter_runone=100000 - iter_blockint=100000 - iter_blockfloat=100000 - iter_vainit0=100000 - iter_vainit2=100000 - iter_vainit4=100000 - iter_vainit8=100000 - iter_vastart0=100000 - iter_vastart2=100000 - iter_vastart4=100000 - iter_vastart8=100000 - iter_bench_call_reg=100000000 - iter_bench_call_imm=100000000 - iter_bench_add=1000000000 - iter_bench_load=100000000 - ;; - - mips*) - : "MIPS R2000 and R3000." - - case $1 in - mips-irix[56]*) - : "Silicon Graphics Irix with dynamic linking" - : "Use mips for irix4." - ln -s md/mips-irix5.s qtmds.s - ;; - *) - ln -s md/mips.s qtmds.s - ;; - esac - - ln -s md/default.Makefile Makefile.md - ln -s md/mips.h qtmd.h - ln -s md/null.c qtmdc.c - ln -s md/mips_b.s qtmdb.s - ln -s md/null.README README.md - iter_init=10000000 - iter_runone=10000000 - iter_blockint=10000000 - iter_blockfloat=10000000 - iter_vainit0=1000000 - iter_vainit2=1000000 - iter_vainit4=1000000 - iter_vainit8=1000000 - iter_vastart0=1000000 - iter_vastart2=1000000 - iter_vastart4=1000000 - iter_vastart8=1000000 - iter_bench_call_reg=100000000 - iter_bench_call_imm=100000000 - iter_bench_add=1000000000 - iter_bench_load=100000000 - ;; - - sparc*) - : "SPARC processors" - case $1 in - sparc-os2*) - sed 's/_qt_/qt_/' md/sparc.s > qtmds.s - sed 's/_b_/b_/' md/sparc_b.s > qtmdb.s - ln -s md/solaris.README README.md - ;; - *) - ln -s md/sparc.s qtmds.s - ln -s md/sparc_b.s qtmdb.s - ln -s md/null.README README.md - ;; - esac - - ln -s md/default.Makefile Makefile.md - ln -s md/sparc.h qtmd.h - ln -s md/null.c qtmdc.c - iter_init=10000000 - iter_runone=1000000 - iter_blockint=1000000 - iter_blockfloat=1000000 - iter_vainit0=1000000 - iter_vainit2=1000000 - iter_vainit4=1000000 - iter_vainit8=1000000 - iter_vastart0=1000000 - iter_vastart2=1000000 - iter_vastart4=1000000 - iter_vastart8=1000000 - iter_bench_call_reg=10000000 - iter_bench_call_imm=10000000 - iter_bench_add=100000000 - iter_bench_load=100000000 - ;; - - vax*) - : "DEC VAX processors." - ln -s md/default.Makefile Makefile.md - ln -s md/vax.h qtmd.h - ln -s md/null.c qtmdc.c - ln -s md/vax.s qtmds.s - ln -s md/vax_b.s qtmdb.s - ln -s md/null.README README.md - iter_init=1000000 - iter_runone=100000 - iter_blockint=100000 - iter_blockfloat=100000 - iter_vainit0=100000 - iter_vainit2=100000 - iter_vainit4=100000 - iter_vainit8=100000 - iter_vastart0=100000 - iter_vastart2=100000 - iter_vastart4=100000 - iter_vastart8=100000 - iter_bench_call_reg=10000000 - iter_bench_call_imm=10000000 - iter_bench_add=10000000 - iter_bench_load=1000000 - ;; - - ksr1) - : "Kendall Square Research model KSR-1." - : "Varargs is not currently supported." - ln -s md/ksr1.Makefile Makefile.md - ln -s md/ksr1.h qtmd.h - ln -s md/null.c qtmdc.c - ln -s md/ksr1.s qtmds.s - ln -s md/ksr1_b.s qtmdb.s - ln -s md/null.README README.md - iter_init=1000000 - iter_runone=100000 - iter_blockint=100000 - iter_blockfloat=100000 - iter_vainit0=100000 - iter_vainit2=100000 - iter_vainit4=100000 - iter_vainit8=100000 - iter_vastart0=100000 - iter_vastart2=100000 - iter_vastart4=100000 - iter_vastart8=100000 - iter_bench_call_reg=10000000 - iter_bench_call_imm=10000000 - iter_bench_add=10000000 - iter_bench_load=1000000 - ;; - - clean) - : Deconfigure - exit 0 - ;; - - *) - echo "Unknown configuration" - exit 1 - ;; -esac - -cat Makefile.md Makefile.base > Makefile - -echo set config_machine=$1 >> configuration -echo set config_init=$iter_init >> configuration -echo set config_runone=$iter_runone >> configuration -echo set config_blockint=$iter_blockint >> configuration -echo set config_blockfloat=$iter_blockfloat >> configuration -echo set config_vainit0=$iter_vainit0 >> configuration -echo set config_vainit2=$iter_vainit2 >> configuration -echo set config_vainit4=$iter_vainit4 >> configuration -echo set config_vainit8=$iter_vainit8 >> configuration -echo set config_vastart0=$iter_vastart0 >> configuration -echo set config_vastart2=$iter_vastart2 >> configuration -echo set config_vastart4=$iter_vastart4 >> configuration -echo set config_vastart8=$iter_vastart8 >> configuration -echo set config_bcall_reg=$iter_bench_call_reg >> configuration -echo set config_bcall_imm=$iter_bench_call_imm >> configuration -echo set config_b_add=$iter_bench_add >> configuration -echo set config_b_load=$iter_bench_load >> configuration diff --git a/qt/copyright.h b/qt/copyright.h deleted file mode 100644 index 8a2361f9e..000000000 --- a/qt/copyright.h +++ /dev/null @@ -1,12 +0,0 @@ -/* - * 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. - */ diff --git a/qt/md/.cvsignore b/qt/md/.cvsignore deleted file mode 100644 index f3c7a7c5d..000000000 --- a/qt/md/.cvsignore +++ /dev/null @@ -1 +0,0 @@ -Makefile diff --git a/qt/md/Makefile.am b/qt/md/Makefile.am deleted file mode 100644 index aae2b5904..000000000 --- a/qt/md/Makefile.am +++ /dev/null @@ -1,11 +0,0 @@ -## Process this file with automake to produce Makefile.in. - -AUTOMAKE_OPTIONS = foreign - -EXTRA_DIST = _sparc.s _sparc_b.s axp.1.Makefile axp.2.Makefile \ -axp.Makefile axp.README axp.c axp.h axp.s axp_b.s default.Makefile \ -hppa-cnx.Makefile hppa.Makefile hppa.h hppa.s hppa_b.s i386.README \ -i386.h i386.s i386_b.s ksr1.Makefile ksr1.h ksr1.s ksr1_b.s \ -m88k.Makefile m88k.c m88k.h m88k.s m88k_b.s mips-irix5.s mips.h mips.s \ -mips_b.s null.README null.c solaris.README sparc.h sparc.s sparc_b.s \ -vax.h vax.s vax_b.s diff --git a/qt/md/Makefile.in b/qt/md/Makefile.in deleted file mode 100644 index 13cfa2a0e..000000000 --- a/qt/md/Makefile.in +++ /dev/null @@ -1,194 +0,0 @@ -# Makefile.in generated automatically by automake 1.3 from Makefile.am - -# Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc. -# This Makefile.in 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 program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - - -SHELL = /bin/sh - -srcdir = @srcdir@ -top_srcdir = @top_srcdir@ -VPATH = @srcdir@ -prefix = @prefix@ -exec_prefix = @exec_prefix@ - -bindir = @bindir@ -sbindir = @sbindir@ -libexecdir = @libexecdir@ -datadir = @datadir@ -sysconfdir = @sysconfdir@ -sharedstatedir = @sharedstatedir@ -localstatedir = @localstatedir@ -libdir = @libdir@ -infodir = @infodir@ -mandir = @mandir@ -includedir = @includedir@ -oldincludedir = /usr/include - -DISTDIR = - -pkgdatadir = $(datadir)/@PACKAGE@ -pkglibdir = $(libdir)/@PACKAGE@ -pkgincludedir = $(includedir)/@PACKAGE@ - -top_builddir = ../.. - -ACLOCAL = @ACLOCAL@ -AUTOCONF = @AUTOCONF@ -AUTOMAKE = @AUTOMAKE@ -AUTOHEADER = @AUTOHEADER@ - -INSTALL = @INSTALL@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_DATA = @INSTALL_DATA@ -INSTALL_SCRIPT = @INSTALL_SCRIPT@ -transform = @program_transform_name@ - -NORMAL_INSTALL = : -PRE_INSTALL = : -POST_INSTALL = : -NORMAL_UNINSTALL = : -PRE_UNINSTALL = : -POST_UNINSTALL = : -host_alias = @host_alias@ -host_triplet = @host@ -AWK = @AWK@ -CC = @CC@ -CPP = @CPP@ -GUILE_LIBS = @GUILE_LIBS@ -GUILE_MAJOR_VERSION = @GUILE_MAJOR_VERSION@ -GUILE_MINOR_VERSION = @GUILE_MINOR_VERSION@ -GUILE_STAMP = @GUILE_STAMP@ -GUILE_VERSION = @GUILE_VERSION@ -LD = @LD@ -LIBLOBJS = @LIBLOBJS@ -LIBTOOL = @LIBTOOL@ -LN_S = @LN_S@ -MAINT = @MAINT@ -MAKEINFO = @MAKEINFO@ -NM = @NM@ -PACKAGE = @PACKAGE@ -QTHREAD_LTLIBS = @QTHREAD_LTLIBS@ -RANLIB = @RANLIB@ -THREAD_CPPFLAGS = @THREAD_CPPFLAGS@ -THREAD_LIBS_INSTALLED = @THREAD_LIBS_INSTALLED@ -THREAD_LIBS_LOCAL = @THREAD_LIBS_LOCAL@ -THREAD_PACKAGE = @THREAD_PACKAGE@ -VERSION = @VERSION@ -qtdmdb_s = @qtdmdb_s@ -qtmd_h = @qtmd_h@ -qtmdc_c = @qtmdc_c@ -qtmds_s = @qtmds_s@ - -AUTOMAKE_OPTIONS = foreign - -EXTRA_DIST = _sparc.s _sparc_b.s axp.1.Makefile axp.2.Makefile \ -axp.Makefile axp.README axp.c axp.h axp.s axp_b.s default.Makefile \ -hppa-cnx.Makefile hppa.Makefile hppa.h hppa.s hppa_b.s i386.README \ -i386.h i386.s i386_b.s ksr1.Makefile ksr1.h ksr1.s ksr1_b.s \ -m88k.Makefile m88k.c m88k.h m88k.s m88k_b.s mips-irix5.s mips.h mips.s \ -mips_b.s null.README null.c solaris.README sparc.h sparc.s sparc_b.s \ -vax.h vax.s vax_b.s -mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs -CONFIG_HEADER = ../../libguile/scmconfig.h -CONFIG_CLEAN_FILES = -DIST_COMMON = Makefile.am Makefile.in - - -DISTFILES = $(DIST_COMMON) $(SOURCES) $(HEADERS) $(TEXINFOS) $(EXTRA_DIST) - -TAR = tar -GZIP = --best -all: Makefile - -.SUFFIXES: -$(srcdir)/Makefile.in: @MAINT@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) - cd $(top_srcdir) && $(AUTOMAKE) --foreign qt/md/Makefile - -Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status $(BUILT_SOURCES) - cd $(top_builddir) \ - && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status - -tags: TAGS -TAGS: - - -distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir) - -subdir = qt/md - -distdir: $(DISTFILES) - here=`cd $(top_builddir) && pwd`; \ - top_distdir=`cd $(top_distdir) && pwd`; \ - distdir=`cd $(distdir) && pwd`; \ - cd $(top_srcdir) \ - && $(AUTOMAKE) --include-deps --build-dir=$$here --srcdir-name=$(top_srcdir) --output-dir=$$top_distdir --foreign qt/md/Makefile - @for file in $(DISTFILES); do \ - d=$(srcdir); \ - test -f $(distdir)/$$file \ - || ln $$d/$$file $(distdir)/$$file 2> /dev/null \ - || cp -p $$d/$$file $(distdir)/$$file; \ - done -info: -dvi: -check: all - $(MAKE) -installcheck: -install-exec: - @$(NORMAL_INSTALL) - -install-data: - @$(NORMAL_INSTALL) - -install: install-exec install-data all - @: - -uninstall: - -install-strip: - $(MAKE) INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' INSTALL_SCRIPT='$(INSTALL_PROGRAM)' install -installdirs: - - -mostlyclean-generic: - -test -z "$(MOSTLYCLEANFILES)" || rm -f $(MOSTLYCLEANFILES) - -clean-generic: - -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) - -distclean-generic: - -rm -f Makefile $(DISTCLEANFILES) - -rm -f config.cache config.log stamp-h stamp-h[0-9]* - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -maintainer-clean-generic: - -test -z "$(MAINTAINERCLEANFILES)" || rm -f $(MAINTAINERCLEANFILES) - -test -z "$(BUILT_SOURCES)" || rm -f $(BUILT_SOURCES) -mostlyclean: mostlyclean-generic - -clean: clean-generic mostlyclean - -distclean: distclean-generic clean - -rm -f config.status - -rm -f libtool - -maintainer-clean: maintainer-clean-generic distclean - @echo "This command is intended for maintainers to use;" - @echo "it deletes files that may require special tools to rebuild." - -.PHONY: tags distdir info dvi installcheck install-exec install-data \ -install uninstall all installdirs mostlyclean-generic distclean-generic \ -clean-generic maintainer-clean-generic clean mostlyclean distclean \ -maintainer-clean - - -# Tell versions [3.59,3.63) of GNU make to not export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: diff --git a/qt/md/_sparc.s b/qt/md/_sparc.s deleted file mode 100644 index 1d8adc77e..000000000 --- a/qt/md/_sparc.s +++ /dev/null @@ -1,142 +0,0 @@ -/* sparc.s -- assembly support for the `qt' thread building kit. */ - -/* - * 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. - */ - -/* #include <machine/trap.h> */ - - .text - .align 4 - .global _qt_blocki - .global _qt_block - .global _qt_abort - .global _qt_start - .global _qt_vstart - -/* Register assignment: -// %o0: incoming `helper' function to call after cswap -// also used as outgoing sp of old thread (qt_t *) -// %o1, %o2: -// parameters to `helper' function called after cswap -// %o3: sp of new thread -// %o5: tmp used to save old thread sp, while using %o0 -// to call `helper' f() after cswap. -// -// -// Aborting a thread is easy if there are no cached register window -// frames: just switch to the new stack and away we go. If there are -// cached register window frames they must all be written back to the -// old stack before we move to the new stack. If we fail to do the -// writeback then the old stack memory can be written with register -// window contents e.g., after the stack memory has been freed and -// reused. -// -// If you don't believe this, try setting the frame pointer to zero -// once we're on the new stack. This will not affect correctnes -// otherwise because the frame pointer will eventually get reloaded w/ -// the new thread's frame pointer. But it will be zero briefly before -// the reload. You will eventually (100,000 cswaps later on a small -// SPARC machine that I tried) get an illegal instruction trap from -// the kernel trying to flush a cached window to location 0x0. -// -// Solution: flush windows before switching stacks, which invalidates -// all the other register windows. We could do the trap -// conditionally: if we're in the lowest frame of a thread, the fp is -// zero already so we know there's nothing cached. But we expect most -// aborts will be done from a first function that does a `save', so we -// will rarely save anything and always pay the cost of testing to see -// if we should flush. -// -// All floating-point registers are caller-save, so this routine -// doesn't need to do anything to save and restore them. -// -// `qt_block' and `qt_blocki' return the same value as the value -// returned by the helper function. We get this ``for free'' -// since we don't touch the return value register between the -// return from the helper function and return from qt_block{,i}. -*/ - -_qt_block: -_qt_blocki: - sub %sp, 8, %sp /* Allocate save area for return pc. */ - st %o7, [%sp+64] /* Save return pc. */ -_qt_abort: - ta 0x03 /* Save locals and ins. */ - mov %sp, %o5 /* Remember old sp w/o chng ins/locals. */ - sub %o3, 64, %sp /* Allocate kwsa, switch stacks. */ - call %o0, 0 /* Call `helper' routine. */ - mov %o5, %o0 /* Pass old thread to qt_after_t() */ - /* .. along w/ args in %o1 & %o2. */ - - /* Restore callee-save regs. The kwsa - // is on this stack, so offset all - // loads by sizeof(kwsa), 64 bytes. - */ - ldd [%sp+ 0+64], %l0 - ldd [%sp+ 8+64], %l2 - ldd [%sp+16+64], %l4 - ldd [%sp+24+64], %l6 - ldd [%sp+32+64], %i0 - ldd [%sp+40+64], %i2 - ldd [%sp+48+64], %i4 - ldd [%sp+56+64], %i6 - ld [%sp+64+64], %o7 /* Restore return pc. */ - - retl /* Return to address in %o7. */ - add %sp, 72, %sp /* Deallocate kwsa, ret pc area. */ - - -/* The function calling conventions say there has to be a 1-word area -// in the caller's stack to hold a pointer to space for aggregate -// return values. It also says there should be a 6-word area to hold -// %o0..%o5 if the callee wants to save them (why? I don't know...) -// Round up to 8 words to maintain alignment. -// -// Parameter values were stored in callee-save regs and are moved to -// the parameter registers. -*/ -_qt_start: - mov %i1, %o0 /* `pu': Set up args to `only'. */ - mov %i2, %o1 /* `pt'. */ - mov %i4, %o2 /* `userf'. */ - call %i5, 0 /* Call client function. */ - sub %sp, 32, %sp /* Allocate 6-word callee space. */ - - call _qt_error, 0 /* `only' erroniously returned. */ - nop - - -/* Same comments as `_qt_start' about allocating rounded-up 7-word -// save areas. */ - -_qt_vstart: - sub %sp, 32, %sp /* Allocate 7-word callee space. */ - call %i5, 0 /* call `startup'. */ - mov %i2, %o0 /* .. with argument `pt'. */ - - add %sp, 32, %sp /* Use 7-word space in varargs. */ - ld [%sp+ 4+64], %o0 /* Load arg0 ... */ - ld [%sp+ 8+64], %o1 - ld [%sp+12+64], %o2 - ld [%sp+16+64], %o3 - ld [%sp+20+64], %o4 - call %i4, 0 /* Call `userf'. */ - ld [%sp+24+64], %o5 - - /* Use 6-word space in varargs. */ - mov %o0, %o1 /* Pass return value from userf */ - call %i3, 0 /* .. when call `cleanup. */ - mov %i2, %o0 /* .. along with argument `pt'. */ - - call _qt_error, 0 /* `cleanup' erroniously returned. */ - nop diff --git a/qt/md/_sparc_b.s b/qt/md/_sparc_b.s deleted file mode 100644 index cd26672d7..000000000 --- a/qt/md/_sparc_b.s +++ /dev/null @@ -1,106 +0,0 @@ -/* - * 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. - */ - - .globl _b_call_reg - .globl _b_call_imm - .globl _b_add - .globl _b_load - -_b_null: - retl - nop - -_b_call_reg: - sethi %hi(_b_null),%o4 - or %o4,%lo(_b_null),%o4 - add %o7,%g0, %o3 -L0: - call %o4 - nop - call %o4 - nop - call %o4 - nop - call %o4 - nop - call %o4 - nop - - subcc %o0,1,%o0 - bg L0 - nop - add %o3,%g0, %o7 - retl - nop - -_b_call_imm: - sethi %hi(_b_null),%o4 - or %o4,%lo(_b_null),%o4 - add %o7,%g0, %o3 -L1: - call _b_null - call _b_null - call _b_null - call _b_null - call _b_null - - subcc %o0,1,%o0 - bg L0 - nop - add %o3,%g0, %o7 - retl - nop - - -_b_add: - add %o0,%g0,%o1 - add %o0,%g0,%o2 - add %o0,%g0,%o3 - add %o0,%g0,%o4 -L2: - sub %o0,5,%o0 - sub %o1,5,%o1 - sub %o2,5,%o2 - sub %o3,5,%o3 - sub %o4,5,%o4 - - subcc %o0,5,%o0 - sub %o1,5,%o1 - sub %o2,5,%o2 - sub %o3,5,%o3 - sub %o4,5,%o4 - - bg L2 - nop - retl - nop - - -_b_load: - ld [%sp+ 0], %g0 -L3: - ld [%sp+ 4],%g0 - ld [%sp+ 8],%g0 - ld [%sp+12],%g0 - ld [%sp+16],%g0 - ld [%sp+20],%g0 - ld [%sp+24],%g0 - ld [%sp+28],%g0 - ld [%sp+32],%g0 - ld [%sp+36],%g0 - - subcc %o0,10,%o0 - bg L3 - ld [%sp+ 0],%g0 - retl - nop diff --git a/qt/md/axp.1.Makefile b/qt/md/axp.1.Makefile deleted file mode 100644 index 86ccd8f42..000000000 --- a/qt/md/axp.1.Makefile +++ /dev/null @@ -1,5 +0,0 @@ - -# -# Compiling for the DEC AXP (alpha) with GNU CC or version 1.x of OSF. -# -CC = cc -std1 -D__AXP__ -D__OSF1__ diff --git a/qt/md/axp.2.Makefile b/qt/md/axp.2.Makefile deleted file mode 100644 index 268636fc9..000000000 --- a/qt/md/axp.2.Makefile +++ /dev/null @@ -1,5 +0,0 @@ - -# -# Compiling for the DEC AXP (alpha) with GNU CC or version 2.x of OSF. -# -CC = cc -std1 -D__AXP__ -D__OSF2__ diff --git a/qt/md/axp.Makefile b/qt/md/axp.Makefile deleted file mode 100644 index 4e6d74da4..000000000 --- a/qt/md/axp.Makefile +++ /dev/null @@ -1,5 +0,0 @@ - -# -# GNU CC -# -CC = gcc -D__AXP__ diff --git a/qt/md/axp.README b/qt/md/axp.README deleted file mode 100644 index b6a705c07..000000000 --- a/qt/md/axp.README +++ /dev/null @@ -1,10 +0,0 @@ -The handling of varargs is platform-dependent. Assar Westerlund -stared at the problem for a while and deduces the following table: - -vers / compiler cc gcc ----------------------------------------------------------------------- -1.3 a0, offset __base, __offset -2.0 _a0, _offset __base, __offset - -The current code should handle both cc and gcc versions, provided -you configure for the correct compiler. diff --git a/qt/md/axp.c b/qt/md/axp.c deleted file mode 100644 index 26c15c0ea..000000000 --- a/qt/md/axp.c +++ /dev/null @@ -1,133 +0,0 @@ -/* - * 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. - */ - -#include <stdarg.h> -#include "qt.h" - - -/* Varargs is harder on the AXP. Parameters are saved on the stack as - something like (stack grows down to low memory; low at bottom of - picture): - - | : - | arg6 - +--- - | iarg5 - | : - | iarg3 <-- va_list._a0 + va_list._offset - | : - | iarg0 <-- va_list._a0 - +--- - | farg5 - | : - | farg0 - +--- - - When some of the arguments have known type, there is no need to - save all of them in the struct. So, for example, if the routine is - called - - zork (int a0, float a1, int a2, ...) - { - va_list ap; - va_start (ap, a2); - qt_vargs (... &ap ...); - } - - then offset is set to 3 * 8 (8 === sizeof machine word) = 24. - - What this means for us is that the user's routine needs to be - called with an arg list where some of the words in the `any type' - parameter list have to be split and moved up in to the int/fp - region. - - Ways in which this can fail: - - The user might not know the size of the pushed arguments anyway. - - Structures have funny promotion rules. - - Probably lots of other things. - - All in all, we never promised varargs would work reliably. */ - - - -#define QT_VADJ(sp) (((char *)sp) - QT_VSTKBASE) - -#define QT_VARGS_MD0(sp, vabytes) \ - ((qt_t *)(((char *)(sp)) - 6*2*8 - QT_STKROUNDUP(vabytes))) - -extern void qt_vstart(void); -#define QT_VARGS_MD1(sp) (QT_SPUT (sp, QT_R26, qt_vstart)) - - -/* Different machines use different implementations for varargs. - Unfortunately, the code below ``looks in to'' the varargs - structure, `va_list', and thus depends on the conventions. - The following #defines try to deal with it but don't catch - everything. */ - -#ifdef __GNUC__ -#define _a0 __base -#define _offset __offset -#else -#ifdef __OSF1__ -#define _a0 a0 -#define _offset offset -#endif -#endif /* def __GNUC__ */ - - - struct qt_t * -qt_vargs (struct qt_t *qsp, int nbytes, struct va_list *vargs, - void *pt, qt_function_t *startup, - qt_function_t *vuserf, qt_function_t *cleanup) -{ - va_list ap; - int i; - int max; /* Maximum *words* of args to copy. */ - int tmove; /* *Words* of args moved typed->typed. */ - qt_word_t *sp; - - ap = *(va_list *)vargs; - qsp = QT_VARGS_MD0 (qsp, nbytes); - sp = (qt_word_t *)qsp; - - tmove = 6 - ap._offset/sizeof(qt_word_t); - - /* Copy from one typed area to the other. */ - for (i=0; i<tmove; ++i) { - /* Integer args: */ - sp[i+6] = ((qt_word_t *)(ap._a0 + ap._offset))[i]; - /* Fp args: */ - sp[i] = ((qt_word_t *)(ap._a0 + ap._offset))[i-6]; - } - - max = nbytes/sizeof(qt_word_t); - - /* Copy from the untyped area to the typed area. Split each arg. - in to integer and floating-point save areas. */ - for (; i<6 && i<max; ++i) { - sp[i] = sp[i+6] = ((qt_word_t *)(ap._a0 + ap._offset))[i]; - } - - /* Copy from the untyped area to the other untyped area. */ - for (; i<max; ++i) { - sp[i+6] = ((qt_word_t *)(ap._a0 + ap._offset))[i]; - } - - QT_VARGS_MD1 (QT_VADJ(sp)); - QT_SPUT (QT_VADJ(sp), QT_VARGT_INDEX, pt); - QT_SPUT (QT_VADJ(sp), QT_VSTARTUP_INDEX, startup); - QT_SPUT (QT_VADJ(sp), QT_VUSERF_INDEX, vuserf); - QT_SPUT (QT_VADJ(sp), QT_VCLEANUP_INDEX, cleanup); - return ((qt_t *)QT_VADJ(sp)); -} diff --git a/qt/md/axp.h b/qt/md/axp.h deleted file mode 100644 index ff951a0d3..000000000 --- a/qt/md/axp.h +++ /dev/null @@ -1,160 +0,0 @@ -/* - * 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. - */ - -#ifndef QT_AXP_H -#define QT_AXP_H - -#define QT_GROW_DOWN - -typedef unsigned long qt_word_t; - - -/* Stack layout on the Alpha: - - Integer: - - Caller-save: r0..r8, r22..r25, r27..r29 - argument/caller-save: r16..r21 - callee-save: r9..r15 - return pc *callee-save*: r26 - stack pointer: r30 - zero: r31 - - Floating-point: - - Caller-save: f0..f1, f10..f15 - argument/caller-save: f16..f21, f22..f30 - callee-save: f2..f9 - zero: f31 - - Non-varargs: - - +--- - | padding - | f9 - | f8 - | f7 - | f6 - | f5 - | f4 - | f3 - | f2 - | r26 - +--- - | padding - | r29 - | r15 - | r14 - | r13 - | r12 on startup === `only' - | r11 on startup === `userf' - | r10 on startup === `qt' - | r9 on startup === `qu' - | r26 on startup === qt_start <--- qt.sp - +--- - - Conventions for varargs startup: - - | : - | arg6 - | iarg5 - | : - | iarg0 - | farg5 - | : - | farg0 - +--- - | padding - | r29 - | r15 - | r14 - | r13 - | r12 on startup === `startup' - | r11 on startup === `vuserf' - | r10 on startup === `cleanup' - | r9 on startup === `qt' - | r26 on startup === qt_vstart <--- qt.sp - +--- - - Note: this is a pretty cheap/sleazy way to get things going, - but ``there must be a better way.'' For instance, some varargs - parameters could be loaded in to integer registers, or the return - address could be stored on top of the stack. */ - - -/* Stack must be 16-byte aligned. */ -#define QT_STKALIGN (16) - -/* How much space is allocated to hold all the crud for - initialization: 7 registers times 8 bytes/register. */ - -#define QT_STKBASE (10 * 8) -#define QT_VSTKBASE QT_STKBASE - - -/* Offsets of various registers. */ -#define QT_R26 0 -#define QT_R9 1 -#define QT_R10 2 -#define QT_R11 3 -#define QT_R12 4 - - -/* When a never-before-run thread is restored, the return pc points - to a fragment of code that starts the thread running. For - non-vargs functions, it just calls the client's `only' function. - For varargs functions, it calls the startup, user, and cleanup - functions. - - The varargs startup routine always reads 12 8-byte arguments from - the stack. If fewer argumets were pushed, the startup routine - would read off the top of the stack. To prevent errors we always - allocate enough space. When there are fewer args, the preallocated - words are simply wasted. */ - -extern void qt_start(void); -#define QT_ARGS_MD(sp) (QT_SPUT (sp, QT_R26, qt_start)) - - -/* The AXP uses a struct for `va_list', so pass a pointer to the - struct. This may break some uses of `QT_VARGS', but then we never - claimed it was totally portable. */ - -typedef void (qt_function_t)(void); - -struct qt_t; -struct va_list; -extern struct qt_t *qt_vargs (struct qt_t *sp, int nbytes, - struct va_list *vargs, void *pt, - qt_function_t *startup, - qt_function_t *vuserf, - qt_function_t *cleanup); - -#define QT_VARGS(sp, nbytes, vargs, pt, startup, vuserf, cleanup) \ - (qt_vargs (sp, nbytes, (struct va_list *)(&(vargs)), pt, \ - (qt_function_t *) startup, (qt_function_t *)vuserf, \ - (qt_function_t *)cleanup)); - - -/* The *index* (positive offset) of where to put each value. */ -#define QT_ONLY_INDEX (QT_R12) -#define QT_USER_INDEX (QT_R11) -#define QT_ARGT_INDEX (QT_R10) -#define QT_ARGU_INDEX (QT_R9) - -#define QT_VCLEANUP_INDEX (QT_R10) -#define QT_VUSERF_INDEX (QT_R11) -#define QT_VSTARTUP_INDEX (QT_R12) -#define QT_VARGT_INDEX (QT_R9) - -#endif /* ndef QT_AXP_H */ diff --git a/qt/md/axp.s b/qt/md/axp.s deleted file mode 100644 index 1f8555c51..000000000 --- a/qt/md/axp.s +++ /dev/null @@ -1,160 +0,0 @@ - # - # 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. - # - - # axp.s -- assembly support. - - .text - .align 4 - .file 2 "axp.s" - - .globl qt_block - .globl qt_blocki - .globl qt_abort - .globl qt_start - .globl qt_vstart - - # - # $16: ptr to function to call once curr is suspended - # and control is on r19's stack. - # $17: 1'th arg to (*$16)(...). - # $18: 2'th arg to (*$16)(...). - # $19: sp of thread to resume. - # - # The helper routine returns a value that is passed on as the - # return value from the blocking routine. Since we don't - # touch r0 between the helper's return and the end of - # function, we get this behavior for free. - # - - .ent qt_blocki -qt_blocki: - subq $30,80, $30 # Allocate save area. - stq $26, 0($30) # Save registers. - stq $9, 8($30) - stq $10,16($30) - stq $11,24($30) - stq $12,32($30) - stq $13,40($30) - stq $14,48($30) - stq $15,56($30) - stq $29,64($30) - .end qt_blocki - .ent qt_abort -qt_abort: - addq $16,$31, $27 # Put argument function in PV. - addq $30,$31, $16 # Save stack ptr in outgoing arg. - addq $19,$31, $30 # Set new stack pointer. - jsr $26,($27),0 # Call helper function. - - ldq $26, 0($30) # Restore registers. - ldq $9, 8($30) - ldq $10,16($30) - ldq $11,24($30) - ldq $12,32($30) - ldq $13,40($30) - ldq $14,48($30) - ldq $15,56($30) - ldq $29,64($30) - - addq $30,80, $30 # Deallocate save area. - ret $31,($26),1 # Return, predict===RET. - .end qt_abort - - - # - # Non-varargs thread startup. - # - .ent qt_start -qt_start: - addq $9,$31, $16 # Load up `qu'. - addq $10,$31, $17 # ... user function's `pt'. - addq $11,$31, $18 # ... user function's `userf'. - addq $12,$31, $27 # ... set procedure value to `only'. - jsr $26,($27),0 # Call `only'. - - jsr $26,qt_error # `only' erroniously returned. - .end qt_start - - - .ent qt_vstart -qt_vstart: - # Call startup function. - addq $9,$31, $16 # Arg0 to `startup'. - addq $12,$31, $27 # Set procedure value. - jsr $26,($27),0 # Call `startup'. - - # Call user function. - ldt $f16, 0($30) # Load fp arg regs. - ldt $f17, 8($30) - ldt $f18,16($30) - ldt $f19,24($30) - ldt $f20,32($30) - ldt $f21,40($30) - ldq $16,48($30) # And integer arg regs. - ldq $17,56($30) - ldq $18,64($30) - ldq $19,72($30) - ldq $20,80($30) - ldq $21,88($30) - addq $30,96, $30 # Pop 6*2*8 saved arg regs. - addq $11,$31, $27 # Set procedure value. - jsr $26,($27),0 # Call `vuserf'. - - # Call cleanup. - addq $9,$31, $16 # Arg0 to `cleanup'. - addq $0,$31, $17 # Users's return value is arg1. - addq $10,$31, $27 # Set procedure value. - jsr $26,($27),0 # Call `cleanup'. - - jsr $26,qt_error # Cleanup erroniously returned. - .end qt_start - - - # - # Save calle-save floating-point regs $f2..$f9. - # Also save return pc from whomever called us. - # - # Return value from `qt_block' is the same as the return from - # `qt_blocki'. We get that for free since we don't touch $0 - # between the return from `qt_blocki' and the return from - # `qt_block'. - # - .ent qt_block -qt_block: - subq $30,80, $30 # Allocate a save space. - stq $26, 0($30) # Save registers. - stt $f2, 8($30) - stt $f3,16($30) - stt $f4,24($30) - stt $f5,32($30) - stt $f6,40($30) - stt $f7,48($30) - stt $f8,56($30) - stt $f9,64($30) - - jsr $26,qt_blocki # Call helper. - # .. who will also restore $gp. - - ldq $26, 0($30) # restore registers. - ldt $f2, 8($30) - ldt $f3,16($30) - ldt $f4,24($30) - ldt $f5,32($30) - ldt $f6,40($30) - ldt $f7,48($30) - ldt $f8,56($30) - ldt $f9,64($30) - - addq $30,80, $30 # Deallcate save space. - ret $31,($26),1 # Return, predict===RET. - .end qt_block diff --git a/qt/md/axp_b.s b/qt/md/axp_b.s deleted file mode 100644 index 82194d52c..000000000 --- a/qt/md/axp_b.s +++ /dev/null @@ -1,111 +0,0 @@ - # - # 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. - # - - .text - .globl b_call_reg - .globl b_call_imm - .globl b_add - .globl b_load - - .ent b_null -b_null: - ret $31,($18),1 - .end b_null - - .ent b_call_reg -b_call_reg: - lda $27,b_null -$L0: - jsr $18,($27) - jsr $18,($27) - jsr $18,($27) - jsr $18,($27) - jsr $18,($27) - - jsr $18,($27) - jsr $18,($27) - jsr $18,($27) - jsr $18,($27) - jsr $18,($27) - - subq $16,1,$16 - bgt $16,$L0 - - ret $31,($26),1 - .end - - - .ent b_call_imm -b_call_imm: -$L1: - jsr $18,b_null - jsr $18,b_null - jsr $18,b_null - jsr $18,b_null - jsr $18,b_null - - jsr $18,b_null - jsr $18,b_null - jsr $18,b_null - jsr $18,b_null - jsr $18,b_null - - subq $16,1,$16 - bgt $16,$L1 - - ret $31,($26),1 - .end - - - .ent b_add -b_add: -$L2: - addq $31,$31,$31 - addq $31,$31,$31 - addq $31,$31,$31 - addq $31,$31,$31 - addq $31,$31,$31 - - addq $31,$31,$31 - addq $31,$31,$31 - addq $31,$31,$31 - addq $31,$31,$31 - addq $31,$31,$31 - - subq $16,1,$16 - bgt $16,$L2 - - ret $31,($26),1 - .end - - - .ent b_load -b_load: -$L3: - ldq $31,0($30) - ldq $31,8($30) - ldq $31,16($30) - ldq $31,24($30) - ldq $31,32($30) - - ldq $31,0($30) - ldq $31,8($30) - ldq $31,16($30) - ldq $31,24($30) - ldq $31,32($30) - - subq $16,1,$16 - bgt $16,$L3 - - ret $31,($26),1 - .end diff --git a/qt/md/default.Makefile b/qt/md/default.Makefile deleted file mode 100644 index e240ca270..000000000 --- a/qt/md/default.Makefile +++ /dev/null @@ -1,6 +0,0 @@ - -# -# `Normal' configuration. -# -CC = gcc -ansi -Wall -pedantic - diff --git a/qt/md/hppa-cnx.Makefile b/qt/md/hppa-cnx.Makefile deleted file mode 100644 index bff257d9f..000000000 --- a/qt/md/hppa-cnx.Makefile +++ /dev/null @@ -1,9 +0,0 @@ -# This file (cnx_spp.Makefile) is part of the port of QuickThreads for -# PA-RISC 1.1 architecture on a Convex SPP. This file is a machine dependent -# makefile for QuickThreads. It was written in 1994 by Uwe Reder -# (`uereder@cip.informatik.uni-erlangen.de') for the Operating Systems -# Department (IMMD4) at the University of Erlangen/Nuernberg Germany. - -# `Normal' configuration. - -CC = /usr/convex/bin/cc diff --git a/qt/md/hppa.Makefile b/qt/md/hppa.Makefile deleted file mode 100644 index a15e28c99..000000000 --- a/qt/md/hppa.Makefile +++ /dev/null @@ -1,9 +0,0 @@ -# This file (pa-risc.Makefile) is part of the port of QuickThreads for -# PA-RISC 1.1 architecture. This file is a machine dependent makefile -# for QuickThreads. It was written in 1994 by Uwe Reder -# (`uereder@cip.informatik.uni-erlangen.de') for the Operating Systems -# Department (IMMD4) at the University of Erlangen/Nuernberg Germany. - -# `Normal' configuration. - -CC = cc -Aa diff --git a/qt/md/hppa.h b/qt/md/hppa.h deleted file mode 100644 index 0df98de88..000000000 --- a/qt/md/hppa.h +++ /dev/null @@ -1,194 +0,0 @@ -/* - * 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. - */ - -/* - * This file (pa-risc.h) is part of the port of QuickThreads for the - * PA-RISC 1.1 architecture. This file is a machine dependent header - * file. It was written in 1994 by Uwe Reder - * (`uereder@cip.informatik.uni-erlangen.de') for the Operating Systems - * Department (IMMD4) at the University of Erlangen/Nuernberg Germany. - */ - - -#ifndef QT_PA_RISC_H -#define QT_PA_RISC_H - -#include <qt.h> - -/* size of an integer-register (32 bit) */ -typedef unsigned long qt_word_t; - -/* PA-RISC's stack grows up */ -#define QT_GROW_UP - -/* Stack layout on PA-RISC according to PA-RISC Procedure Calling Conventions: - - Callee-save registers are: gr3-gr18, fr12-fr21. - Also save gr2, return pointer. - - +--- - | fr12 Each floating register is a double word (8 bytes). - | fr13 Floating registers are only saved if `qt_block' is - | fr14 called, in which case it saves the floating-point - | fr15 registers then calls `qt_blocki' to save the integer - | fr16 registers. - | fr17 - | fr18 - | fr19 - | fr20 - | fr21 - | <arg word 3> fixed arguments (must be allocated; may remain unused) - | <arg word 2> - | <arg word 1> - | <arg word 0> - | <LPT> frame marker - | <LPT'> - | <RP'> - | <Current RP> - | <Static Link> - | <Clean Up> - | <RP''> - | <Previous SP> - +--- - | gr3 word each (4 bytes) - | gr4 - | gr5 - | gr6 - | gr7 - | gr8 - | gr9 - | gr10 - | gr11 - | gr12 - | gr13 - | gr14 - | gr15 - | gr16 - | gr17 - | gr18 - | <16 bytes filled in (sp has to be 64-bytes aligned)> - | <arg word 3> fixed arguments (must be allocated; may remain unused) - | <arg word 2> - | <arg word 1> - | <arg word 0> - | <LPT> frame marker - | <LPT'> - | <RP'> - | <Current RP> - | <Static Link> - | <Clean Up> - | <RP''> - | <Previous SP> - +--- <--- sp -*/ - -/* When a never-before-run thread is restored, the return pc points - to a fragment of code that starts the thread running. For - non-vargs functions, it just calls the client's `only' function. - For varargs functions, it calls the startup, user, and cleanup - functions. */ - -/* Note: Procedue Labels on PA-RISC - - <--2--><-------28---------><1-><1-> - ----------------------------------- - | SID | Adress Part | L | X | - ----------------------------------- - - On HP-UX the L field is used to flag wheather the procedure - label (plabel) is a pointer to an LT entry or to the entry point - of the procedure (PA-RISC Procedure Calling Conventions Reference - Manual, 5.3.2 Procedure Labels and Dynamic Calls). */ - -#define QT_PA_RISC_READ_PLABEL(plabel) \ - ( (((int)plabel) & 2) ? \ - ( (*((int *)(((int)plabel) & 0xfffffffc)))) : ((int)plabel) ) - -/* Stack must be 64 bytes aligned. */ -#define QT_STKALIGN (64) - -/* Internal helper for putting stuff on stack (negative index!). */ -#define QT_SPUT(top, at, val) \ - (((qt_word_t *)(top))[-(at)] = (qt_word_t)(val)) - -/* Offsets of various registers which are modified on the stack. - rp (return-pointer) has to be stored in the frame-marker-area - of the "older" stack-segment. */ - -#define QT_crp (12+4+16+5) -#define QT_15 (12+4+4) -#define QT_16 (12+4+3) -#define QT_17 (12+4+2) -#define QT_18 (12+4+1) - - -/** This stuff is for NON-VARARGS. **/ - -/* Stack looks like this (2 stack frames): - - <--- 64-bytes aligned --><------- 64-bytes aligned ------------> - | || | - <--16--><------48-------><----16*4-----><--16-><------48-------> - || | || | | || - ||filler|arg|frame-marker||register-save|filler|arg|frame-marker|| - ------------------------------------------------------------------ - */ - -#define QT_STKBASE (16+48+(16*sizeof(qt_word_t))+16+48) - -/* The index, relative to sp, of where to put each value. */ -#define QT_ONLY_INDEX (QT_15) -#define QT_USER_INDEX (QT_16) -#define QT_ARGT_INDEX (QT_17) -#define QT_ARGU_INDEX (QT_18) - -extern void qt_start(void); -#define QT_ARGS_MD(sp) \ - (QT_SPUT (sp, QT_crp, QT_PA_RISC_READ_PLABEL(qt_start))) - - -/** This is for VARARGS. **/ - -#define QT_VARGS_DEFAULT - -/* Stack looks like this (2 stack frames): - - <------ 64-bytes aligned -------><--------- 64-bytes aligned ----------> - | || | - <---?--><--?---><16><----32-----><----16*4-----><-16--><16><----32-----> - || | | | || | | | || - ||filler|varargs|arg|frame-marker||register-save|filler|arg|frame-marker|| - -------------------------------------------------------------------------- - */ - -/* Sp is moved to the end of the first stack frame. */ -#define QT_VARGS_MD0(sp, vasize) \ - ((qt_t *)(((char *)sp) + QT_STKROUNDUP(vasize + 4*4 + 32))) - -/* To reach the arguments from the end of the first stack frame use 32 - as a negative adjustment. */ -#define QT_VARGS_ADJUST(sp) ((qt_t *)(((char *)sp) - 32)) - -/* Offset to reach the end of the second stack frame. */ -#define QT_VSTKBASE ((16*sizeof(qt_word_t)) + 16 + 4*4 + 32) - -extern void qt_vstart(void); -#define QT_VARGS_MD1(sp) \ - (QT_SPUT (sp, QT_crp, QT_PA_RISC_READ_PLABEL(qt_vstart))) - -#define QT_VARGT_INDEX (QT_15) -#define QT_VSTARTUP_INDEX (QT_16) -#define QT_VUSERF_INDEX (QT_17) -#define QT_VCLEANUP_INDEX (QT_18) - -#endif /* ndef QT_PA_RISC_H */ diff --git a/qt/md/hppa.s b/qt/md/hppa.s deleted file mode 100644 index 84d8e875b..000000000 --- a/qt/md/hppa.s +++ /dev/null @@ -1,237 +0,0 @@ -; pa-risc.s -- assembly support. - -; 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. - -; This file (pa-risc.s) is part of the port of QuickThreads for -; PA-RISC 1.1 architecture. This file implements context switches -; and thread startup. It was written in 1994 by Uwe Reder -; (`uereder@cip.informatik.uni-erlangen.de') for the Operating -; Systems Department (IMMD4) at the University of Erlangen/Nuernberg -; Germany. - - -; Callee saves general registers gr3..gr18, -; floating-point registers fr12..fr21. - - .CODE - - .IMPORT $$dyncall, MILLICODE - .IMPORT qt_error, CODE - - .EXPORT qt_blocki, ENTRY - .EXPORT qt_block, ENTRY - .EXPORT qt_abort, ENTRY - .EXPORT qt_start, ENTRY - .EXPORT qt_vstart, ENTRY - - -; arg0: ptr to function (helper) to call once curr is suspended -; and control is on arg3's stack. -; arg1: 1'th arg to *arg0. -; arg2: 2'th arg to *arg0. -; arg3: sp of new thread. - -qt_blocki - .PROC - .CALLINFO CALLER, FRAME=0, SAVE_RP, ENTRY_GR=18 - .ENTRY - - stw %rp,-20(%sp) ; save rp to old frame-marker - - stwm %r3,128(%sp) ; save callee-saves general registers - stw %r4,-124(%sp) - stw %r5,-120(%sp) - stw %r6,-116(%sp) - stw %r7,-112(%sp) - stw %r8,-108(%sp) - stw %r9,-104(%sp) - stw %r10,-100(%sp) - stw %r11,-96(%sp) - stw %r12,-92(%sp) - stw %r13,-88(%sp) - stw %r14,-84(%sp) - stw %r15,-80(%sp) - stw %r16,-76(%sp) - stw %r17,-72(%sp) - stw %r18,-68(%sp) - -qt_abort - copy %arg0,%r22 ; helper to be called by $$dyncall - copy %sp,%arg0 ; pass current sp as arg0 to helper - copy %arg3,%sp ; set new sp - - .CALL - bl $$dyncall,%mrp ; call helper - copy %mrp,%rp - - ldw -68(%sp),%r18 ; restore general registers - ldw -72(%sp),%r17 - ldw -76(%sp),%r16 - ldw -80(%sp),%r15 - ldw -84(%sp),%r14 - ldw -88(%sp),%r13 - ldw -92(%sp),%r12 - ldw -96(%sp),%r11 - ldw -100(%sp),%r10 - ldw -104(%sp),%r9 - ldw -108(%sp),%r8 - ldw -112(%sp),%r7 - ldw -116(%sp),%r6 - ldw -120(%sp),%r5 - ldw -124(%sp),%r4 - - ldw -148(%sp),%rp ; restore return-pointer - - bv %r0(%rp) ; return to caller - ldwm -128(%sp),%r3 - - .EXIT - .PROCEND - - -qt_block - .PROC - .CALLINFO CALLER, FRAME=0, SAVE_RP, ENTRY_FR=21 - .ENTRY - - stw %rp,-20(%sp) ; save rp to old frame-marker - - fstds,ma %fr12,8(%sp) ; save callee-saves float registers - fstds,ma %fr13,8(%sp) - fstds,ma %fr14,8(%sp) - fstds,ma %fr15,8(%sp) - fstds,ma %fr16,8(%sp) - fstds,ma %fr17,8(%sp) - fstds,ma %fr18,8(%sp) - fstds,ma %fr19,8(%sp) - fstds,ma %fr20,8(%sp) - fstds,ma %fr21,8(%sp) - - .CALL - bl qt_blocki,%rp - ldo 48(%sp),%sp - - ldo -48(%sp),%sp - - fldds,mb -8(%sp),%fr21 ; restore callee-saves float registers - fldds,mb -8(%sp),%fr20 - fldds,mb -8(%sp),%fr19 - fldds,mb -8(%sp),%fr18 - fldds,mb -8(%sp),%fr17 - fldds,mb -8(%sp),%fr16 - fldds,mb -8(%sp),%fr15 - fldds,mb -8(%sp),%fr14 - fldds,mb -8(%sp),%fr13 - - ldw -28(%sp),%rp ; restore return-pointer - - bv %r0(%rp) ; return to caller. - fldds,mb -8(%sp),%fr12 - - .EXIT - .PROCEND - - -qt_start - .PROC - .CALLINFO CALLER, FRAME=0 - .ENTRY - - copy %r18,%arg0 ; set user arg `pu'. - copy %r17,%arg1 ; ... user function pt. - copy %r16,%arg2 ; ... user function userf. - ; %r22 is a caller-saves register - copy %r15,%r22 ; function to be called by $$dyncall - - .CALL ; in=%r22 - bl $$dyncall,%mrp ; call `only'. - copy %mrp,%rp - - bl,n qt_error,%r0 ; `only' erroniously returned. - - .EXIT - .PROCEND - - -; Varargs -; -; First, call `startup' with the `pt' argument. -; -; Next, call the user's function with all arguments. -; We don't know whether arguments are integers, 32-bit floating-points or -; even 64-bit floating-points, so we reload all the registers, possibly -; with garbage arguments. The thread creator provided non-garbage for -; the arguments that the callee actually uses, so the callee never gets -; garbage. -; -; -48 -44 -40 -36 -32 -; | arg3 | arg2 | arg1 | arg0 | -; ----------------------------- -; integers: arg3 arg2 arg1 arg0 -; 32-bit fps: farg3 farg2 farg1 farg0 -; 64-bit fps: <---farg3--> <---farg1--> -; -; Finally, call `cleanup' with the `pt' argument and with the return value -; from the user's function. It is an error for `cleanup' to return. - -qt_vstart - .PROC - .CALLINFO CALLER, FRAME=0 - .ENTRY - - ; Because the startup function may damage the fixed arguments - ; on the stack (PA-RISC Procedure Calling Conventions Reference - ; Manual, 2.4 Fixed Arguments Area), we allocate a seperate - ; stack frame for it. - ldo 64(%sp),%sp - - ; call: void startup(void *pt) - - copy %r15,%arg0 ; `pt' is arg0 to `startup'. - copy %r16,%r22 - .CALL - bl $$dyncall,%mrp ; Call `startup'. - copy %mrp,%rp - - ldo -64(%sp),%sp - - ; call: void *qt_vuserf_t(...) - - ldw -36(%sp),%arg0 ; Load args to integer registers. - ldw -40(%sp),%arg1 - ldw -44(%sp),%arg2 - ldw -48(%sp),%arg3 - ; Index of fld[w|d]s only ranges from -16 to 15, so we - ; take r22 to be our new base register. - ldo -32(%sp),%r22 - fldws -4(%r22),%farg0 ; Load args to floating-point registers. - fldds -8(%r22),%farg1 - fldws -12(%r22),%farg2 - fldds -16(%r22),%farg3 - copy %r17,%r22 - .CALL - bl $$dyncall,%mrp ; Call `userf'. - copy %mrp,%rp - - ; call: void cleanup(void *pt, void *vuserf_return) - - copy %r15,%arg0 ; `pt' is arg0 to `cleanup'. - copy %ret0,%arg1 ; Return-value is arg1 to `cleanup'. - copy %r18,%r22 - .CALL - bl $$dyncall,%mrp ; Call `cleanup'. - copy %mrp,%rp - - bl,n qt_error,%r0 - - .EXIT - .PROCEND diff --git a/qt/md/hppa_b.s b/qt/md/hppa_b.s deleted file mode 100644 index 1b1e8264e..000000000 --- a/qt/md/hppa_b.s +++ /dev/null @@ -1,203 +0,0 @@ -; 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. - -; This file (pa-risc_b.s) is part of the port of QuickThreads for -; PA-RISC 1.1 architecture. It contains assembly-level support for -; raw processor performance measurement. It was written in 1994 by -; Uwe Reder (`uereder@cip.informatik.uni-erlangen.de') -; for the Operating Systems Department (IMMD4) at the -; University of Erlangen/Nuernberg Germany. - - -; Note that the number of instructions in the measurement-loops, differ -; from implementation to implementation. I took eight instructions in a loop -; for every test (execute eight instructions and loop to the start). - - .CODE - - .IMPORT $global$,DATA - .IMPORT $$dyncall,MILLICODE - .EXPORT b_call_reg - .EXPORT b_call_imm - .EXPORT b_add - .EXPORT b_load - -; Just do nothing, only return to caller. This procedure is called by -; `b_call_reg' and `b_call_imm'. - -b_null - .PROC - .CALLINFO NO_CALLS, FRAME=0 - .ENTRY - - bv,n %r0(%rp) ; just return - - .EXIT - .PROCEND - -; Call the procedure `b_null' with function pointer in a register. - -b_call_reg - .PROC - .CALLINFO CALLER, FRAME=0 - .ENTRY - - stwm %r3,64(%sp) ; store r3 (may be used by caller) - stw %rp,-20(%sp) ; save return-pointer to frame-marker - - addil LR'to_call-$global$,%r27 - ldw RR'to_call-$global$(%r1),%r3 - -_loop0 - copy %r3,%r22 ; copy the procedure label to r22, ... - .CALL ; ...this is the input to $$dyncall - bl $$dyncall,%mrp ; call $$dyncall (millicode function) - copy %mrp,%rp ; remember the return-pointer - - copy %r3,%r22 - .CALL - bl $$dyncall,%mrp - copy %mrp,%rp - - copy %r3,%r22 - .CALL - bl $$dyncall,%mrp - copy %mrp,%rp - - copy %r3,%r22 - .CALL - bl $$dyncall,%mrp - copy %mrp,%rp - - copy %r3,%r22 - .CALL - bl $$dyncall,%mrp - copy %mrp,%rp - - copy %r3,%r22 - .CALL - bl $$dyncall,%mrp - copy %mrp,%rp - - copy %r3,%r22 - .CALL - bl $$dyncall,%mrp - copy %mrp,%rp - - copy %r3,%r22 - .CALL - bl $$dyncall,%mrp - copy %mrp,%rp - - addibf,<= -8,%arg0,_loop0 ; decrement counter by 8 and loop - nop - - ldw -20(%sp),%rp ; restore return-pointer - bv %r0(%rp) ; return to caller - ldwm -64(%sp),%r3 ; resore r3 and remove stack frame - - .EXIT - .PROCEND - -; Call the procedure `b_null' immediate. - -b_call_imm - .PROC - .CALLINFO CALLER, FRAME=0, SAVE_RP - .ENTRY - - ldo 64(%sp),%sp ; caller needs a stack-frame - stw %rp,-20(%sp) ; save return-pointer to frame-marker - -_loop1 - bl b_null,%rp ; call `b_null' immediate (8 times) - nop - bl b_null,%rp - nop - bl b_null,%rp - nop - bl b_null,%rp - nop - bl b_null,%rp - nop - bl b_null,%rp - nop - bl b_null,%rp - nop - bl b_null,%rp - nop - - addibf,<= -8,%arg0,_loop1 ; decrement counter by 8 and loop - nop - - ldw -20(%sp),%rp ; restore return-pointer - bv %r0(%rp) ; return to caller - ldo -64(%sp),%sp ; remove stack-frame - - .EXIT - .PROCEND - -; Copy register-to-register. -; On PA-RISC this is implemented with an `or'. -; The `or' is hidden by a pseudo-operation called `copy'. - -b_add - .PROC - .CALLINFO NO_CALLS, FRAME=0 - .ENTRY - -_loop2 - copy %r19,%r20 ; copy register-to-register - copy %r20,%r21 ; use caller-saves registers - copy %r21,%r22 - copy %r22,%r21 - copy %r21,%r20 - copy %r20,%r19 - copy %r19,%r20 - copy %r20,%r21 - - addibf,<= -8,%arg0,_loop2 ; decrement counter by 8 and loop - nop - - bv,n %r0(%rp) - - .EXIT - .PROCEND - -; Load memory to a register. - -b_load - .PROC - .CALLINFO NO_CALLS, FRAME=0 - .ENTRY - -_loop3 - ldw -4(%sp),%r22 ; load data from frame-marker - ldw -8(%sp),%r22 ; use a caller-saves register - ldw -12(%sp),%r22 - ldw -16(%sp),%r22 - ldw -20(%sp),%r22 - ldw -24(%sp),%r22 - ldw -28(%sp),%r22 - ldw -32(%sp),%r22 - - addibf,<= -8,%arg0,_loop3 ; decrement counter by 8 and loop - nop - - bv,n %r0(%rp) - - .EXIT - .PROCEND - - - .ALIGN 8 -to_call - .WORD b_null diff --git a/qt/md/i386.README b/qt/md/i386.README deleted file mode 100644 index 8ffb92198..000000000 --- a/qt/md/i386.README +++ /dev/null @@ -1,7 +0,0 @@ -Note that some machines want labels to have leading underscores, -while others (e.g. System V) do not. Thus, several labels appear -duplicated except for the leading underscore, e.g. - - _qt_cswap: - qt_cswap: - diff --git a/qt/md/i386.h b/qt/md/i386.h deleted file mode 100644 index 158fe2703..000000000 --- a/qt/md/i386.h +++ /dev/null @@ -1,120 +0,0 @@ -/* - * 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. - */ - -#ifndef QT_386_H -#define QT_386_H - -typedef unsigned long qt_word_t; - -/* Thread's initial stack layout on the i386: - - non-varargs: - - +--- - | arg[2] === `userf' on startup - | arg[1] === `pt' on startup - | arg[0] === `pu' on startup - +--- - | ret pc === qt_error - +--- - | ret pc === `only' on startup - +--- - | %ebp - | %esi - | %edi - | %ebx <--- qt_t.sp - +--- - - When a non-varargs thread is started, it ``returns'' directly to - the client's `only' function. - - varargs: - - +--- - | arg[n-1] - | .. - | arg[0] - +--- - | ret pc === `qt_vstart' - +--- - | %ebp === `startup' - | %esi === `cleanup' - | %edi === `pt' - | %ebx === `vuserf' <--- qt_t.sp - +--- - - When a varargs thread is started, it ``returns'' to the `qt_vstart' - startup code. The startup code calls the appropriate functions. */ - - -/* What to do to start a varargs thread running. */ -extern void qt_vstart (void); - - -/* Hold 4 saved regs plus two return pcs (qt_error, qt_start) plus - three args. */ -#define QT_STKBASE (9 * 4) - -/* Hold 4 saved regs plus one return pc (qt_vstart). */ -#define QT_VSTKBASE (5 * 4) - - -/* Stack must be 4-byte aligned. */ -#define QT_STKALIGN (4) - - -/* Where to place various arguments. */ -#define QT_ONLY_INDEX (QT_PC) -#define QT_USER_INDEX (QT_ARG2) -#define QT_ARGT_INDEX (QT_ARG1) -#define QT_ARGU_INDEX (QT_ARG0) - -#define QT_VSTARTUP_INDEX (QT_EBP) -#define QT_VUSERF_INDEX (QT_EBX) -#define QT_VCLEANUP_INDEX (QT_ESI) -#define QT_VARGT_INDEX (QT_EDI) - - -#define QT_EBX 0 -#define QT_EDI 1 -#define QT_ESI 2 -#define QT_EBP 3 -#define QT_PC 4 -/* The following are defined only for non-varargs. */ -#define QT_RPC 5 -#define QT_ARG0 6 -#define QT_ARG1 7 -#define QT_ARG2 8 - - -/* Stack grows down. The top of the stack is the first thing to - pop off (preincrement, postdecrement). */ -#define QT_GROW_DOWN - -extern void qt_error (void); - -/* Push on the error return address. */ -#define QT_ARGS_MD(sto) \ - (QT_SPUT (sto, QT_RPC, qt_error)) - - -/* When varargs are pushed, allocate space for all the args. */ -#define QT_VARGS_MD0(sto, nbytes) \ - ((qt_t *)(((char *)(sto)) - QT_STKROUNDUP(nbytes))) - -#define QT_VARGS_MD1(sto) \ - (QT_SPUT (sto, QT_PC, qt_vstart)) - -#define QT_VARGS_DEFAULT - -#endif /* QT_386_H */ diff --git a/qt/md/i386.s b/qt/md/i386.s deleted file mode 100644 index ed2c533d1..000000000 --- a/qt/md/i386.s +++ /dev/null @@ -1,108 +0,0 @@ -/* i386.s -- assembly support. */ - -/* -// 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. */ - -/* NOTE: double-labeled `_name' and `name' for System V compatability. */ -/* NOTE: Comment lines start with '/*' and '//' ONLY. Sorry! */ - -/* Callee-save: %esi, %edi, %ebx, %ebp -// Caller-save: %eax, %ecx -// Can't tell: %edx (seems to work w/o saving it.) -// -// Assignment: -// -// See ``i386.h'' for the somewhat unconventional stack layout. */ - - - .text - .align 2 - - .globl _qt_abort - .globl qt_abort - .globl _qt_block - .globl qt_block - .globl _qt_blocki - .globl qt_blocki - -/* These all have the type signature -// -// void *blocking (helper, arg0, arg1, new) -// -// On procedure entry, the helper is at 4(sp), args at 8(sp) and -// 12(sp) and the new thread's sp at 16(sp). It *appears* that the -// calling convention for the 8X86 requires the caller to save all -// floating-point registers, this makes our life easy. */ - -/* Halt the currently-running thread. Save it's callee-save regs on -// to the stack, 32 bytes. Switch to the new stack (next == 16+32(sp)) -// and call the user function (f == 4+32(sp) with arguments: old sp -// arg1 (8+32(sp)) and arg2 (12+32(sp)). When the user function is -// done, restore the new thread's state and return. -// -// `qt_abort' is (currently) an alias for `qt_block' because most of -// the work is shared. We could save the insns up to `qt_common' by -// replicating, but w/o replicating we need an inital subtract (to -// offset the stack as if it had been a qt_block) and then a jump -// to qt_common. For the cost of a jump, we might as well just do -// all the work. -// -// The helper function (4(sp)) can return a void* that is returned -// by the call to `qt_blockk{,i}'. Since we don't touch %eax in -// between, we get that ``for free''. */ - -_qt_abort: -qt_abort: -_qt_block: -qt_block: -_qt_blocki: -qt_blocki: - pushl %ebp /* Save callee-save, sp-=4. */ - pushl %esi /* Save callee-save, sp-=4. */ - pushl %edi /* Save callee-save, sp-=4. */ - pushl %ebx /* Save callee-save, sp-=4. */ - movl %esp, %eax /* Remember old stack pointer. */ - -qt_common: - movl 32(%esp), %esp /* Move to new thread. */ - pushl 28(%eax) /* Push arg 2. */ - pushl 24(%eax) /* Push arg 1. */ - pushl %eax /* Push arg 0. */ - movl 20(%eax), %ebx /* Get function to call. */ - call *%ebx /* Call f. */ - addl $12, %esp /* Pop args. */ - - popl %ebx /* Restore callee-save, sp+=4. */ - popl %edi /* Restore callee-save, sp+=4. */ - popl %esi /* Restore callee-save, sp+=4. */ - popl %ebp /* Restore callee-save, sp+=4. */ - ret /* Resume the stopped function. */ - hlt - - -/* Start a varargs thread. */ - - .globl _qt_vstart - .globl qt_vstart -_qt_vstart: -qt_vstart: - pushl %edi /* Push `pt' arg to `startup'. */ - call *%ebp /* Call `startup'. */ - popl %eax /* Clean up the stack. */ - - call *%ebx /* Call the user's function. */ - - pushl %eax /* Push return from user's. */ - pushl %edi /* Push `pt' arg to `cleanup'. */ - call *%esi /* Call `cleanup'. */ - - hlt /* `cleanup' never returns. */ diff --git a/qt/md/i386_b.s b/qt/md/i386_b.s deleted file mode 100644 index 32129a5d1..000000000 --- a/qt/md/i386_b.s +++ /dev/null @@ -1,30 +0,0 @@ -/* -// 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. */ - - .globl _b_call_reg - .globl b_call_reg - .globl _b_call_imm - .globl b_call_imm - .globl _b_add - .globl b_add - .globl _b_load - .globl b_load - -_b_call_reg: -b_call_reg: -_b_call_imm: -b_call_imm: -_b_add: -b_add: -_b_load: -b_load: - hlt diff --git a/qt/md/ksr1.Makefile b/qt/md/ksr1.Makefile deleted file mode 100644 index aa195839a..000000000 --- a/qt/md/ksr1.Makefile +++ /dev/null @@ -1,6 +0,0 @@ - -# -# KSR1 configuration. -# -CC = cc -ansi - diff --git a/qt/md/ksr1.h b/qt/md/ksr1.h deleted file mode 100644 index 83537a3c2..000000000 --- a/qt/md/ksr1.h +++ /dev/null @@ -1,164 +0,0 @@ -/* - * 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. - */ - -#ifndef QT_KSR1_H -#define QT_KSR1_H - -/* - Stack layout: - - Registers are saved in strictly low to high order, FPU regs first - (only if qt_block is called), CEU regs second, IPU regs next, with no - padding between the groups. - - Callee-save: f16..f63; c15..c30; i12..i30. - Args passed in i2..i5. - - Note: c31 is a private data pointer. It is not changed on thread - swaps with the assumption that it represents per-processor rather - than per-thread state. - - Note: i31 is an instruction count register that is updated by the - context switch routines. Like c31, it is not changed on context - switches. - - This is what we want on startup: - - - +------ <-- BOS: Bottom of stack (grows down) - | 80 (128 - 48) bytes of padding to a 128-byte boundary - +--- - | only - | userf - | t - | u - | qt_start$TXT - | (empty) <-- qt.sp - +------ <-- (BOS - 128) - - This is why we want this on startup: - - A thread begins running when the restore procedure switches thread stacks - and pops a return address off of the top of the new stack (see below - for the reason why we explicitly store qt_start$TXT). The - block procedure pushes two jump addresses on a thread's stack before - it switches stacks. The first is the return address for the block - procedure, and the second is a restore address. The return address - is used to jump back to the thread that has been switched to; the - restore address is a jump within the block code to restore the registers. - Normally, this is just a jump to the next address. However, on thread - startup, this is a jump to qt_start$TXT. (The block procedure stores - the restore address at an offset of 8 bytes from the top of the stack, - which is also the offset at which qt_start$TXT is stored on the stacks - of new threads. Hence, when the block procedure switches to a new - thread stack, it will initially jump to qt_start$TXT; thereafter, - it jumps to the restore code.) - - qt_start$TXT, after it has read the initial data on the new thread's - stack and placed it in registers, pops the initial stack frame - and gives the thread the entire stack to use for execution. - - The KSR runtime system has an unusual treatment of pointers to - functions. From C, taking the `name' of a function yields a - pointer to a _constant block_ and *not* the address of the - function. The zero'th entry in the constant block is a pointer to - the function. - - We have to be careful: the restore procedure expects a return - address on the top of the stack (pointed to by qt.sp). This is not - a problem when restoring a thread that has run before, since the - block routine would have stored the return address on top of the - stack. However, when ``faking up'' a thread start (bootstrapping a - thread stack frame), the top of the stack needs to contain a - pointer to the code that will start the thread running. - - The pointer to the startup code is *not* `qt_start'. It is the - word *pointed to* by `qt_start'. Thus, we dereference `qt_start', - see QT_ARGS_MD below. - - On varargs startup (still unimplemented): - - | padding to 128 byte boundary - | varargs <-- padded to a 128-byte-boundary - +--- - | caller's frame, 16 bytes - | 80 bytes of padding (frame padded to a 128-byte boundary) - +--- - | cleanup - | vuserf - | startup - | t - +--- - | qt_start <-- qt.sp - +--- - - Of a suspended thread: - - +--- - | caller's frame, 16 bytes - | fpu registers 47 regs * 8 bytes/reg 376 bytes - | ceu registers 16 regs * 8 bytes/reg 128 bytes - | ipu registers 19 regs * 8 bytes/reg 152 bytes - | : - | 80 bytes of padding - | : - | qt_restore <-- qt.sp - +--- - - */ - - -#define QT_STKALIGN 128 -#define QT_GROW_DOWN -typedef unsigned long qt_word_t; - -#define QT_STKBASE QT_STKALIGN -#define QT_VSTKBASE QT_STKBASE - -extern void qt_start(void); -/* - * See the discussion above for what indexing into a procedure ptr - * does for us (it's lovely, though, isn't it?). - * - * This assumes that the address of a procedure's code is the - * first word in a procedure's constant block. That's how the manual - * says it will be arranged. - */ -#define QT_ARGS_MD(sp) (QT_SPUT (sp, 1, ((qt_word_t *)qt_start)[0])) - -/* - * The *index* (positive offset) of where to put each value. - * See the picture of the stack above that explains the offsets. - */ -#define QT_ONLY_INDEX (5) -#define QT_USER_INDEX (4) -#define QT_ARGT_INDEX (3) -#define QT_ARGU_INDEX (2) - -#define QT_VARGS_DEFAULT -#define QT_VARGS(sp, nb, vargs, pt, startup, vuserf, cleanup) \ - (qt_vargs (sp, nbytes, &vargs, pt, startup, vuserf, cleanup)) - - -#define QT_VARGS_MD0(sp, vabytes) \ - ((qt_t *)(((char *)(sp)) - 4*8 - QT_STKROUNDUP(vabytes))) - -extern void qt_vstart(void); -#define QT_VARGS_MD1(sp) (QT_SPUT (sp, 0, ((qt_word_t *)qt_vstart)[0])) - -#define QT_VCLEANUP_INDEX (4) -#define QT_VUSERF_INDEX (3) -#define QT_VSTARTUP_INDEX (2) -#define QT_VARGT_INDEX (1) - -#endif /* def QT_KSR1_H */ diff --git a/qt/md/ksr1.s b/qt/md/ksr1.s deleted file mode 100644 index d4d51a0a6..000000000 --- a/qt/md/ksr1.s +++ /dev/null @@ -1,424 +0,0 @@ -/* - * 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. - */ - - .file "ksr1.s" - .def .debug; .endef - - .align 128 - .globl qt_blocki - .globl qt_blocki$TXT - .globl qt_block - .globl qt_block$TXT - .globl qt_start$TXT - .globl qt_start - .globl qt_abort$TXT - .globl qt_abort - .globl qt_vstart - .globl qt_vstart$TXT - -# -# KSR convention: on procedure calls, load both the procedure address -# and a pointer to a constant block. The address of function `f' is -# `f$TXT', and the constant block address is `f'. The constant block -# has several reserved values: -# -# 8 bytes fpu register save mask -# 4 bytes ipu register save mask -# 4 bytes ceu register save mask -# f: f$TXT -# ... whatever you want ... (not quite...read on) -# -# Note, by the way, that a pointer to a function is passed as a -# pointer to the constant area, and the constant area has the text -# address. -# - -# -# Procedures that do not return structures prefix their code with -# -# proc$TXT: -# finop; cxnop -# finop; cxnop -# <proc code> -# -# Calls to those procedures branch to a 16 byte offset (4 instrs) in -# to the procedure to skip those instructions. -# -# Procedures that return structures use a different code prefix: -# -# proc$TXT: -# finop; beq.qt %rc, %rc, 24 # return value entry -# finop; cxnop -# finop; movi8 0, %rc # no return value entry -# <proc code> -# -# Calls that want the returned structure branch directly to the -# procedure address. Callers that don't want (or aren't expecting) a -# return value branche 16 bytes in to the procedure, which will zero -# %rc, telling the called procedure not to return a structure. -# - -# -# On entry: -# %i2 -- control block of helper function to run -# (dereference to get helper) -# %i3 -- a1 -# %i4 -- a2 -# %i5 -- sp of new to run -# - - .data - .half 0x0, 0x0, 0x7ffff000, 0x7fff8000 -qt_blocki: -qt_abort: - .word qt_blocki$TXT - .word qt_restore$TXT - - .text -qt_abort$TXT: -qt_blocki$TXT: - finop ; cxnop # entry prefix - finop ; cxnop # entry prefix - add8.ntr 75,%i31,%i31 ; movi8 512,%c5 # ICR; stk adjust - finop ; ssub8.ntr 0,%sp,%c5,%sp - finop ; st8 %fp,504(%sp) # Save caller's fp - finop ; st8 %cp,496(%sp) # Save caller's cp - finop ; ld8 8(%c10),%c5 # ld qt_restore$TXT - finop ; st8 %c14,0(%sp) # Save special ret addr - finop ; mov8_8 %c10, %cp # Our cp - finop ; sadd8.ntr 0,%sp,%c5,%fp # Our frame ptr - finop ; st8 %c5,8(%sp) # st qt_restore$TXT -# -# CEU registers %c15-%c24, %c26-%c30 (%c14 we restore later) -# - finop ; st8 %c15,456(%sp) - finop ; st8 %c16,448(%sp) - finop ; st8 %c17,440(%sp) - finop ; st8 %c18,432(%sp) - finop ; st8 %c19,424(%sp) - finop ; st8 %c20,416(%sp) - finop ; st8 %c21,408(%sp) - finop ; st8 %c22,400(%sp) - finop ; st8 %c23,392(%sp) - finop ; st8 %c24,384(%sp) -# -# %c25 is the Enclosing Frame Pointer (EFP) -- since C doesn't -# use nested procedures, we ignore it (leaving a gap, though) -# - finop ; st8 %c26,368(%sp) - finop ; st8 %c27,360(%sp) - finop ; st8 %c28,352(%sp) - finop ; st8 %c29,344(%sp) - finop ; st8 %c30,336(%sp) -# -# IPU registers %i12-%i30 -# - finop ; st8 %i12,328(%sp) - finop ; st8 %i13,320(%sp) - finop ; st8 %i14,312(%sp) - finop ; st8 %i15,304(%sp) -# (gap to get alignment for st64) -# -- Doesn't work on version 1.1.3 of the OS -# finop ; st64 %i16,256(%sp) - - finop ; st8 %i16,256(%sp) - finop ; st8 %i17,248(%sp) - finop ; st8 %i18,240(%sp) - finop ; st8 %i19,232(%sp) - finop ; st8 %i20,224(%sp) - finop ; st8 %i21,216(%sp) - finop ; st8 %i22,208(%sp) - finop ; st8 %i23,200(%sp) - finop ; st8 %i24,192(%sp) - finop ; st8 %i25,184(%sp) - finop ; st8 %i26,176(%sp) - finop ; st8 %i27,168(%sp) - finop ; st8 %i28,160(%sp) - finop ; st8 %i29,152(%sp) - finop ; st8 %i30,144(%sp) -# -# FPU already saved, or saving not necessary -# - -# -# Switch to the stack passed in as fourth argument to the block -# routine (%i5) and call the helper routine passed in as the first -# argument (%i2). Note that the address of the helper's constant -# block is passed in, so we must derefence it to get the helper's text -# address. -# - finop ; movb8_8 %i2,%c10 # helper's ConstBlock - finop ; cxnop # Delay slot, fill w/ - finop ; cxnop # .. 2 st8 from above - finop ; ld8 0(%c10),%c4 # load addr of helper - finop ; movb8_8 %sp, %i2 # 1st arg to helper - # is this stack; other - # args remain in regs - finop ; movb8_8 %i5,%sp # switch stacks - finop ; jsr %c14,16(%c4) # call helper - movi8 3, %i0 ; movi8 0,%c8 # nargs brain dmg - finop ; cxnop - finop ; cxnop -# -# Here is where behavior differs for threads being restored and threads -# being started. Blocked threads have a pointer to qt_restore$TXT on -# the top of their stacks; manufactured stacks have a pointer to qt_start$TXT -# on the top of their stacks. With this setup, starting threads -# skip the (unecessary) restore operations. -# -# We jump to an offset of 16 to either (1) skip past the two noop pairs -# at the start of qt_start$TXT, or (2) skip past the two noop pairs -# after qt_restore$TXT. -# - finop ; ld8 8(%sp),%c4 - finop ; cxnop - finop ; cxnop - finop ; jmp 16(%c4) -qt_restore$TXT: - finop ; cxnop - finop ; cxnop -# -# Point of Restore: -# -# The helper funtion will return here. Any result it has placed in -# a return register (most likely %i0) will not get overwritten below -# and will consequently be the return value of the blocking routine. -# - -# -# CEU registers %c15-%c24, %c26-%c30 (%c14 we restore later) -# - finop ; ld8 456(%sp),%c15 - finop ; ld8 448(%sp),%c16 - finop ; ld8 440(%sp),%c17 - finop ; ld8 432(%sp),%c18 - finop ; ld8 424(%sp),%c19 - finop ; ld8 416(%sp),%c20 - finop ; ld8 408(%sp),%c21 - finop ; ld8 400(%sp),%c22 - finop ; ld8 392(%sp),%c23 - finop ; ld8 384(%sp),%c24 -# -# %c25 is the Enclosing Frame Pointer (EFP) -- since C doesn't -# use nested procedures, we ignore it (leaving a gap, though) -# - finop ; ld8 368(%sp),%c26 - finop ; ld8 360(%sp),%c27 - finop ; ld8 352(%sp),%c28 - finop ; ld8 344(%sp),%c29 - finop ; ld8 336(%sp),%c30 -# -# IPU registers %i12-%i30 -# - finop ; ld8 328(%sp),%i12 - finop ; ld8 320(%sp),%i13 - finop ; ld8 312(%sp),%i14 - finop ; ld8 304(%sp),%i15 -# (gap to get alignment for ld64) -# -- Doesn't work on version 1.1.3 of the OS -# finop ; ld64 256(%sp),%i16 - - finop ; ld8 256(%sp),%i16 - finop ; ld8 248(%sp),%i17 - finop ; ld8 240(%sp),%i18 - finop ; ld8 232(%sp),%i19 - finop ; ld8 224(%sp),%i20 - finop ; ld8 216(%sp),%i21 - finop ; ld8 208(%sp),%i22 - finop ; ld8 200(%sp),%i23 - finop ; ld8 192(%sp),%i24 - finop ; ld8 184(%sp),%i25 - finop ; ld8 176(%sp),%i26 - finop ; ld8 168(%sp),%i27 - finop ; ld8 160(%sp),%i28 - finop ; ld8 152(%sp),%i29 - finop ; ld8 144(%sp),%i30 - -# -# FPU registers don't need to be loaded, or will be loaded by an -# enclosing scope (e.g., if this is called by qt_block). -# - -# -# Load the special registers. We don't load the stack ptr because -# the new stack is passed in as an argument, we don't load the EFP -# because we don't use it, and we load the return address specially -# off the top of the stack. -# - finop ; ld8 0(%sp),%c14 # return addr - finop ; ld8 496(%sp),%cp - finop ; ld8 504(%sp),%fp - - finop ; jmp 32(%c14) # jump back to thread - finop ; movi8 512,%c5 # stack adjust - finop ; sadd8.ntr 0,%sp,%c5,%sp - - .data - .half 0x0, 0x0, 0x7ffff000, 0x7fff8000 -qt_block: - .word qt_block$TXT - .word qt_error - .word qt_error$TXT - .word qt_blocki -# -# Handle saving and restoring the FPU regs, relying on qt_blocki -# to save and restore the remaining registers. -# - .text -qt_block$TXT: - finop ; cxnop # entry prefix - finop ; cxnop # entry prefix - - add8.ntr 29,%i31,%i31 ; movi8 512,%c5 # ICR; stk adjust - finop ; ssub8.ntr 0,%sp,%c5,%sp - finop ; st8 %fp,504(%sp) # Save caller's fp - finop ; st8 %cp,496(%sp) # Save caller's cp - finop ; st8 %c14,488(%sp) # store ret addr - finop ; sadd8.ntr 0,%sp,%c5,%fp # Our frame ptr - finop ; mov8_8 %c10, %cp # Our cp - -# -# Store 8 registers at once...destination must be a multiple of 64 -# - finop ; st64 %f16,384(%sp) - finop ; st64 %f24,320(%sp) - finop ; st64 %f32,256(%sp) - finop ; st64 %f40,192(%sp) - finop ; st64 %f48,128(%sp) - finop ; st64 %f56,64(%sp) - -# -# Call the integer blocking routine, passing the arguments passed to us -# - finop ; ld8 24(%cp), %c10 - finop ; cxnop - finop ; jsr %c14, qt_blocki$TXT - finop ; cxnop - finop ; cxnop - movi8 4,%i0 ; movi8 0,%c8 # nargs brain dmg - -# -# Load 8 registers at once...source must be a multiple of 64 -# - finop ; ld64 64(%sp),%f56 - finop ; ld64 128(%sp),%f48 - finop ; ld64 192(%sp),%f40 - finop ; ld64 256(%sp),%f32 - finop ; ld64 320(%sp),%f24 - finop ; ld64 384(%sp),%f16 - - finop ; ld8 488(%sp),%c14 - finop ; ld8 496(%sp),%cp - finop ; ld8 504(%sp),%fp - finop ; jmp 32(%c14) # jump back to thread - finop ; movi8 512,%c5 # stack adjust - finop ; sadd8.ntr 0,%sp,%c5,%sp - - - .data - .half 0x0, 0x0, 0x7ffff000, 0x7fff8000 -qt_start: - .word qt_start$TXT -# -# A new thread is set up to "appear" as if it were executing code at -# the beginning of qt_start and then it called a blocking routine -# (qt_blocki). So when a new thread starts to run, it gets unblocked -# by the code above and "returns" to `qt_start$TXT' in the -# restore step of the switch. Blocked threads jump to 16(qt_restore$TXT), -# and starting threads jump to 16(qt_start$TXT). -# - .text -qt_start$TXT: - finop ; cxnop # - finop ; cxnop # - finop ; ld8 40(%sp),%c10 # `only' constant block - finop ; ld8 32(%sp),%i4 # `userf' arg. - finop ; ld8 24(%sp),%i3 # `t' arg. - finop ; ld8 0(%c10),%c4 # `only' text location - finop ; ld8 16(%sp),%i2 # `u' arg. - finop ; cxnop - finop ; jsr %c14,16(%c4) # call `only' -# -# Pop the frame used to store the thread's initial data -# - finop ; sadd8.ntr 0,%sp,128,%sp - finop ; cxnop - movi8 2,%i0 ; movi8 0,%c8 # nargs brain dmg -# -# If we ever return, it's an error. -# - finop ; jmp qt_error$TXT - finop ; cxnop - finop ; cxnop - movi8 0,%i0 ; movi8 0,%c8 # nargs brain dmg - - -# -# This stuff is broken -# - .data - .half 0x0, 0x0, 0x7ffff000, 0x7fff8000 -qt_vstart: - .word qt_vstart$TXT - - .text -qt_vstart$TXT: - finop ; cxnop # entry prefix - finop ; cxnop # entry prefix - finop ; cxnop - finop ; cxnop - add8.ntr 11,%i31,%i31 ; movi8 512,%c5 - finop ; ssub8.ntr 0,%sp,%c5,%sp # fix stack - finop ; ld8 8(%sp),%i2 # load `t' as arg to - finop ; cxnop # `startup' - finop ; cxnop - finop ; ld8 16(%sp),%c10 # `startup' const block - finop ; cxnop - finop ; cxnop - finop ; ld8 0(%c10),%c4 # `startup' text loc. - finop ; cxnop - finop ; cxnop - finop ; jsr %c14,16(%c4) # call `startup' - finop ; cxnop - finop ; cxnop - movi8 1, %i0 ; movi8 0,%c8 # nargs brain dmg -# -# finop ; sadd 0,%sp,128,%sp # alter stack -# - finop ; ld8 8(%sp),%i2 # load `t' as arg to - finop ; ld8 8(%sp),%i2 # load `t' as arg to - finop ; ld8 8(%sp),%i2 # load `t' as arg to - finop ; ld8 8(%sp),%i2 # load `t' as arg to - - finop ; ld8 32(%sp),%c10 # `only' constant block - finop ; ld8 8(%sp),%i2 # `u' arg. - finop ; ld8 16(%sp),%i3 # `t' arg. - finop ; ld8 0(%c10),%c4 # `only' text location - finop ; ld8 24(%sp),%i4 # `userf' arg. - finop ; cxnop - finop ; jsr %c4,16(%c4) # call `only' - finop ; cxnop - finop ; cxnop -# -# If the callee ever calls `nargs', the following instruction (pair) -# will be executed. However, we don't know when we compile this code -# how many args are being passed. So we give our best guess: 0. -# - movi8 0,%i0 ; movi8 0,%c8 # nargs brain dmg -# -# If we ever return, it's an error. -# - finop ; jmp qt_error$TXT - finop ; cxnop - finop ; cxnop - movi8 0,%i0 ; movi8 0,%c8 # nargs brain dmg diff --git a/qt/md/ksr1_b.s b/qt/md/ksr1_b.s deleted file mode 100644 index 80b0c59eb..000000000 --- a/qt/md/ksr1_b.s +++ /dev/null @@ -1,49 +0,0 @@ -/* - * 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. - */ - - .file "ksr1_b.s" - .def .debug; .endef - - .globl b_call_reg$TXT - .globl b_call_reg - .globl b_call_imm$TXT - .globl b_call_imm - .globl b_add$TXT - .globl b_add - .globl b_load$TXT - .globl b_load - - -b_call_reg: -b_call_imm: -b_add: -b_load: - .word b_call_reg$TXT - .word qt_error - .word qt_error$TXT - - -b_call_reg$TXT: -b_call_imm$TXT: -b_add$TXT: -b_load$TXT: - finop ; cxnop - finop ; cxnop - finop ; ld8 16(%cp),%c4 - finop ; ld8 8(%cp),%cp - finop ; cxnop - finop ; cxnop - finop ; jsr %c4,0(%c4) - finop ; cxnop - finop ; cxnop - diff --git a/qt/md/m88k.Makefile b/qt/md/m88k.Makefile deleted file mode 100644 index 608c70690..000000000 --- a/qt/md/m88k.Makefile +++ /dev/null @@ -1,6 +0,0 @@ - -# -# Hosted compilers for 88k for Meerkat. -# -CC = gcc88 -Dm88k -ansi -pedantic -Wall -fno-builtin -AS = as88 diff --git a/qt/md/m88k.c b/qt/md/m88k.c deleted file mode 100644 index 9e3ae8ba8..000000000 --- a/qt/md/m88k.c +++ /dev/null @@ -1,111 +0,0 @@ -/* - * 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. - */ - -#include <stdarg.h> -#include "qt.h" - -/* Varargs is harder on the m88k. Parameters are saved on the stack as - something like (stack grows down to low memory; low at bottom of - picture): - - | : - | arg8 <-- va_list.__va_stk - +--- - | : - +--- - | arg7 - | : - | iarg0 <-- va_list.__va_reg - +--- - | : - | va_list { __va_arg, __va_stk, __va_reg } - | : - +--- - - Here, `va_list.__va_arg' is the number of word-size arguments - that have already been skipped. Doubles must be double-arligned. - - What this means for us is that the user's routine needs to be - called with an arg list where some of the words in the `__va_stk' - part of the parameter list have to be promoted to registers. - - BUG: doubleword register arguments must be double-aligned. If - something is passed as an even # arg and used as an odd # arg or - vice-versa, the code in the called routine (in the new thread) that - decides how to adjust the index will get it wrong, because it will - be expect it to be, say, doubleword aligned and it will really be - singleword aligned. - - I'm not sure you can solve this without knowing the types of all - the arguments. All in all, we never promised varargs would work - reliably. */ - - - -#define QT_VADJ(sp) (((char *)sp) - QT_VSTKBASE) - -/* Always allocate at least enough space for 8 args; waste some space - at the base of the stack to ensure the startup routine doesn't read - off the end of the stack. */ - -#define QT_VARGS_MD0(sp, vabytes) \ - ((qt_t *)(((char *)(sp)) - 8*4 - QT_STKROUNDUP(vabytes))) - -extern void qt_vstart(void); -#define QT_VARGS_MD1(sp) (QT_SPUT (sp, QT_1, qt_vstart)) - - - struct qt_t * -qt_vargs (struct qt_t *qsp, int nbytes, void *vargs, - void *pt, qt_function_t *startup, - qt_function_t *vuserf, qt_function_t *cleanup) -{ - va_list ap; - int i; - int n; /* Number of words into original arg list. */ - qt_word_t *sp; - int *reg; /* Where to read passed-in-reg args. */ - int *stk; /* Where to read passed-on-stk args. */ - - ap = *(va_list *)vargs; - qsp = QT_VARGS_MD0 (qsp, nbytes); - sp = (qt_word_t *)qsp; - - reg = (ap.__va_arg < 8) - ? &ap.__va_reg[ap.__va_arg] - : 0; - stk = &ap.__va_stk[8]; - n = ap.__va_arg; - for (i=0; i<nbytes/sizeof(qt_word_t) && n<8; ++i,++n) { - sp[i] = *reg++; - } - for (; i<nbytes/sizeof(qt_word_t); ++i) { - sp[i] = *stk++; - } - -#ifdef QT_NDEF - for (i=0; i<nbytes/sizeof(qt_word_t); ++i) { - sp[i] = (n < 8) - ? *reg++ - : *stk++; - ++n; - } -#endif - - QT_VARGS_MD1 (QT_VADJ(sp)); - QT_SPUT (QT_VADJ(sp), QT_VARGT_INDEX, pt); - QT_SPUT (QT_VADJ(sp), QT_VSTARTUP_INDEX, startup); - QT_SPUT (QT_VADJ(sp), QT_VUSERF_INDEX, vuserf); - QT_SPUT (QT_VADJ(sp), QT_VCLEANUP_INDEX, cleanup); - return ((qt_t *)QT_VADJ(sp)); -} diff --git a/qt/md/m88k.h b/qt/md/m88k.h deleted file mode 100644 index df7e07a85..000000000 --- a/qt/md/m88k.h +++ /dev/null @@ -1,159 +0,0 @@ -/* - * 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. - */ - -#ifndef QT_M88K_H -#define QT_M88K_H - -typedef unsigned long qt_word_t; - -#define QT_GROW_DOWN - -/* Stack layout on the mips: - - Callee-save registers are: $16-$23, $30; $f20-$f30. - Also save $31, return pc. - - Non-varargs: - - +--- - | r30 (fp) on startup === 0 - | r25 - | r24 - | r23 - | r22 - | r21 - | r20 - | r19 - | r18 - | r17 on startup === `only' - | r16 on startup === `userf' - | r15 on startup === `pt' - | r14 on startup === `pu' - | r1 on startup === `qt_start' - | 0 - | 0 - +--- - | 0 - | ... (8 regs worth === 32 bytes of homing area) - | 0 <--- sp - +--- - - Conventions for varargs: - - | : - | arg8 - +--- - | r30 (fp) arg7 - | r25 arg6 - | r24 arg5 - | r23 arg4 - | r22 arg3 - | r21 arg2 - | r20 arg1 - | r19 arg0 - | r18 - | r17 on startup === `startup' - | r16 on startup === `vuserf' - | r15 on startup === `pt' - | r14 on startup === `cleanup' - | r1 on startup === `qt_vstart' - | 0 - | 0 - +--- - | 0 - | ... (8 regs worth === 32 bytes of homing area) - | 0 <--- sp - +--- - - */ - - -/* Stack must be doubleword aligned. */ -#define QT_STKALIGN (16) /* Doubleword aligned. */ - -/* How much space is allocated to hold all the crud for - initialization: saved registers plus padding to keep the stack - aligned plus 8 words of padding to use as a `homing area' (for - r2-r9) when calling helper functions on the stack of the (not yet - started) thread. The varargs save area is small because it gets - overlapped with the top of the parameter list. In case the - parameter list is less than 8 args, QT_ARGS_MD0 adds some dead - space at the top of the stack. */ - -#define QT_STKBASE (16*4 + 8*4) -#define QT_VSTKBASE (8*4 + 8*4) - - -/* Index of various registers. */ -#define QT_1 (8+2) -#define QT_14 (8+3) -#define QT_15 (8+4) -#define QT_16 (8+5) -#define QT_17 (8+6) -#define QT_30 (8+15) - - -/* When a never-before-run thread is restored, the return pc points - to a fragment of code that starts the thread running. For - non-vargs functions, it sets up arguments and calls the client's - `only' function. For varargs functions, the startup code calls the - startup, user, and cleanup functions. - - For non-varargs functions, we set the frame pointer to 0 to - null-terminate the call chain. - - For varargs functions, the frame pointer register is used to hold - one of the arguments, so that all arguments can be laid out in - memory by the conventional `qt_vargs' varargs initialization - routine. - - The varargs startup routine always reads 8 words of arguments from - the stack. If there are less than 8 words of arguments, then the - arg list could call off the top of the stack. To prevent fall-off, - always allocate 8 words. */ - -extern void qt_start(void); -#define QT_ARGS_MD(sp) \ - (QT_SPUT (sp, QT_1, qt_start), \ - QT_SPUT (sp, QT_30, 0)) - - -/* The m88k uses a struct for `va_list', so pass a pointer to the - struct. */ - -typedef void (qt_function_t)(void); - -struct qt_t; -extern struct qt_t *qt_vargs (struct qt_t *sp, int nbytes, - void *vargs, void *pt, - qt_function_t *startup, - qt_function_t *vuserf, - qt_function_t *cleanup); - -#define QT_VARGS(sp, nbytes, vargs, pt, startup, vuserf, cleanup) \ - (qt_vargs (sp, nbytes, &(vargs), pt, (qt_function_t *)startup, \ - (qt_function_t *)vuserf, (qt_function_t *)cleanup)) - - -/* The *index* (positive offset) of where to put each value. */ -#define QT_ONLY_INDEX (QT_17) -#define QT_USER_INDEX (QT_16) -#define QT_ARGT_INDEX (QT_15) -#define QT_ARGU_INDEX (QT_14) - -#define QT_VCLEANUP_INDEX (QT_14) -#define QT_VUSERF_INDEX (QT_16) -#define QT_VSTARTUP_INDEX (QT_17) -#define QT_VARGT_INDEX (QT_15) - -#endif /* ndef QT_M88K_H */ diff --git a/qt/md/m88k.s b/qt/md/m88k.s deleted file mode 100644 index 42467e8d5..000000000 --- a/qt/md/m88k.s +++ /dev/null @@ -1,132 +0,0 @@ -/* m88k.s -- assembly support. */ - -/* - * 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. - */ - -/* Callee-save r14..r25, r31(sp), r30(fp). r1 === return pc. - * Argument registers r2..r9, return value r2..r3. - * - * On startup, restore regs so retpc === call to a function to start. - * - * We're going to call a function (r2) from within the context switch - * routine. Call it on the new thread's stack on behalf of the old - * thread. - */ - - .globl _qt_block - .globl _qt_blocki - .globl _qt_abort - .globl _qt_start - .globl _qt_vstart - - /* - ** r2: ptr to function to call once curr is suspended - ** and control is on r5's stack. - ** r3: 1'th arg to *r2. - ** r4: 2'th arg to *r2. - ** r5: sp of thread to suspend. - ** - ** The helper routine returns a value that is passed on as the - ** return value from the blocking routine. Since we don't - ** touch r2 between the helper's return and the end of - ** function, we get this behavior for free. - ** - ** Same entry for integer-only and floating-point, since there - ** are no separate integer and floating-point registers. - ** - ** Each procedure call sets aside a ``home region'' of 8 regs - ** for r2-r9 for varargs. For context switches we don't use - ** the ``home region'' for varargs so use it to save regs. - ** Allocate 64 bytes of save space -- use 32 bytes of register - ** save area passed in to us plus 32 bytes we allcated, use - ** the other 32 bytes for save area for a save area to call - ** the helper function. - */ -_qt_block: -_qt_blocki: - sub r31, r31,64 /* Allocate reg save space. */ - st r1, r31,8+32 /* Save callee-save registers. */ - st r14, r31,12+32 - st.d r15, r31,16+32 - st.d r17, r31,24+32 - st.d r19, r31,32+32 - st.d r21, r31,40+32 - st.d r23, r31,48+32 - st r25, r31,56+32 - st r30, r31,60+32 - -_qt_abort: - addu r14, r31,0 /* Remember old sp. */ - addu r31, r5,0 /* Set new sp. */ - jsr.n r2 /* Call helper. */ - addu r2, r14,0 /* Pass old sp as an arg0 to helper. */ - - ld r1, r31,8+32 /* Restore callee-save registers. */ - ld r14, r31,12+32 - ld.d r15, r31,16+32 - ld.d r17, r31,24+32 - ld.d r19, r31,32+32 - ld.d r21, r31,40+32 - ld.d r23, r31,48+32 - ld r25, r31,56+32 - ld r30, r31,60+32 - - jmp.n r1 /* Return to new thread's caller. */ - addu r31, r31,64 /* Free register save space. */ - - - /* - ** Non-varargs thread startup. - ** See `m88k.h' for register use conventions. - */ -_qt_start: - addu r2, r14,0 /* Set user arg `pu'. */ - addu r3, r15,0 /* ... user function pt. */ - jsr.n r17 /* Call `only'. */ - addu r4, r16,0 /* ... user function userf. */ - - bsr _qt_error /* `only' erroniously returned. */ - - - /* - ** Varargs thread startup. - ** See `m88k.h' for register use conventions. - ** - ** Call the `startup' function with just argument `pt'. - ** Then call `vuserf' with 8 register args plus any - ** stack args. - ** Then call `cleanup' with `pt' and the return value - ** from `vuserf'. - */ -_qt_vstart: - addu r18, r30,0 /* Remember arg7 to `vuserf'. */ - addu r30, r0,0 /* Null-terminate call chain. */ - - jsr.n r17 /* Call `startup'. */ - addu r2, r15,0 /* `pt' is arg0 to `startup'. */ - - addu r2, r19,0 /* Set arg0. */ - addu r3, r20,0 /* Set arg1. */ - addu r4, r21,0 /* Set arg2. */ - addu r5, r22,0 /* Set arg3. */ - addu r6, r23,0 /* Set arg4. */ - addu r7, r24,0 /* Set arg5. */ - addu r8, r25,0 /* Set arg6. */ - jsr.n r16 /* Call `vuserf'. */ - addu r9, r18,0 /* Set arg7. */ - - addu r3, r2,0 /* Ret. value is arg1 to `cleanup'. */ - jsr.n r14 /* Call `cleanup'. */ - addu r2, r15,0 /* `pt' is arg0 to `cleanup'. */ - - bsr _qt_error /* `cleanup' erroniously returned. */ diff --git a/qt/md/m88k_b.s b/qt/md/m88k_b.s deleted file mode 100644 index 1926e6ae8..000000000 --- a/qt/md/m88k_b.s +++ /dev/null @@ -1,117 +0,0 @@ -/* - * 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. - */ - - .text - .globl _b_call_reg - .globl _b_call_imm - .globl _b_add - .globl _b_load - -_b_null: - jmp r1 - -_b_call_reg: - subu r31, r31,8 /* Alloc ret pc save space. */ - st r1, r31,32 /* Save ret pc. */ - or.u r3, r0,hi16(_b_null) /* Put call addr in a reg. */ - or r3, r3,lo16(_b_null) - jsr r3 -L0: - jsr r3 - jsr r3 - jsr r3 - jsr.n r3 - subu r2, r2,5 /* Decrement #of iter to go. */ - bcnd.n gt0,r2,L0 - jsr r3 - - ld r1, r31,32 - jmp r1 - - -_b_call_imm: - subu r31, r31,8 /* Alloc ret pc save space. */ - st r1, r31,32 /* Save ret pc. */ - bsr _b_null -L1: - bsr _b_null - bsr _b_null - bsr _b_null - bsr.n _b_null - subu r2, r2,5 /* Decrement #of iter to go. */ - bcnd.n gt0,r2,L1 - bsr _b_null - - ld r1, r31,32 - jmp r1 - -_b_add: - add r0, r3,r4 -L2: - add r3, r4,r5 - add r4, r5,r6 - add r5, r6,r7 - add r8, r9,r0 - add r0, r3,r4 - add r3, r4,r5 - add r4, r5,r6 - add r5, r6,r7 - add r8, r9,r0 - - add r0, r3,r4 - add r3, r4,r5 - add r4, r5,r6 - add r5, r6,r7 - add r8, r9,r0 - add r0, r3,r4 - add r3, r4,r5 - add r4, r5,r6 - add r5, r6,r7 - add r8, r9,r0 - - subu r2, r2,20 /* Decrement #of iter to go. */ - bcnd.n gt0,r2,L2 - add r0, r3,r4 - - jmp r1 - - -_b_load: - ld r0, r31,0 -L3: - ld r3, r31,4 - ld r4, r31,8 - ld r5, r31,12 - ld r6, r31,16 - ld r0, r31,0 - ld r3, r31,4 - ld r4, r31,8 - ld r5, r31,12 - ld r6, r31,16 - - ld r0, r31,0 - ld r3, r31,4 - ld r4, r31,8 - ld r5, r31,12 - ld r6, r31,16 - ld r0, r31,0 - ld r3, r31,4 - ld r4, r31,8 - ld r5, r31,12 - ld r6, r31,16 - - subu r2, r2,20 /* Decrement #of iter to go. */ - bcnd.n gt0,r2,L3 - ld r0, r31,0 - - jmp r1 diff --git a/qt/md/mips-irix5.s b/qt/md/mips-irix5.s deleted file mode 100644 index 234a953ed..000000000 --- a/qt/md/mips-irix5.s +++ /dev/null @@ -1,182 +0,0 @@ -/* mips.s -- assembly support. */ - -/* - * 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. - */ - -/* Callee-save $16-$23, $30-$31. - * - * $25 is used as a procedure value pointer, used to discover constants - * in a callee. Thus, each caller here sets $25 before the call. - * - * On startup, restore regs so retpc === call to a function to start. - * We're going to call a function ($4) from within this routine. - * We're passing 3 args, therefore need to allocate 12 extra bytes on - * the stack for a save area. The start routine needs a like 16-byte - * save area. Must be doubleword aligned (_mips r3000 risc - * architecture_, gerry kane, pg d-23). - */ - -/* - * Modified by Assar Westerlund <assar@sics.se> to support Irix 5.x - * calling conventions for dynamically-linked code. - */ - - /* Make this position-independent code. */ - .option pic2 - - .globl qt_block - .globl qt_blocki - .globl qt_abort - .globl qt_start - .globl qt_vstart - - /* - ** $4: ptr to function to call once curr is suspended - ** and control is on $7's stack. - ** $5: 1'th arg to $4. - ** $6: 2'th arg to $4 - ** $7: sp of thread to suspend. - ** - ** Totally gross hack: The MIPS calling convention reserves - ** 4 words on the stack for a0..a3. This routine "ought" to - ** allocate space for callee-save registers plus 4 words for - ** the helper function, but instead we use the 4 words - ** provided by the function that called us (we don't need to - ** save our argument registers). So what *appears* to be - ** allocating only 40 bytes is actually allocating 56, by - ** using the caller's 16 bytes. - ** - ** The helper routine returns a value that is passed on as the - ** return value from the blocking routine. Since we don't - ** touch $2 between the helper's return and the end of - ** function, we get this behavior for free. - */ -qt_blocki: - sub $sp,$sp,40 /* Allocate reg save space. */ - sw $16, 0+16($sp) - sw $17, 4+16($sp) - sw $18, 8+16($sp) - sw $19,12+16($sp) - sw $20,16+16($sp) - sw $21,20+16($sp) - sw $22,24+16($sp) - sw $23,28+16($sp) - sw $30,32+16($sp) - sw $31,36+16($sp) - add $2, $sp,$0 /* $2 <= old sp to pass to func@$4. */ -qt_abort: - add $sp, $7,$0 /* $sp <= new sp. */ - .set noreorder - add $25, $4,$0 /* Set helper function procedure value. */ - jal $31,$25 /* Call helper func@$4 . */ - add $4, $2,$0 /* $a0 <= pass old sp as a parameter. */ - .set reorder - lw $31,36+16($sp) /* Restore callee-save regs... */ - lw $30,32+16($sp) - lw $23,28+16($sp) - lw $22,24+16($sp) - lw $21,20+16($sp) - lw $20,16+16($sp) - lw $19,12+16($sp) - lw $18, 8+16($sp) - lw $17, 4+16($sp) - lw $16, 0+16($sp) /* Restore callee-save */ - - add $sp,$sp,40 /* Deallocate reg save space. */ - j $31 /* Return to caller. */ - - /* - ** Non-varargs thread startup. - ** Note: originally, 56 bytes were allocated on the stack. - ** The thread restore routine (_blocki/_abort) removed 40 - ** of them, which means there is still 16 bytes for the - ** argument area required by the MIPS calling convention. - */ -qt_start: - add $4, $16,$0 /* Load up user function pu. */ - add $5, $17,$0 /* ... user function pt. */ - add $6, $18,$0 /* ... user function userf. */ - add $25, $19,$0 /* Set `only' procedure value. */ - jal $31,$25 /* Call `only'. */ - la $25,qt_error /* Set `qt_error' procedure value. */ - j $25 - - - /* - ** Save calle-save floating-point regs $f20-$f30 - ** See comment in `qt_block' about calling conventinos and - ** reserved space. Use the same trick here, but here we - ** actually have to allocate all the bytes since we have to - ** leave 4 words leftover for `qt_blocki'. - ** - ** Return value from `qt_block' is the same as the return from - ** `qt_blocki'. We get that for free since we don't touch $2 - ** between the return from `qt_blocki' and the return from - ** `qt_block'. - */ -qt_block: - sub $sp, $sp,56 /* 6 8-byte regs, saved ret pc, aligned. */ - swc1 $f20, 0+16($sp) - swc1 $f22, 8+16($sp) - swc1 $f24, 16+16($sp) - swc1 $f26, 24+16($sp) - swc1 $f28, 32+16($sp) - swc1 $f30, 40+16($sp) - sw $31, 48+16($sp) - jal qt_blocki - lwc1 $f20, 0+16($sp) - lwc1 $f22, 8+16($sp) - lwc1 $f24, 16+16($sp) - lwc1 $f26, 24+16($sp) - lwc1 $f28, 32+16($sp) - lwc1 $f30, 40+16($sp) - lw $31, 48+16($sp) - add $sp, $sp,56 - j $31 - - - /* - ** First, call `startup' with the `pt' argument. - ** - ** Next, call the user's function with all arguments. - ** Note that we don't know whether args were passed in - ** integer regs, fp regs, or on the stack (See Gerry Kane - ** "MIPS R2000 RISC Architecture" pg D-22), so we reload - ** all the registers, possibly with garbage arguments. - ** - ** Finally, call `cleanup' with the `pt' argument and with - ** the return value from the user's function. It is an error - ** for `cleanup' to return. - */ -qt_vstart: - add $4, $17,$0 /* `pt' is arg0 to `startup'. */ - add $25, $18,$0 /* Set `startup' procedure value. */ - jal $31, $25 /* Call `startup'. */ - - add $sp, $sp,16 /* Free extra save space. */ - lw $4, 0($sp) /* Load up args. */ - lw $5, 4($sp) - lw $6, 8($sp) - lw $7, 12($sp) - lwc1 $f12, 0($sp) /* Load up fp args. */ - lwc1 $f14, 8($sp) - add $25, $19,$0 /* Set `userf' procedure value. */ - jal $31,$25 /* Call `userf'. */ - - add $4, $17,$0 /* `pt' is arg0 to `cleanup'. */ - add $5, $2,$0 /* Ret. val is arg1 to `cleanup'. */ - add $25, $16,$0 /* Set `cleanup' procedure value. */ - jal $31, $25 /* Call `cleanup'. */ - - la $25,qt_error /* Set `qt_error' procedure value. */ - j $25 diff --git a/qt/md/mips.h b/qt/md/mips.h deleted file mode 100644 index c584a681e..000000000 --- a/qt/md/mips.h +++ /dev/null @@ -1,134 +0,0 @@ -/* - * 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. - */ - -#ifndef QT_MIPS_H -#define QT_MIPS_H - -typedef unsigned long qt_word_t; - -#define QT_GROW_DOWN - -/* Stack layout on the mips: - - Callee-save registers are: $16-$23, $30; $f20-$f30. - Also save $31, return pc. - - Non-varargs: - - +--- - | $f30 The first clump is only saved if `qt_block' - | $f28 is called, in which case it saves the fp regs - | $f26 then calls `qt_blocki' to save the int regs. - | $f24 - | $f22 - | $f20 - | $31 === return pc in `qt_block' - +--- - | $31 === return pc; on startup == qt_start - | $30 - | $23 - | $22 - | $21 - | $20 - | $19 on startup === only - | $18 on startup === $a2 === userf - | $17 on startup === $a1 === pt - | $16 on startup === $a0 === pu - | <a3> save area req'd by MIPS calling convention - | <a2> save area req'd by MIPS calling convention - | <a1> save area req'd by MIPS calling convention - | <a0> save area req'd by MIPS calling convention <--- sp - +--- - - Conventions for varargs: - - | args ... - +--- - | : - | : - | $21 - | $20 - | $19 on startup === `userf' - | $18 on startup === `startup' - | $17 on startup === `pt' - | $16 on startup === `cleanup' - | <a3> - | <a2> - | <a1> - | <a0> <--- sp - +--- - - Note: if we wanted to, we could muck about and try to get the 4 - argument registers loaded in to, e.g., $22, $23, $30, and $31, - and the return pc in, say, $20. Then, the first 4 args would - not need to be loaded from memory, they could just use - register-to-register copies. */ - - -/* Stack must be doubleword aligned. */ -#define QT_STKALIGN (8) /* Doubleword aligned. */ - -/* How much space is allocated to hold all the crud for - initialization: $16-$23, $30, $31. Just do an integer restore, - no need to restore floating-point. Four words are needed for the - argument save area for the helper function that will be called for - the old thread, just before the new thread starts to run. */ - -#define QT_STKBASE (14 * 4) -#define QT_VSTKBASE QT_STKBASE - - -/* Offsets of various registers. */ -#define QT_31 (9+4) -#define QT_19 (3+4) -#define QT_18 (2+4) -#define QT_17 (1+4) -#define QT_16 (0+4) - - -/* When a never-before-run thread is restored, the return pc points - to a fragment of code that starts the thread running. For - non-vargs functions, it just calls the client's `only' function. - For varargs functions, it calls the startup, user, and cleanup - functions. - - The varargs startup routine always reads 4 words of arguments from - the stack. If there are less than 4 words of arguments, then the - startup routine can read off the top of the stack. To prevent - errors we always allocate 4 words. If there are more than 3 words - of arguments, the 4 preallocated words are simply wasted. */ - -extern void qt_start(void); -#define QT_ARGS_MD(sp) (QT_SPUT (sp, QT_31, qt_start)) - -#define QT_VARGS_MD0(sp, vabytes) \ - ((qt_t *)(((char *)(sp)) - 4*4 - QT_STKROUNDUP(vabytes))) - -extern void qt_vstart(void); -#define QT_VARGS_MD1(sp) (QT_SPUT (sp, QT_31, qt_vstart)) - -#define QT_VARGS_DEFAULT - - -/* The *index* (positive offset) of where to put each value. */ -#define QT_ONLY_INDEX (QT_19) -#define QT_USER_INDEX (QT_18) -#define QT_ARGT_INDEX (QT_17) -#define QT_ARGU_INDEX (QT_16) - -#define QT_VCLEANUP_INDEX (QT_16) -#define QT_VUSERF_INDEX (QT_19) -#define QT_VSTARTUP_INDEX (QT_18) -#define QT_VARGT_INDEX (QT_17) - -#endif /* ndef QT_MIPS_H */ diff --git a/qt/md/mips.s b/qt/md/mips.s deleted file mode 100644 index b074b98dc..000000000 --- a/qt/md/mips.s +++ /dev/null @@ -1,164 +0,0 @@ -/* mips.s -- assembly support. */ - -/* - * 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. - */ - -/* Callee-save $16-$23, $30-$31. - * - * On startup, restore regs so retpc === call to a function to start. - * We're going to call a function ($4) from within this routine. - * We're passing 3 args, therefore need to allocate 12 extra bytes on - * the stack for a save area. The start routine needs a like 16-byte - * save area. Must be doubleword aligned (_mips r3000 risc - * architecture_, gerry kane, pg d-23). - */ - - .globl qt_block - .globl qt_blocki - .globl qt_abort - .globl qt_start - .globl qt_vstart - - /* - ** $4: ptr to function to call once curr is suspended - ** and control is on $7's stack. - ** $5: 1'th arg to $4. - ** $6: 2'th arg to $4 - ** $7: sp of thread to suspend. - ** - ** Totally gross hack: The MIPS calling convention reserves - ** 4 words on the stack for a0..a3. This routine "ought" to - ** allocate space for callee-save registers plus 4 words for - ** the helper function, but instead we use the 4 words - ** provided by the function that called us (we don't need to - ** save our argument registers). So what *appears* to be - ** allocating only 40 bytes is actually allocating 56, by - ** using the caller's 16 bytes. - ** - ** The helper routine returns a value that is passed on as the - ** return value from the blocking routine. Since we don't - ** touch $2 between the helper's return and the end of - ** function, we get this behavior for free. - */ -qt_blocki: - sub $sp,$sp,40 /* Allocate reg save space. */ - sw $16, 0+16($sp) - sw $17, 4+16($sp) - sw $18, 8+16($sp) - sw $19,12+16($sp) - sw $20,16+16($sp) - sw $21,20+16($sp) - sw $22,24+16($sp) - sw $23,28+16($sp) - sw $30,32+16($sp) - sw $31,36+16($sp) - add $2, $sp,$0 /* $2 <= old sp to pass to func@$4. */ -qt_abort: - add $sp, $7,$0 /* $sp <= new sp. */ - .set noreorder - jal $31,$4 /* Call helper func@$4 . */ - add $4, $2,$0 /* $a0 <= pass old sp as a parameter. */ - .set reorder - lw $31,36+16($sp) /* Restore callee-save regs... */ - lw $30,32+16($sp) - lw $23,28+16($sp) - lw $22,24+16($sp) - lw $21,20+16($sp) - lw $20,16+16($sp) - lw $19,12+16($sp) - lw $18, 8+16($sp) - lw $17, 4+16($sp) - lw $16, 0+16($sp) /* Restore callee-save */ - - add $sp,$sp,40 /* Deallocate reg save space. */ - j $31 /* Return to caller. */ - - /* - ** Non-varargs thread startup. - ** Note: originally, 56 bytes were allocated on the stack. - ** The thread restore routine (_blocki/_abort) removed 40 - ** of them, which means there is still 16 bytes for the - ** argument area required by the MIPS calling convention. - */ -qt_start: - add $4, $16,$0 /* Load up user function pu. */ - add $5, $17,$0 /* ... user function pt. */ - add $6, $18,$0 /* ... user function userf. */ - jal $31,$19 /* Call `only'. */ - j qt_error - - - /* - ** Save calle-save floating-point regs $f20-$f30 - ** See comment in `qt_block' about calling conventinos and - ** reserved space. Use the same trick here, but here we - ** actually have to allocate all the bytes since we have to - ** leave 4 words leftover for `qt_blocki'. - ** - ** Return value from `qt_block' is the same as the return from - ** `qt_blocki'. We get that for free since we don't touch $2 - ** between the return from `qt_blocki' and the return from - ** `qt_block'. - */ -qt_block: - sub $sp, $sp,56 /* 6 8-byte regs, saved ret pc, aligned. */ - swc1 $f20, 0+16($sp) - swc1 $f22, 8+16($sp) - swc1 $f24, 16+16($sp) - swc1 $f26, 24+16($sp) - swc1 $f28, 32+16($sp) - swc1 $f30, 40+16($sp) - sw $31, 48+16($sp) - jal qt_blocki - lwc1 $f20, 0+16($sp) - lwc1 $f22, 8+16($sp) - lwc1 $f24, 16+16($sp) - lwc1 $f26, 24+16($sp) - lwc1 $f28, 32+16($sp) - lwc1 $f30, 40+16($sp) - lw $31, 48+16($sp) - add $sp, $sp,56 - j $31 - - - /* - ** First, call `startup' with the `pt' argument. - ** - ** Next, call the user's function with all arguments. - ** Note that we don't know whether args were passed in - ** integer regs, fp regs, or on the stack (See Gerry Kane - ** "MIPS R2000 RISC Architecture" pg D-22), so we reload - ** all the registers, possibly with garbage arguments. - ** - ** Finally, call `cleanup' with the `pt' argument and with - ** the return value from the user's function. It is an error - ** for `cleanup' to return. - */ -qt_vstart: - add $4, $17,$0 /* `pt' is arg0 to `startup'. */ - jal $31, $18 /* Call `startup'. */ - - add $sp, $sp,16 /* Free extra save space. */ - lw $4, 0($sp) /* Load up args. */ - lw $5, 4($sp) - lw $6, 8($sp) - lw $7, 12($sp) - lwc1 $f12, 0($sp) /* Load up fp args. */ - lwc1 $f14, 8($sp) - jal $31,$19 /* Call `userf'. */ - - add $4, $17,$0 /* `pt' is arg0 to `cleanup'. */ - add $5, $2,$0 /* Ret. val is arg1 to `cleanup'. */ - jal $31, $16 /* Call `cleanup'. */ - - j qt_error diff --git a/qt/md/mips_b.s b/qt/md/mips_b.s deleted file mode 100644 index 5b3740843..000000000 --- a/qt/md/mips_b.s +++ /dev/null @@ -1,99 +0,0 @@ -/* - * 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. - */ - - .globl b_call_reg - .globl b_call_imm - .globl b_add - .globl b_load - - .ent b_null -b_null: - j $31 - .end b_null - - .ent b_call_reg -b_call_reg: - la $5,b_null - add $6, $31,0 -$L0: - jal $5 - jal $5 - jal $5 - jal $5 - jal $5 - - sub $4, $4,5 - bgtz $4,$L0 - j $6 - .end - - - .ent b_call_imm -b_call_imm: - add $6, $31,0 -$L1: - jal b_null - jal b_null - jal b_null - jal b_null - jal b_null - - sub $4, $4,5 - bgtz $4,$L1 - j $6 - .end - - - .ent b_add -b_add: - add $5, $0,$4 - add $6, $0,$4 - add $7, $0,$4 - add $8, $0,$4 -$L2: - sub $4, $4,5 - sub $5, $5,5 - sub $6, $6,5 - sub $7, $7,5 - sub $8, $8,5 - - sub $4, $4,5 - sub $5, $5,5 - sub $6, $6,5 - sub $7, $7,5 - sub $8, $8,5 - - bgtz $4,$L2 - j $31 - .end - - - .ent b_load -b_load: -$L3: - ld $0, 0($sp) - ld $0, 4($sp) - ld $0, 8($sp) - ld $0, 12($sp) - ld $0, 16($sp) - - ld $0, 20($sp) - ld $0, 24($sp) - ld $0, 28($sp) - ld $0, 32($sp) - ld $0, 36($sp) - - sub $4, $4,10 - bgtz $4,$L3 - j $31 - .end diff --git a/qt/md/null.README b/qt/md/null.README deleted file mode 100644 index e69de29bb..000000000 --- a/qt/md/null.README +++ /dev/null diff --git a/qt/md/null.c b/qt/md/null.c deleted file mode 100644 index 775db62be..000000000 --- a/qt/md/null.c +++ /dev/null @@ -1,14 +0,0 @@ -/* - * 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. - */ - -char const qtmd_rcsid[] = "$Header: /home/ludo/src/guile.cvs/gitification/guile-cvs/guile/guile-core/qt/md/null.c,v 1.1 1996-10-01 03:34:16 mdj Exp $"; diff --git a/qt/md/solaris.README b/qt/md/solaris.README deleted file mode 100644 index 04f855c44..000000000 --- a/qt/md/solaris.README +++ /dev/null @@ -1,19 +0,0 @@ -Solaris 2.x is like System V (maybe it *is* System V?) and is different -from older versions in that it uses no leading underscore for variable -and function names. That is, the old convention was: - - foo(){} - -got compiled as - - .globl _foo - _foo: - -and is now compiled as - - .globl foo - foo: - -The `config' script should fix up the older (leading underscore) versions -of the machine-dependent files to use the newer (no leading underscore) -calling conventions. diff --git a/qt/md/sparc.h b/qt/md/sparc.h deleted file mode 100644 index e2ab281b4..000000000 --- a/qt/md/sparc.h +++ /dev/null @@ -1,140 +0,0 @@ -/* - * 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. - */ - -#ifndef QT_SPARC_H -#define QT_SPARC_H - -typedef unsigned long qt_word_t; - -/* Stack layout on the sparc: - - non-varargs: - - +--- - | <blank space for alignment> - | %o7 == return address -> qt_start - | %i7 - | %i6 == frame pointer -> 0 (NULL-terminated stack frame chain) - | %i5 -> only - | %i4 -> userf - | %i3 - | %i2 -> pt - | %i1 -> pu - | %i0 - | %l7 - | %l6 - | %l5 - | %l4 - | %l3 - | %l2 - | %l1 - | %l0 <--- qt_t.sp - +--- - - varargs: - - | : - | : - | argument list - | one-word aggregate return pointer - +--- - | <blank space for alignment> - | %o7 == return address -> qt_vstart - | %i7 - | %i6 == frame pointer -> 0 (NULL-terminated stack frame chain) - | %i5 -> startup - | %i4 -> userf - | %i3 -> cleanup - | %i2 -> pt - | %i1 - | %i0 - | %l7 - | %l6 - | %l5 - | %l4 - | %l3 - | %l2 - | %l1 - | %l0 <--- qt_t.sp - +--- - - */ - - -/* What to do to start a thread running. */ -extern void qt_start (void); -extern void qt_vstart (void); - - -/* Hold 17 saved registers + 1 word for alignment. */ -#define QT_STKBASE (18 * 4) -#define QT_VSTKBASE QT_STKBASE - - -/* Stack must be doubleword aligned. */ -#define QT_STKALIGN (8) /* Doubleword aligned. */ - -#define QT_ONLY_INDEX (QT_I5) -#define QT_USER_INDEX (QT_I4) -#define QT_ARGT_INDEX (QT_I2) -#define QT_ARGU_INDEX (QT_I1) - -#define QT_VSTARTUP_INDEX (QT_I5) -#define QT_VUSERF_INDEX (QT_I4) -#define QT_VCLEANUP_INDEX (QT_I3) -#define QT_VARGT_INDEX (QT_I2) - -#define QT_O7 (16) -#define QT_I6 (14) -#define QT_I5 (13) -#define QT_I4 (12) -#define QT_I3 (11) -#define QT_I2 (10) -#define QT_I1 ( 9) - - -/* The thread will ``return'' to the `qt_start' routine to get things - going. The normal return sequence takes us to QT_O7+8, so we - pre-subtract 8. The frame pointer chain is 0-terminated to prevent - the trap handler from chasing off in to random memory when flushing - stack windows. */ - -#define QT_ARGS_MD(top) \ - (QT_SPUT ((top), QT_O7, ((void *)(((int)qt_start)-8))), \ - QT_SPUT ((top), QT_I6, 0)) - - -/* The varargs startup routine always reads 6 words of arguments - (6 argument registers) from the stack, offset by one word to - allow for an aggregate return area pointer. If the varargs - routine actually pushed fewer words than that, qt_vstart could read - off the top of the stack. To prevent errors, we always allocate 8 - words. The space is often just wasted. */ - -#define QT_VARGS_MD0(sp, vabytes) \ - ((qt_t *)(((char *)(sp)) - 8*4 - QT_STKROUNDUP(vabytes))) - -#define QT_VARGS_MD1(sp) \ - (QT_SPUT (sp, QT_O7, ((void *)(((int)qt_vstart)-8)))) - -/* The SPARC has wierdo calling conventions which stores a hidden - parameter for returning aggregate values, so the rest of the - parameters are shoved up the stack by one place. */ -#define QT_VARGS_ADJUST(sp) (((char *)sp)+4) - -#define QT_VARGS_DEFAULT - - -#define QT_GROW_DOWN - -#endif /* ndef QT_SPARC_H */ diff --git a/qt/md/sparc.s b/qt/md/sparc.s deleted file mode 100644 index d9bdf0c58..000000000 --- a/qt/md/sparc.s +++ /dev/null @@ -1,142 +0,0 @@ -/* sparc.s -- assembly support for the `qt' thread building kit. */ - -/* - * 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. - */ - -/* #include <machine/trap.h> */ - - .text - .align 4 - .global qt_blocki - .global qt_block - .global qt_abort - .global qt_start - .global qt_vstart - -/* Register assignment: -// %o0: incoming `helper' function to call after cswap -// also used as outgoing sp of old thread (qt_t *) -// %o1, %o2: -// parameters to `helper' function called after cswap -// %o3: sp of new thread -// %o5: tmp used to save old thread sp, while using %o0 -// to call `helper' f() after cswap. -// -// -// Aborting a thread is easy if there are no cached register window -// frames: just switch to the new stack and away we go. If there are -// cached register window frames they must all be written back to the -// old stack before we move to the new stack. If we fail to do the -// writeback then the old stack memory can be written with register -// window contents e.g., after the stack memory has been freed and -// reused. -// -// If you don't believe this, try setting the frame pointer to zero -// once we're on the new stack. This will not affect correctnes -// otherwise because the frame pointer will eventually get reloaded w/ -// the new thread's frame pointer. But it will be zero briefly before -// the reload. You will eventually (100,000 cswaps later on a small -// SPARC machine that I tried) get an illegal instruction trap from -// the kernel trying to flush a cached window to location 0x0. -// -// Solution: flush windows before switching stacks, which invalidates -// all the other register windows. We could do the trap -// conditionally: if we're in the lowest frame of a thread, the fp is -// zero already so we know there's nothing cached. But we expect most -// aborts will be done from a first function that does a `save', so we -// will rarely save anything and always pay the cost of testing to see -// if we should flush. -// -// All floating-point registers are caller-save, so this routine -// doesn't need to do anything to save and restore them. -// -// `qt_block' and `qt_blocki' return the same value as the value -// returned by the helper function. We get this ``for free'' -// since we don't touch the return value register between the -// return from the helper function and return from qt_block{,i}. -*/ - -qt_block: -qt_blocki: - sub %sp, 8, %sp /* Allocate save area for return pc. */ - st %o7, [%sp+64] /* Save return pc. */ -qt_abort: - ta 0x03 /* Save locals and ins. */ - mov %sp, %o5 /* Remember old sp w/o chng ins/locals. */ - sub %o3, 64, %sp /* Allocate kwsa, switch stacks. */ - call %o0, 0 /* Call `helper' routine. */ - mov %o5, %o0 /* Pass old thread to qt_after_t() */ - /* .. along w/ args in %o1 & %o2. */ - - /* Restore callee-save regs. The kwsa - // is on this stack, so offset all - // loads by sizeof(kwsa), 64 bytes. - */ - ldd [%sp+ 0+64], %l0 - ldd [%sp+ 8+64], %l2 - ldd [%sp+16+64], %l4 - ldd [%sp+24+64], %l6 - ldd [%sp+32+64], %i0 - ldd [%sp+40+64], %i2 - ldd [%sp+48+64], %i4 - ldd [%sp+56+64], %i6 - ld [%sp+64+64], %o7 /* Restore return pc. */ - - retl /* Return to address in %o7. */ - add %sp, 72, %sp /* Deallocate kwsa, ret pc area. */ - - -/* The function calling conventions say there has to be a 1-word area -// in the caller's stack to hold a pointer to space for aggregate -// return values. It also says there should be a 6-word area to hold -// %o0..%o5 if the callee wants to save them (why? I don't know...) -// Round up to 8 words to maintain alignment. -// -// Parameter values were stored in callee-save regs and are moved to -// the parameter registers. -*/ -qt_start: - mov %i1, %o0 /* `pu': Set up args to `only'. */ - mov %i2, %o1 /* `pt'. */ - mov %i4, %o2 /* `userf'. */ - call %i5, 0 /* Call client function. */ - sub %sp, 32, %sp /* Allocate 6-word callee space. */ - - call qt_error, 0 /* `only' erroniously returned. */ - nop - - -/* Same comments as `qt_start' about allocating rounded-up 7-word -// save areas. */ - -qt_vstart: - sub %sp, 32, %sp /* Allocate 7-word callee space. */ - call %i5, 0 /* call `startup'. */ - mov %i2, %o0 /* .. with argument `pt'. */ - - add %sp, 32, %sp /* Use 7-word space in varargs. */ - ld [%sp+ 4+64], %o0 /* Load arg0 ... */ - ld [%sp+ 8+64], %o1 - ld [%sp+12+64], %o2 - ld [%sp+16+64], %o3 - ld [%sp+20+64], %o4 - call %i4, 0 /* Call `userf'. */ - ld [%sp+24+64], %o5 - - /* Use 6-word space in varargs. */ - mov %o0, %o1 /* Pass return value from userf */ - call %i3, 0 /* .. when call `cleanup. */ - mov %i2, %o0 /* .. along with argument `pt'. */ - - call qt_error, 0 /* `cleanup' erroniously returned. */ - nop diff --git a/qt/md/sparc_b.s b/qt/md/sparc_b.s deleted file mode 100644 index 08351d76d..000000000 --- a/qt/md/sparc_b.s +++ /dev/null @@ -1,106 +0,0 @@ -/* - * 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. - */ - - .globl b_call_reg - .globl b_call_imm - .globl b_add - .globl b_load - -b_null: - retl - nop - -b_call_reg: - sethi %hi(b_null),%o4 - or %o4,%lo(b_null),%o4 - add %o7,%g0, %o3 -L0: - call %o4 - nop - call %o4 - nop - call %o4 - nop - call %o4 - nop - call %o4 - nop - - subcc %o0,1,%o0 - bg L0 - nop - add %o3,%g0, %o7 - retl - nop - -b_call_imm: - sethi %hi(b_null),%o4 - or %o4,%lo(b_null),%o4 - add %o7,%g0, %o3 -L1: - call b_null - call b_null - call b_null - call b_null - call b_null - - subcc %o0,1,%o0 - bg L0 - nop - add %o3,%g0, %o7 - retl - nop - - -b_add: - add %o0,%g0,%o1 - add %o0,%g0,%o2 - add %o0,%g0,%o3 - add %o0,%g0,%o4 -L2: - sub %o0,5,%o0 - sub %o1,5,%o1 - sub %o2,5,%o2 - sub %o3,5,%o3 - sub %o4,5,%o4 - - subcc %o0,5,%o0 - sub %o1,5,%o1 - sub %o2,5,%o2 - sub %o3,5,%o3 - sub %o4,5,%o4 - - bg L2 - nop - retl - nop - - -b_load: - ld [%sp+ 0], %g0 -L3: - ld [%sp+ 4],%g0 - ld [%sp+ 8],%g0 - ld [%sp+12],%g0 - ld [%sp+16],%g0 - ld [%sp+20],%g0 - ld [%sp+24],%g0 - ld [%sp+28],%g0 - ld [%sp+32],%g0 - ld [%sp+36],%g0 - - subcc %o0,10,%o0 - bg L3 - ld [%sp+ 0],%g0 - retl - nop diff --git a/qt/md/vax.h b/qt/md/vax.h deleted file mode 100644 index 1a5af0f2b..000000000 --- a/qt/md/vax.h +++ /dev/null @@ -1,130 +0,0 @@ -/* - * 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. - */ - -#ifndef QT_VAX_H -#define QT_VAX_H - -typedef unsigned long qt_word_t; - -/* Thread's initial stack layout on the VAX: - - non-varargs: - - +--- - | arg[2] === `userf' on startup - | arg[1] === `pt' on startup - | arg[0] === `pu' on startup - | ... === `only' on startup. - +--- - | ret pc === `qt_start' on startup - | fp === 0 on startup - | ap === 0 on startup - | <mask> - | 0 (handler) <--- qt_t.sp - +--- - - When a non-varargs thread is started, it ``returns'' to the start - routine, which calls the client's `only' function. - - The varargs case is clearly bad code. The various values should be - stored in a save area and snarfed in to callee-save registers on - startup. However, it's too painful to figure out the register - mask (right now), so do it the slow way. - - +--- - | arg[n-1] - | .. - | arg[0] - | nargs - +--- - | === `cleanup' - | === `vuserf' - | === `startup' - | === `pt' - +--- - | ret pc === `qt_start' on startup - | fp === 0 on startup - | ap === 0 on startup - | <mask> - | 0 (handler) <--- qt_t.sp - +--- - - When a varargs thread is started, it ``returns'' to the `qt_vstart' - startup code. The startup code pops all the extra arguments, then - calls the appropriate functions. */ - - -/* What to do to start a thread running. */ -extern void qt_start (void); -extern void qt_vstart (void); - - -/* Initial call frame for non-varargs and varargs cases. */ -#define QT_STKBASE (10 * 4) -#define QT_VSTKBASE (9 * 4) - - -/* Stack "must be" 4-byte aligned. (Actually, no, but it's - easiest and probably fastest to do so.) */ - -#define QT_STKALIGN (4) - - -/* Where to place various arguments. */ -#define QT_ONLY_INDEX (5) -#define QT_USER_INDEX (8) -#define QT_ARGT_INDEX (7) -#define QT_ARGU_INDEX (6) - -#define QT_VSTARTUP_INDEX (6) -#define QT_VUSERF_INDEX (7) -#define QT_VCLEANUP_INDEX (8) -#define QT_VARGT_INDEX (5) - - -/* Stack grows down. The top of the stack is the first thing to - pop off (predecrement, postincrement). */ -#define QT_GROW_DOWN - - -extern void qt_error (void); - -#define QT_VAX_GMASK_NOREGS (0) - -/* Push on the error return address, null termination to call chains, - number of arguments to `only', register save mask (save no - registers). */ - -#define QT_ARGS_MD(sto) \ - (QT_SPUT (sto, 0, 0), \ - QT_SPUT (sto, 1, QT_VAX_GMASK_NOREGS), \ - QT_SPUT (sto, 2, 0), \ - QT_SPUT (sto, 3, 0), \ - QT_SPUT (sto, 4, qt_start)) - -#define QT_VARGS_MD0(sto, nbytes) \ - (QT_SPUT (sto, (-(nbytes)/4)-1, (nbytes)/4), \ - ((char *)(((sto)-4) - QT_STKROUNDUP(nbytes)))) - -#define QT_VARGS_ADJUST(sp) ((char *)sp + 4) - -#define QT_VARGS_MD1(sto) \ - (QT_SPUT (sto, 0, 0), \ - QT_SPUT (sto, 1, QT_VAX_GMASK_NOREGS), \ - QT_SPUT (sto, 2, 0), \ - QT_SPUT (sto, 3, 0), \ - QT_SPUT (sto, 4, qt_vstart)) - -#define QT_VARGS_DEFAULT - -#endif /* QT_VAX_H */ diff --git a/qt/md/vax.s b/qt/md/vax.s deleted file mode 100644 index fed03f043..000000000 --- a/qt/md/vax.s +++ /dev/null @@ -1,69 +0,0 @@ -/* - * 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. - */ - - .text - - .globl _qt_abort - .globl _qt_block - .globl _qt_blocki - .globl _qt_start - .globl _qt_vstart - - -/* -// Calls to these routines have the signature -// -// void *block (func, arg1, arg2, newsp) -// -// Since the prologue saves 5 registers, nargs, pc, fp, ap, mask, and -// a condition handler (at sp+0), the first argument is 40=4*10 bytes -// offset from the stack pointer. -*/ -_qt_block: -_qt_blocki: -_qt_abort: - .word 0x7c0 /* Callee-save mask: 5 registers. */ - movl 56(sp),r1 /* Get stack pointer of new thread. */ - movl 52(sp),-(r1) /* Push arg2 */ - movl 48(sp),-(r1) /* Push arg1 */ - movl sp,-(r1) /* Push arg0 */ - - movl 44(sp),r0 /* Get helper to call. */ - movl r1,sp /* Move to new thread's stack. */ - addl3 sp,$12,fp /* .. including the frame pointer. */ - calls $3,(r0) /* Call helper. */ - - ret - -_qt_start: - movl (sp)+,r0 /* Get `only'. */ - calls $3,(r0) /* Call `only'. */ - calls $0,_qt_error /* `only' erroniously returned. */ - - -_qt_vstart: - movl (sp)+,r10 /* Get `pt'. */ - movl (sp)+,r9 /* Get `startup'. */ - movl (sp)+,r8 /* Get `vuserf'. */ - movl (sp)+,r7 /* Get `cleanup'. */ - - pushl r10 /* Push `qt'. */ - calls $1,(r9) /* Call `startup', pop `qt' on return. */ - - calls (sp)+,(r8) /* Call user's function. */ - - pushl r0 /* Push `vuserf_retval'. */ - pushl r10 /* Push `qt'. */ - calls $2,(r7) /* Call `cleanup', never return. */ - - calls $0,_qt_error /* `cleanup' erroniously returned. */ diff --git a/qt/md/vax_b.s b/qt/md/vax_b.s deleted file mode 100644 index 2db2d4fec..000000000 --- a/qt/md/vax_b.s +++ /dev/null @@ -1,92 +0,0 @@ -/* - * 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. - */ - - .text - .globl _b_call_reg - .globl _b_call_imm - .globl _b_add - .globl _b_load - -_b_null: - .word 0x0 - ret - -_b_call_reg: - .word 0x0 - movl 4(ap),r0 - moval _b_null,r1 -L0: - calls $0,(r1) - calls $0,(r1) - calls $0,(r1) - calls $0,(r1) - calls $0,(r1) - - subl2 $5,r0 - bgtr L0 - ret - - -_b_call_imm: - .word 0x0 - movl 4(ap),r0 -L1: - calls $0,_b_null - calls $0,_b_null - calls $0,_b_null - calls $0,_b_null - calls $0,_b_null - - subl2 $5,r0 - bgtr L1 - ret - - -_b_add: - .word 0x0 - movl 4(ap),r0 -L2: - subl2 $1,r0 - subl2 $1,r0 - subl2 $1,r0 - subl2 $1,r0 - subl2 $1,r0 - - subl2 $1,r0 - subl2 $1,r0 - subl2 $1,r0 - subl2 $1,r0 - subl2 $1,r0 - - bgtr L2 - ret - - -_b_load: - .word 0x0 - movl 4(ap),r0 -L3: - movl 0(sp),r1 - movl 4(sp),r1 - movl 8(sp),r1 - movl 12(sp),r1 - movl 16(sp),r1 - movl 20(sp),r1 - movl 24(sp),r1 - movl 28(sp),r1 - movl 32(sp),r1 - movl 36(sp),r1 - - subl2 $1,r0 - bgtr L3 - ret diff --git a/qt/meas.c b/qt/meas.c deleted file mode 100644 index 3faab3c52..000000000 --- a/qt/meas.c +++ /dev/null @@ -1,1049 +0,0 @@ -/* meas.c -- measure qt stuff. */ - -#include "copyright.h" - -/* Need this to get assertions under Mach on the Sequent/i386: */ -#ifdef __i386__ -#define assert(ex) \ - do { \ - if (!(ex)) { \ - fprintf (stderr, "[%s:%d] Assertion " #ex " failed\n", __FILE__, __LINE__); \ - abort(); \ - } \ - } while (0) -#else -#include <assert.h> -#endif - -/* This really ought to be defined in some ANSI include file (*I* - think...), but it's defined here instead, which leads us to another - machine dependency. - - The `iaddr_t' type is an integer representation of a pointer, - suited for doing arithmetic on addresses, e.g. to round an address - to an alignment boundary. */ -typedef unsigned long iaddr_t; - -#include <stdarg.h> /* For varargs tryout. */ -#include <stdio.h> -#include "b.h" -#include "qt.h" -#include "stp.h" - -extern void exit (int status); -extern int atoi (char const *s); -extern int fprintf (FILE *out, char const *fmt, ...); -extern int fputs (char const *s, FILE *fp); -extern void free (void *sto); -extern void *malloc (unsigned nbytes); -extern void perror (char const *s); - -void usage (void); -void tracer(void); - -/* Round `v' to be `a'-aligned, assuming `a' is a power of two. */ -#define ROUND(v, a) (((v) + (a) - 1) & ~((a)-1)) - -typedef struct thread_t { - qt_t *qt; /* Pointer to thread of function... */ - void *stk; - void *top; /* Set top of stack if reuse. */ - struct thread_t *next; -} thread_t; - - - static thread_t * -t_alloc (void) -{ - thread_t *t; - int ssz = 0x1000; - - t = malloc (sizeof(thread_t)); - if (!t) { - perror ("malloc"); - exit (1); - } - assert (ssz > QT_STKBASE); - t->stk = malloc (ssz); - t->stk = (void *)ROUND (((iaddr_t)t->stk), QT_STKALIGN); - if (!t->stk) { - perror ("malloc"); - exit (1); - } - assert ((((iaddr_t)t->stk) & (QT_STKALIGN-1)) == 0); - t->top = QT_SP (t->stk, ssz - QT_STKBASE); - - return (t); -} - - - static thread_t * -t_create (qt_only_t *starter, void *p0, qt_userf_t *f) -{ - thread_t *t; - - t = t_alloc(); - t->qt = QT_ARGS (t->top, p0, t, f, starter); - return (t); -} - - - static void -t_free (thread_t *t) -{ - free (t->stk); - free (t); -} - - - static void * -t_null (qt_t *old, void *p1, void *p2) -{ - /* return (garbage); */ -} - - - static void * -t_splat (qt_t *old, void *oldp, void *null) -{ - *(qt_t **)oldp = old; - /* return (garbage); */ -} - - -static char const test01_msg[] = - "*QT_SP(sto,sz), QT_ARGS(top,p0,p1,userf,first)"; - -static char const *test01_descr[] = { - "Performs 1 QT_SP and one QT_ARGS per iteration.", - NULL -}; - -/* This test gives a guess on how long it takes to initalize - a thread. */ - - static void -test01 (int n) -{ - char stack[QT_STKBASE+QT_STKALIGN]; - char *stk; - qt_t *top; - - stk = (char *)ROUND (((iaddr_t)stack), QT_STKALIGN); - - { - int i; - - for (i=0; i<QT_STKBASE; ++i) { - stk[i] = 0; - } - } - - while (n>0) { - /* RETVALUSED */ - top = QT_SP (stk, QT_STKBASE); QT_ARGS (top, 0, 0, 0, 0); -#ifdef NDEF - top = QT_SP (stk, QT_STKBASE); QT_ARGS (top, 0, 0, 0, 0); - top = QT_SP (stk, QT_STKBASE); QT_ARGS (top, 0, 0, 0, 0); - top = QT_SP (stk, QT_STKBASE); QT_ARGS (top, 0, 0, 0, 0); - top = QT_SP (stk, QT_STKBASE); QT_ARGS (top, 0, 0, 0, 0); - - top = QT_SP (stk, QT_STKBASE); QT_ARGS (top, 0, 0, 0, 0); - top = QT_SP (stk, QT_STKBASE); QT_ARGS (top, 0, 0, 0, 0); - top = QT_SP (stk, QT_STKBASE); QT_ARGS (top, 0, 0, 0, 0); - top = QT_SP (stk, QT_STKBASE); QT_ARGS (top, 0, 0, 0, 0); - top = QT_SP (stk, QT_STKBASE); QT_ARGS (top, 0, 0, 0, 0); - - n -= 10; -#else - n -= 1; -#endif - } -} - - -static char const test02_msg[] = "QT_BLOCKI (0, 0, test02_aux, t->qt)"; -static qt_t *rootthread; - - static void -test02_aux1 (void *pu, void *pt, qt_userf_t *f) -{ - QT_ABORT (t_null, 0, 0, rootthread); -} - - static void * -test02_aux2 (qt_t *old, void *farg1, void *farg2) -{ - rootthread = old; - /* return (garbage); */ -} - - static void -test02 (int n) -{ - thread_t *t; - - while (n>0) { - t = t_create (test02_aux1, 0, 0); - QT_BLOCKI (test02_aux2, 0, 0, t->qt); - t_free (t); - t = t_create (test02_aux1, 0, 0); - QT_BLOCKI (test02_aux2, 0, 0, t->qt); - t_free (t); - t = t_create (test02_aux1, 0, 0); - QT_BLOCKI (test02_aux2, 0, 0, t->qt); - t_free (t); - t = t_create (test02_aux1, 0, 0); - QT_BLOCKI (test02_aux2, 0, 0, t->qt); - t_free (t); - t = t_create (test02_aux1, 0, 0); - QT_BLOCKI (test02_aux2, 0, 0, t->qt); - t_free (t); - - n -= 5; - } -} - - -static char const test03_msg[] = "QT_BLOCKI (...) test vals are right."; - - -/* Called by the thread function when it wants to shut down. - Return a value to the main thread. */ - - static void * -test03_aux0 (qt_t *old_is_garbage, void *farg1, void *farg2) -{ - assert (farg1 == (void *)5); - assert (farg2 == (void *)6); - return ((void *)15); /* Some unlikely value. */ -} - - -/* Called during new thread startup by main thread. Since the new - thread has never run before, return value is ignored. */ - - static void * -test03_aux1 (qt_t *old, void *farg1, void *farg2) -{ - assert (old != NULL); - assert (farg1 == (void *)5); - assert (farg2 == (void *)6); - rootthread = old; - return ((void *)16); /* Different than `15'. */ -} - - static void -test03_aux2 (void *pu, void *pt, qt_userf_t *f) -{ - assert (pu == (void *)1); - assert (f == (qt_userf_t *)4); - QT_ABORT (test03_aux0, (void *)5, (void *)6, rootthread); -} - - static void -test03 (int n) -{ - thread_t *t; - void *rv; - - while (n>0) { - t = t_create (test03_aux2, (void *)1, (qt_userf_t *)4); - rv = QT_BLOCKI (test03_aux1, (void *)5, (void *)6, t->qt); - assert (rv == (void *)15); - t_free (t); - - --n; - } -} - - -static char const test04_msg[] = "stp_start w/ no threads."; - - static void -test04 (int n) -{ - while (n>0) { - stp_init(); stp_start(); - stp_init(); stp_start(); - stp_init(); stp_start(); - stp_init(); stp_start(); - stp_init(); stp_start(); - - stp_init(); stp_start(); - stp_init(); stp_start(); - stp_init(); stp_start(); - stp_init(); stp_start(); - stp_init(); stp_start(); - - n -= 10; - } -} - - -static char const test05_msg[] = "stp w/ 2 yielding thread."; - - static void -test05_aux (void *null) -{ - stp_yield(); - stp_yield(); -} - - static void -test05 (int n) -{ - while (n>0) { - stp_init(); - stp_create (test05_aux, 0); - stp_create (test05_aux, 0); - stp_start(); - - --n; - } -} - - -static char const test06_msg[] = "*QT_ARGS(...), QT_BLOCKI one thread"; - -static char const *test06_descr[] = { - "Does a QT_ARGS, QT_BLOCKI to a helper function that saves the", - "stack pointer of the main thread, calls an `only' function that", - "saves aborts the thread, calling a null helper function.", - ":: start/stop = QT_ARGS + QT_BLOCKI + QT_ABORT + 3 procedure calls.", - NULL -}; - -/* This test initializes a thread, runs it, then returns to the main - program, which reinitializes the thread, runs it again, etc. Each - iteration corresponds to 1 init, 1 abort, 1 block. */ - -static qt_t *test06_sp; - - - static void -test06_aux2 (void *null0a, void *null1b, void *null2b, qt_userf_t *null) -{ - QT_ABORT (t_null, 0, 0, test06_sp); -} - - - static void * -test06_aux3 (qt_t *sp, void *null0c, void *null1c) -{ - test06_sp = sp; - /* return (garbage); */ -} - - - static void -test06 (int n) -{ - thread_t *t; - - t = t_create (0, 0, 0); - - while (n>0) { - /* RETVALUSED */ - QT_ARGS (t->top, 0, 0, 0, test06_aux2); - QT_BLOCKI (test06_aux3, 0, 0, t->qt); -#ifdef NDEF - /* RETVALUSED */ - QT_ARGS (t->top, 0, 0, 0, test06_aux2); - QT_BLOCKI (test06_aux3, 0, 0, t->qt); - - /* RETVALUSED */ - QT_ARGS (t->top, 0, 0, 0, test06_aux2); - QT_BLOCKI (test06_aux3, 0, 0, t->qt); - - /* RETVALUSED */ - QT_ARGS (t->top, 0, 0, 0, test06_aux2); - QT_BLOCKI (test06_aux3, 0, 0, t->qt); - - /* RETVALUSED */ - QT_ARGS (t->top, 0, 0, 0, test06_aux2); - QT_BLOCKI (test06_aux3, 0, 0, t->qt); - - n -= 5; -#else - --n; -#endif - } -} - -static char test07_msg[] = "*cswap between threads"; - -static char const *test07_descr[] = { - "Build a chain of threads where each thread has a fixed successor.", - "There is no scheduling performed. Each thread but one is a loop", - "that simply blocks with QT_BLOCKI, calling a helper that saves the", - "current stack pointer. The last thread decrements a count, and,", - "if zero, aborts back to the main thread. Else it continues with", - "the blocking chain. The count is divided by the number of threads", - "in the chain, so `n' is the number of integer block operations.", - ":: integer cswap = QT_BLOCKI + a procedure call.", - NULL -}; - -/* This test repeatedly blocks a bunch of threads. - Each iteration corresponds to one block operation. - - The threads are arranged so that there are TEST07_N-1 of them that - run `test07_aux2'. Each one of those blocks saving it's sp to - storage owned by the preceding thread; a pointer to that storage is - passed in via `mep'. Each thread has a handle on it's own storage - for the next thread, referenced by `nxtp', and it blocks by passing - control to `*nxtp', telling the helper function to save its state - in `*mep'. The last thread in the chain decrements a count and, if - it's gone below zero, returns to `test07'; otherwise, it invokes - the first thread in the chain. */ - -static qt_t *test07_heavy; - -#define TEST07_N (4) - - - static void -test07_aux2 (void *null0, void *mep, void *nxtp, qt_userf_t *null) -{ - qt_t *nxt; - - while (1) { - nxt = *(qt_t **)nxtp; -#ifdef NDEF - printf ("Helper 0x%p\n", nxtp); -#endif - QT_BLOCKI (t_splat, mep, 0, nxt); - } -} - - static void -test07_aux3 (void *np, void *mep, void *nxtp, qt_userf_t *null) -{ - int n; - - n = *(int *)np; - while (1) { - n -= TEST07_N; - if (n<0) { - QT_ABORT (t_splat, mep, 0, test07_heavy); - } - QT_BLOCKI (t_splat, mep, 0, *(qt_t **)nxtp); - } -} - - - static void -test07 (int n) -{ - int i; - thread_t *t[TEST07_N]; - - for (i=0; i<TEST07_N; ++i) { - t[i] = t_create (0, 0, 0); - } - for (i=0; i<TEST07_N-1; ++i) { - /* RETVALUSED */ - QT_ARGS (t[i]->top, 0, &t[i]->qt, &t[i+1]->qt, test07_aux2); - } - /* RETVALUSED */ - QT_ARGS (t[i]->top, &n, &t[TEST07_N-1]->qt, &t[0]->qt, test07_aux3); - QT_BLOCKI (t_splat, &test07_heavy, 0, t[0]->qt); -} - - -static char test08_msg[] = "Floating-point cswap between threads"; - -static char const *test08_descr[] = { - "Measure context switch times including floating-point, use QT_BLOCK.", - NULL -}; - -static qt_t *test08_heavy; - -#define TEST08_N (4) - - - static void -test08_aux2 (void *null0, void *mep, void *nxtp, qt_userf_t *null) -{ - qt_t *nxt; - - while (1) { - nxt = *(qt_t **)nxtp; - QT_BLOCK (t_splat, mep, 0, nxt); - } -} - - static void -test08_aux3 (void *np, void *mep, void *nxtp, qt_userf_t *null) -{ - int n; - - n = *(int *)np; - while (1) { - n -= TEST08_N; - if (n<0) { - QT_ABORT (t_splat, mep, 0, test08_heavy); - } - QT_BLOCK (t_splat, mep, 0, *(qt_t **)nxtp); - } -} - - - static void -test08 (int n) -{ - int i; - thread_t *t[TEST08_N]; - - for (i=0; i<TEST08_N; ++i) { - t[i] = t_create (0, 0, 0); - } - for (i=0; i<TEST08_N-1; ++i) { - /* RETVALUSED */ - QT_ARGS (t[i]->top, 0, &t[i]->qt, &t[i+1]->qt, test08_aux2); - } - /* RETVALUSED */ - QT_ARGS (t[i]->top, &n, &t[TEST08_N-1]->qt, &t[0]->qt, test08_aux3); - QT_BLOCK (t_splat, &test08_heavy, 0, t[0]->qt); -} - - -/* Test the varargs procedure calling. */ - -char const test09_msg[] = { "Start and run threads using varargs." }; - -thread_t *test09_t0, *test09_t1, *test09_t2, *test09_main; - - thread_t * -test09_create (qt_startup_t *start, qt_vuserf_t *f, - qt_cleanup_t *cleanup, int nbytes, ...) -{ - va_list ap; - thread_t *t; - - t = t_alloc(); - va_start (ap, nbytes); - t->qt = QT_VARGS (t->top, nbytes, ap, t, start, f, cleanup); - va_end (ap); - return (t); -} - - - static void -test09_cleanup (void *pt, void *vuserf_retval) -{ - assert (vuserf_retval == (void *)17); - QT_ABORT (t_splat, &((thread_t *)pt)->qt, 0, - ((thread_t *)pt)->next->qt); -} - - - static void -test09_start (void *pt) -{ -} - - - static void * -test09_user0 (void) -{ - QT_BLOCKI (t_splat, &test09_t0->qt, 0, test09_t1->qt); - return ((void *)17); -} - - static void * -test09_user2 (int one, int two) -{ - assert (one == 1); - assert (two == 2); - QT_BLOCKI (t_splat, &test09_t1->qt, 0, test09_t2->qt); - assert (one == 1); - assert (two == 2); - return ((void *)17); -} - - static void * -test09_user10 (int one, int two, int three, int four, int five, - int six, int seven, int eight, int nine, int ten) -{ - assert (one == 1); - assert (two == 2); - assert (three == 3); - assert (four == 4); - assert (five == 5); - assert (six == 6); - assert (seven == 7); - assert (eight == 8); - assert (nine == 9); - assert (ten == 10); - QT_BLOCKI (t_splat, &test09_t2->qt, 0, test09_main->qt); - assert (one == 1); - assert (two == 2); - assert (three == 3); - assert (four == 4); - assert (five == 5); - assert (six == 6); - assert (seven == 7); - assert (eight == 8); - assert (nine == 9); - assert (ten == 10); - return ((void *)17); -} - - - void -test09 (int n) -{ - thread_t main; - - test09_main = &main; - - while (--n >= 0) { - test09_t0 = test09_create (test09_start, (qt_vuserf_t*)test09_user0, - test09_cleanup, 0); - test09_t1 = test09_create (test09_start, (qt_vuserf_t*)test09_user2, - test09_cleanup, 2 * sizeof(qt_word_t), 1, 2); - test09_t2 = test09_create (test09_start, (qt_vuserf_t*)test09_user10, - test09_cleanup, 10 * sizeof(qt_word_t), - 1, 2, 3, 4, 5, 6, 7, 8, 9, 10); - - /* Chaining used by `test09_cleanup' to determine who is next. */ - test09_t0->next = test09_t1; - test09_t1->next = test09_t2; - test09_t2->next = test09_main; - - QT_BLOCKI (t_splat, &test09_main->qt, 0, test09_t0->qt); - QT_BLOCKI (t_splat, &test09_main->qt, 0, test09_t0->qt); - - t_free (test09_t0); - t_free (test09_t1); - t_free (test09_t2); - } -} - - - /* Test 10/11/12: time the cost of various number of args. */ - -char const test10_msg[] = { "*Test varargs init & startup w/ 0 args." }; - -char const *test10_descr[] = { - "Start and stop threads that use variant argument lists (varargs).", - "Each thread is initialized by calling a routine that calls", - "QT_VARARGS. Then runs the thread by calling QT_BLOCKI to hald the", - "main thread, a helper that saves the main thread's stack pointer,", - "a null startup function, a null user function, a cleanup function", - "that calls QT_ABORT and restarts the main thread. Copies no user", - "parameters.", - ":: varargs start/stop = QT_BLOCKI + QT_ABORT + 6 function calls.", - NULL -}; - -/* Helper function to send control back to main. - Don't save anything. */ - - -/* Helper function for starting the varargs thread. Save the stack - pointer of the main thread so we can get back there eventually. */ - - -/* Startup function for a varargs thread. */ - - static void -test10_startup (void *pt) -{ -} - - -/* User function for a varargs thread. */ - - static void * -test10_run (int arg0, ...) -{ - /* return (garbage); */ -} - - -/* Cleanup function for a varargs thread. Send control - back to the main thread. Don't save any state from the thread that - is halting. */ - - void -test10_cleanup (void *pt, void *vuserf_retval) -{ - QT_ABORT (t_null, 0, 0, ((thread_t *)pt)->qt); -} - - - void -test10_init (thread_t *new, thread_t *next, int nbytes, ...) -{ - va_list ap; - - va_start (ap, nbytes); - new->qt = QT_VARGS (new->top, nbytes, ap, next, test10_startup, - test10_run, test10_cleanup); - va_end (ap); -} - - - void -test10 (int n) -{ - thread_t main; - thread_t *t; - - t = t_alloc(); - t->next = &main; - - while (--n >= 0) { - test10_init (t, &main, 0); - QT_BLOCKI (t_splat, &main.qt, 0, t->qt); - } - t_free (t); -} - - -char const test11_msg[] = { "*Test varargs init & startup w/ 2 args." }; - -char const *test11_descr[] = { - "Varargs initialization/run. Copies 2 user arguments.", - ":: varargs 2 start/stop = QT_VARGS(2 args), QT_BLOCKI, QT_ABORT, 6 f() calls.", - NULL -}; - - - void -test11 (int n) -{ - thread_t main; - thread_t *t; - - t = t_alloc(); - t->next = &main; - - while (--n >= 0) { - test10_init (t, &main, 2 * sizeof(int), 2, 1); - QT_BLOCKI (t_splat, &main.qt, 0, t->qt); - } - t_free (t); -} - -char const test12_msg[] = { "*Test varargs init & startup w/ 4 args." }; - -char const *test12_descr[] = { - "Varargs initialization/run. Copies 4 user arguments.", - ":: varargs 4 start/stop = QT_VARGS(4 args), QT_BLOCKI, QT_ABORT, 6 f() calls.", - NULL -}; - - - void -test12 (int n) -{ - thread_t main; - thread_t *t; - - t = t_alloc(); - t->next = &main; - - while (--n >= 0) { - test10_init (t, &main, 4 * sizeof(int), 4, 3, 2, 1); - QT_BLOCKI (t_splat, &main.qt, 0, t->qt); - } - t_free (t); -} - - -char const test13_msg[] = { "*Test varargs init & startup w/ 8 args." }; - -char const *test13_descr[] = { - "Varargs initialization/run. Copies 8 user arguments.", - ":: varargs 8 start/stop = QT_VARGS(8 args), QT_BLOCKI, QT_ABORT, 6 f() calls.", - NULL -}; - - void -test13 (int n) -{ - thread_t main; - thread_t *t; - - t = t_alloc(); - t->next = &main; - - while (--n >= 0) { - test10_init (t, &main, 8 * sizeof(int), 8, 7, 6, 5, 4, 3, 2, 1); - QT_BLOCKI (t_splat, &main.qt, 0, t->qt); - } - t_free (t); -} - - -char const test14_msg[] = { "*Test varargs initialization w/ 0 args." }; - -char const *test14_descr[] = { - "Varargs initialization without running the thread. Just calls", - "QT_VARGS.", - ":: varargs 0 init = QT_VARGS()", - NULL -}; - - void -test14 (int n) -{ - thread_t main; - thread_t *t; - - t = t_alloc(); - t->next = &main; - - while (--n >= 0) { - test10_init (t, &main, 0 * sizeof(int)); - } - t_free (t); -} - - -char const test15_msg[] = { "*Test varargs initialization w/ 2 args." }; - -char const *test15_descr[] = { - "Varargs initialization without running the thread. Just calls", - "QT_VARGS.", - ":: varargs 2 init = QT_VARGS(2 args)", - NULL -}; - - void -test15 (int n) -{ - thread_t main; - thread_t *t; - - t = t_alloc(); - t->next = &main; - - while (--n >= 0) { - test10_init (t, &main, 2 * sizeof(int), 2, 1); - } - t_free (t); -} - -char const test16_msg[] = { "*Test varargs initialization w/ 4 args." }; - -char const *test16_descr[] = { - "Varargs initialization without running the thread. Just calls", - "QT_VARGS.", - ":: varargs 4 init = QT_VARGS(4 args)", - NULL -}; - - - void -test16 (int n) -{ - thread_t main; - thread_t *t; - - t = t_alloc(); - t->next = &main; - - while (--n >= 0) { - test10_init (t, &main, 4 * sizeof(int), 4, 3, 2, 1); - } - t_free (t); -} - - -char const test17_msg[] = { "*Test varargs initialization w/ 8 args." }; - -char const *test17_descr[] = { - "Varargs initialization without running the thread. Just calls", - "QT_VARGS.", - ":: varargs 8 init = QT_VARGS(8 args)", - NULL -}; - - - void -test17 (int n) -{ - thread_t main; - thread_t *t; - - t = t_alloc(); - t->next = &main; - - while (--n >= 0) { - test10_init (t, &main, 8 * sizeof(int), 8, 7, 6, 5, 4, 3, 2, 1); - } - t_free (t); -} - - /* Test times for basic machine operations. */ - -char const test18_msg[] = { "*Call register indirect." }; -char const *test18_descr[] = { NULL }; - - void -test18 (int n) -{ - b_call_reg (n); -} - - -char const test19_msg[] = { "*Call immediate." }; -char const *test19_descr[] = { NULL }; - - void -test19 (int n) -{ - b_call_imm (n); -} - - -char const test20_msg[] = { "*Add register-to-register." }; -char const *test20_descr[] = { NULL }; - - void -test20 (int n) -{ - b_add (n); -} - - -char const test21_msg[] = { "*Load memory to a register." }; -char const *test21_descr[] = { NULL }; - - void -test21 (int n) -{ - b_load (n); -} - - /* Driver. */ - -typedef struct foo_t { - char const *msg; /* Message to print for generic help. */ - char const **descr; /* A description of what is done by the test. */ - void (*f)(int n); -} foo_t; - - -static foo_t foo[] = { - { "Usage:\n", NULL, (void(*)(int n))usage }, - { test01_msg, test01_descr, test01 }, - { test02_msg, NULL, test02 }, - { test03_msg, NULL, test03 }, - { test04_msg, NULL, test04 }, - { test05_msg, NULL, test05 }, - { test06_msg, test06_descr, test06 }, - { test07_msg, test07_descr, test07 }, - { test08_msg, test08_descr, test08 }, - { test09_msg, NULL, test09 }, - { test10_msg, test10_descr, test10 }, - { test11_msg, test11_descr, test11 }, - { test12_msg, test12_descr, test12 }, - { test13_msg, test13_descr, test13 }, - { test14_msg, test14_descr, test14 }, - { test15_msg, test15_descr, test15 }, - { test16_msg, test16_descr, test16 }, - { test17_msg, test17_descr, test17 }, - { test18_msg, test18_descr, test18 }, - { test19_msg, test19_descr, test19 }, - { test20_msg, test20_descr, test20 }, - { test21_msg, test21_descr, test21 }, - { 0, 0 } -}; - -static int tv = 0; - - void -tracer () -{ - - fprintf (stderr, "tracer\t%d\n", tv++); - fflush (stderr); -} - - void -tracer2 (void *val) -{ - fprintf (stderr, "tracer2\t%d val=0x%p", tv++, val); - fflush (stderr); -} - - - void -describe() -{ - int i; - FILE *out = stdout; - - for (i=0; foo[i].msg; ++i) { - if (foo[i].descr) { - int j; - - putc ('\n', out); - fprintf (out, "[%d]\n", i); - for (j=0; foo[i].descr[j]; ++j) { - fputs (foo[i].descr[j], out); - putc ('\n', out); - } - } - } - exit (0); -} - - - void -usage() -{ - int i; - - fputs (foo[0].msg, stderr); - for (i=1; foo[i].msg; ++i) { - fprintf (stderr, "%2d\t%s\n", i, foo[i].msg); - } - exit (1); -} - - - void -args (int *which, int *n, int argc, char **argv) -{ - static int nfuncs = 0; - - if (argc == 2 && argv[1][0] == '-' && argv[1][1] == 'h') { - describe(); - } - - if (nfuncs == 0) { - for (nfuncs=0; foo[nfuncs].msg; ++nfuncs) - ; - } - - if (argc != 2 && argc != 3) { - usage(); - } - - *which = atoi (argv[1]); - if (*which < 0 || *which >= nfuncs) { - usage(); - } - *n = (argc == 3) - ? atoi (argv[2]) - : 1; -} - - - int -main (int argc, char **argv) -{ - int which, n; - args (&which, &n, argc, argv); - (*(foo[which].f))(n); - exit (0); - return (0); -} diff --git a/qt/qt.c b/qt/qt.c deleted file mode 100644 index 1e406d24c..000000000 --- a/qt/qt.c +++ /dev/null @@ -1,48 +0,0 @@ -#include "copyright.h" -#include "qt.h" - -#ifdef QT_VARGS_DEFAULT - -/* If the stack grows down, `vargs' is a pointer to the lowest - address in the block of arguments. If the stack grows up, it is a - pointer to the highest address in the block. */ - - qt_t * -qt_vargs (qt_t *sp, int nbytes, void *vargs, - void *pt, qt_startup_t *startup, - qt_vuserf_t *vuserf, qt_cleanup_t *cleanup) -{ - int i; - - sp = QT_VARGS_MD0 (sp, nbytes); -#ifdef QT_GROW_UP - for (i=nbytes/sizeof(qt_word_t); i>0; --i) { - QT_SPUT (QT_VARGS_ADJUST(sp), i, ((qt_word_t *)vargs)[-i]); - } -#else - for (i=nbytes/sizeof(qt_word_t); i>0; --i) { - QT_SPUT (QT_VARGS_ADJUST(sp), i-1, ((qt_word_t *)vargs)[i-1]); - } -#endif - - QT_VARGS_MD1 (QT_VADJ(sp)); - QT_SPUT (QT_VADJ(sp), QT_VARGT_INDEX, pt); - QT_SPUT (QT_VADJ(sp), QT_VSTARTUP_INDEX, startup); - QT_SPUT (QT_VADJ(sp), QT_VUSERF_INDEX, vuserf); - QT_SPUT (QT_VADJ(sp), QT_VCLEANUP_INDEX, cleanup); - return ((qt_t *)QT_VADJ(sp)); -} -#endif /* def QT_VARGS_DEFAULT */ - - void -qt_null (void) -{ -} - - void -qt_error (void) -{ - extern void abort(void); - - abort(); -} diff --git a/qt/qt.h.in b/qt/qt.h.in deleted file mode 100644 index da45ff8e5..000000000 --- a/qt/qt.h.in +++ /dev/null @@ -1,178 +0,0 @@ -#ifndef QT_H -#define QT_H - -#ifdef __cplusplus -extern "C" { -#endif - -#include <@qtmd_h@> - - -/* A QuickThreads thread is represented by it's current stack pointer. - To restart a thread, you merely need pass the current sp (qt_t*) to - a QuickThreads primitive. `qt_t*' is a location on the stack. To - improve type checking, represent it by a particular struct. */ - -typedef struct qt_t { - char dummy; -} qt_t; - - -/* Alignment is guaranteed to be a power of two. */ -#ifndef QT_STKALIGN - #error "Need to know the machine-dependent stack alignment." -#endif - -#define QT_STKROUNDUP(bytes) \ - (((bytes)+QT_STKALIGN) & ~(QT_STKALIGN-1)) - - -/* Find ``top'' of the stack, space on the stack. */ -#ifndef QT_SP -#ifdef QT_GROW_DOWN -#define QT_SP(sto, size) ((qt_t *)(&((char *)(sto))[(size)])) -#endif -#ifdef QT_GROW_UP -#define QT_SP(sto, size) ((void *)(sto)) -#endif -#if !defined(QT_SP) - #error "QT_H: Stack must grow up or down!" -#endif -#endif - - -/* The type of the user function: - For non-varargs, takes one void* function. - For varargs, takes some number of arguments. */ -typedef void *(qt_userf_t)(void *pu); -typedef void *(qt_vuserf_t)(int arg0, ...); - -/* For non-varargs, just call a client-supplied function, - it does all startup and cleanup, and also calls the user's - function. */ -typedef void (qt_only_t)(void *pu, void *pt, qt_userf_t *userf); - -/* For varargs, call `startup', then call the user's function, - then call `cleanup'. */ -typedef void (qt_startup_t)(void *pt); -typedef void (qt_cleanup_t)(void *pt, void *vuserf_return); - - -/* Internal helper for putting stuff on stack. */ -#ifndef QT_SPUT -#define QT_SPUT(top, at, val) \ - (((qt_word_t *)(top))[(at)] = (qt_word_t)(val)) -#endif - - -/* Push arguments for the non-varargs case. */ -#ifndef QT_ARGS - -#ifndef QT_ARGS_MD -#define QT_ARGS_MD (0) -#endif - -#ifndef QT_STKBASE - #error "Need to know the machine-dependent stack allocation." -#endif - -/* All things are put on the stack relative to the final value of - the stack pointer. */ -#ifdef QT_GROW_DOWN -#define QT_ADJ(sp) (((char *)sp) - QT_STKBASE) -#else -#define QT_ADJ(sp) (((char *)sp) + QT_STKBASE) -#endif - -#define QT_ARGS(sp, pu, pt, userf, only) \ - (QT_ARGS_MD (QT_ADJ(sp)), \ - QT_SPUT (QT_ADJ(sp), QT_ONLY_INDEX, only), \ - QT_SPUT (QT_ADJ(sp), QT_USER_INDEX, userf), \ - QT_SPUT (QT_ADJ(sp), QT_ARGT_INDEX, pt), \ - QT_SPUT (QT_ADJ(sp), QT_ARGU_INDEX, pu), \ - ((qt_t *)QT_ADJ(sp))) - -#endif - - -/* Push arguments for the varargs case. - Has to be a function call because initialization is an expression - and we need to loop to copy nbytes of stuff on to the stack. - But that's probably OK, it's not terribly cheap, anyway. */ - -#ifdef QT_VARGS_DEFAULT -#ifndef QT_VARGS_MD0 -#define QT_VARGS_MD0(sp, vasize) (sp) -#endif -#ifndef QT_VARGS_MD1 -#define QT_VARGS_MD1(sp) do { ; } while (0) -#endif - -#ifndef QT_VSTKBASE - #error "Need base stack size for varargs functions." -#endif - -/* Sometimes the stack pointer needs to munged a bit when storing - the list of arguments. */ -#ifndef QT_VARGS_ADJUST -#define QT_VARGS_ADJUST(sp) (sp) -#endif - -/* All things are put on the stack relative to the final value of - the stack pointer. */ -#ifdef QT_GROW_DOWN -#define QT_VADJ(sp) (((char *)sp) - QT_VSTKBASE) -#else -#define QT_VADJ(sp) (((char *)sp) + QT_VSTKBASE) -#endif - -extern qt_t *qt_vargs (qt_t *sp, int nbytes, void *vargs, - void *pt, qt_startup_t *startup, - qt_vuserf_t *vuserf, qt_cleanup_t *cleanup); - -#ifndef QT_VARGS -#define QT_VARGS(sp, nbytes, vargs, pt, startup, vuserf, cleanup) \ - (qt_vargs (sp, nbytes, vargs, pt, startup, vuserf, cleanup)) -#endif - -#endif - -extern void qt_null (void); -extern void qt_error (void); - -/* Save the state of the thread and call the helper function - using the stack of the new thread. */ -typedef void *(qt_helper_t)(qt_t *old, void *a0, void *a1); -typedef void *(qt_block_t)(qt_helper_t *helper, void *a0, void *a1, - qt_t *newthread); - -/* Rearrange the parameters so that things passed to the helper - function are already in the right argument registers. */ -#ifndef QT_ABORT -extern void qt_abort (qt_helper_t *h, void *a0, void *a1, qt_t *newthread); -/* The following does, technically, `return' a value, but the - user had better not rely on it, since the function never - returns. */ -#define QT_ABORT(h, a0, a1, newthread) \ - do { qt_abort (h, a0, a1, newthread); } while (0) -#endif - -#ifndef QT_BLOCK -extern void *qt_block (qt_helper_t *h, void *a0, void *a1, - qt_t *newthread); -#define QT_BLOCK(h, a0, a1, newthread) \ - (qt_block (h, a0, a1, newthread)) -#endif - -#ifndef QT_BLOCKI -extern void *qt_blocki (qt_helper_t *h, void *a0, void *a1, - qt_t *newthread); -#define QT_BLOCKI(h, a0, a1, newthread) \ - (qt_blocki (h, a0, a1, newthread)) -#endif - -#ifdef __cplusplus -} /* Match `extern "C" {' at top. */ -#endif - -#endif /* ndef QT_H */ diff --git a/qt/stp.c b/qt/stp.c deleted file mode 100644 index bfacc893b..000000000 --- a/qt/stp.c +++ /dev/null @@ -1,199 +0,0 @@ -#include "copyright.h" -#include "qt.h" -#include "stp.h" - -#ifndef NULL -#define NULL 0 -#endif - -#define STP_STKSIZE (0x1000) - -/* `alignment' must be a power of 2. */ -#define STP_STKALIGN(sp, alignment) \ - ((void *)((((qt_word_t)(sp)) + (alignment) - 1) & ~((alignment)-1))) - - -/* 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 stp_t { - qt_t *sp; /* QuickThreads handle. */ - void *sto; /* `malloc'-allocated stack. */ - struct stp_t *next; /* Next thread in the queue. */ -}; - - -/* 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 stp_q_t { - stp_t t; - stp_t *tail; -} stp_q_t; - - - /* Helper functions. */ - -extern void *malloc (unsigned size); -extern void perror (char const *msg); -extern void free (void *sto); - - void * -xmalloc (unsigned size) -{ - void *sto; - - sto = malloc (size); - if (!sto) { - perror ("malloc"); - exit (1); - } - return (sto); -} - - /* Queue access functions. */ - - static void -stp_qinit (stp_q_t *q) -{ - q->t.next = q->tail = &q->t; -} - - - static stp_t * -stp_qget (stp_q_t *q) -{ - stp_t *t; - - t = q->t.next; - q->t.next = t->next; - if (t->next == &q->t) { - if (t == &q->t) { /* If it was already empty .. */ - return (NULL); /* .. say so. */ - } - q->tail = &q->t; /* Else now it is empty. */ - } - return (t); -} - - - static void -stp_qput (stp_q_t *q, stp_t *t) -{ - q->tail->next = t; - t->next = &q->t; - q->tail = t; -} - - - /* Thread routines. */ - -static stp_q_t stp_global_runq; /* A queue of runable threads. */ -static stp_t stp_global_main; /* Thread for the process. */ -static stp_t *stp_global_curr; /* Currently-executing thread. */ - -static void *stp_starthelp (qt_t *old, void *ignore0, void *ignore1); -static void stp_only (void *pu, void *pt, qt_userf_t *f); -static void *stp_aborthelp (qt_t *sp, void *old, void *null); -static void *stp_yieldhelp (qt_t *sp, void *old, void *blockq); - - - void -stp_init() -{ - stp_qinit (&stp_global_runq); -} - - - void -stp_start() -{ - stp_t *next; - - while ((next = stp_qget (&stp_global_runq)) != NULL) { - stp_global_curr = next; - QT_BLOCK (stp_starthelp, 0, 0, next->sp); - } -} - - - static void * -stp_starthelp (qt_t *old, void *ignore0, void *ignore1) -{ - stp_global_main.sp = old; - stp_qput (&stp_global_runq, &stp_global_main); - /* return (garbage); */ -} - - - void -stp_create (stp_userf_t *f, void *pu) -{ - stp_t *t; - void *sto; - - t = xmalloc (sizeof(stp_t)); - t->sto = xmalloc (STP_STKSIZE); - sto = STP_STKALIGN (t->sto, QT_STKALIGN); - t->sp = QT_SP (sto, STP_STKSIZE - QT_STKALIGN); - t->sp = QT_ARGS (t->sp, pu, t, (qt_userf_t *)f, stp_only); - stp_qput (&stp_global_runq, t); -} - - - static void -stp_only (void *pu, void *pt, qt_userf_t *f) -{ - stp_global_curr = (stp_t *)pt; - (*(stp_userf_t *)f)(pu); - stp_abort(); - /* NOTREACHED */ -} - - - void -stp_abort (void) -{ - stp_t *old, *newthread; - - newthread = stp_qget (&stp_global_runq); - old = stp_global_curr; - stp_global_curr = newthread; - QT_ABORT (stp_aborthelp, old, (void *)NULL, newthread->sp); -} - - - static void * -stp_aborthelp (qt_t *sp, void *old, void *null) -{ - free (((stp_t *)old)->sto); - free (old); - /* return (garbage); */ -} - - - void -stp_yield() -{ - stp_t *old, *newthread; - - newthread = stp_qget (&stp_global_runq); - old = stp_global_curr; - stp_global_curr = newthread; - QT_BLOCK (stp_yieldhelp, old, &stp_global_runq, newthread->sp); -} - - - static void * -stp_yieldhelp (qt_t *sp, void *old, void *blockq) -{ - ((stp_t *)old)->sp = sp; - stp_qput ((stp_q_t *)blockq, (stp_t *)old); - /* return (garbage); */ -} diff --git a/qt/stp.h b/qt/stp.h deleted file mode 100644 index f786f048d..000000000 --- a/qt/stp.h +++ /dev/null @@ -1,51 +0,0 @@ -#ifndef STP_H -#define STP_H - -/* - * 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. - */ - -typedef struct stp_t stp_t; - -/* Each thread starts by calling a user-supplied function of this - type. */ - -typedef void (stp_userf_t)(void *p0); - -/* Call this before any other primitives. */ -extern void stp_init(); - -/* When one or more threads are created by the main thread, - the system goes multithread when this is called. It is done - (no more runable threads) when this returns. */ - -extern void stp_start (void); - -/* Create a thread and make it runable. When the thread starts - running it will call `f' with the argument `p0'. */ - -extern void stp_create (stp_userf_t *f, void *p0); - -/* The current thread stops running but stays runable. - It is an error to call `stp_yield' before `stp_start' - is called or after `stp_start' returns. */ - -extern void stp_yield (void); - -/* Like `stp_yield' but the thread is discarded. Any intermediate - state is lost. The thread can also terminate by simply - returning. */ - -extern void stp_abort (void); - - -#endif /* ndef STP_H */ diff --git a/qt/time/.cvsignore b/qt/time/.cvsignore deleted file mode 100644 index f3c7a7c5d..000000000 --- a/qt/time/.cvsignore +++ /dev/null @@ -1 +0,0 @@ -Makefile diff --git a/qt/time/Makefile.am b/qt/time/Makefile.am deleted file mode 100644 index d56f14496..000000000 --- a/qt/time/Makefile.am +++ /dev/null @@ -1,5 +0,0 @@ -## Process this file with automake to produce Makefile.in. - -AUTOMAKE_OPTIONS = foreign - -EXTRA_DIST = README.time assim cswap go init prim raw diff --git a/qt/time/Makefile.in b/qt/time/Makefile.in deleted file mode 100644 index 4df1b4c8e..000000000 --- a/qt/time/Makefile.in +++ /dev/null @@ -1,188 +0,0 @@ -# Makefile.in generated automatically by automake 1.3 from Makefile.am - -# Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc. -# This Makefile.in 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 program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - - -SHELL = /bin/sh - -srcdir = @srcdir@ -top_srcdir = @top_srcdir@ -VPATH = @srcdir@ -prefix = @prefix@ -exec_prefix = @exec_prefix@ - -bindir = @bindir@ -sbindir = @sbindir@ -libexecdir = @libexecdir@ -datadir = @datadir@ -sysconfdir = @sysconfdir@ -sharedstatedir = @sharedstatedir@ -localstatedir = @localstatedir@ -libdir = @libdir@ -infodir = @infodir@ -mandir = @mandir@ -includedir = @includedir@ -oldincludedir = /usr/include - -DISTDIR = - -pkgdatadir = $(datadir)/@PACKAGE@ -pkglibdir = $(libdir)/@PACKAGE@ -pkgincludedir = $(includedir)/@PACKAGE@ - -top_builddir = ../.. - -ACLOCAL = @ACLOCAL@ -AUTOCONF = @AUTOCONF@ -AUTOMAKE = @AUTOMAKE@ -AUTOHEADER = @AUTOHEADER@ - -INSTALL = @INSTALL@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_DATA = @INSTALL_DATA@ -INSTALL_SCRIPT = @INSTALL_SCRIPT@ -transform = @program_transform_name@ - -NORMAL_INSTALL = : -PRE_INSTALL = : -POST_INSTALL = : -NORMAL_UNINSTALL = : -PRE_UNINSTALL = : -POST_UNINSTALL = : -host_alias = @host_alias@ -host_triplet = @host@ -AWK = @AWK@ -CC = @CC@ -CPP = @CPP@ -GUILE_LIBS = @GUILE_LIBS@ -GUILE_MAJOR_VERSION = @GUILE_MAJOR_VERSION@ -GUILE_MINOR_VERSION = @GUILE_MINOR_VERSION@ -GUILE_STAMP = @GUILE_STAMP@ -GUILE_VERSION = @GUILE_VERSION@ -LD = @LD@ -LIBLOBJS = @LIBLOBJS@ -LIBTOOL = @LIBTOOL@ -LN_S = @LN_S@ -MAINT = @MAINT@ -MAKEINFO = @MAKEINFO@ -NM = @NM@ -PACKAGE = @PACKAGE@ -QTHREAD_LTLIBS = @QTHREAD_LTLIBS@ -RANLIB = @RANLIB@ -THREAD_CPPFLAGS = @THREAD_CPPFLAGS@ -THREAD_LIBS_INSTALLED = @THREAD_LIBS_INSTALLED@ -THREAD_LIBS_LOCAL = @THREAD_LIBS_LOCAL@ -THREAD_PACKAGE = @THREAD_PACKAGE@ -VERSION = @VERSION@ -qtdmdb_s = @qtdmdb_s@ -qtmd_h = @qtmd_h@ -qtmdc_c = @qtmdc_c@ -qtmds_s = @qtmds_s@ - -AUTOMAKE_OPTIONS = foreign - -EXTRA_DIST = README.time assim cswap go init prim raw -mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs -CONFIG_HEADER = ../../libguile/scmconfig.h -CONFIG_CLEAN_FILES = -DIST_COMMON = Makefile.am Makefile.in - - -DISTFILES = $(DIST_COMMON) $(SOURCES) $(HEADERS) $(TEXINFOS) $(EXTRA_DIST) - -TAR = tar -GZIP = --best -all: Makefile - -.SUFFIXES: -$(srcdir)/Makefile.in: @MAINT@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) - cd $(top_srcdir) && $(AUTOMAKE) --foreign qt/time/Makefile - -Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status $(BUILT_SOURCES) - cd $(top_builddir) \ - && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status - -tags: TAGS -TAGS: - - -distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir) - -subdir = qt/time - -distdir: $(DISTFILES) - here=`cd $(top_builddir) && pwd`; \ - top_distdir=`cd $(top_distdir) && pwd`; \ - distdir=`cd $(distdir) && pwd`; \ - cd $(top_srcdir) \ - && $(AUTOMAKE) --include-deps --build-dir=$$here --srcdir-name=$(top_srcdir) --output-dir=$$top_distdir --foreign qt/time/Makefile - @for file in $(DISTFILES); do \ - d=$(srcdir); \ - test -f $(distdir)/$$file \ - || ln $$d/$$file $(distdir)/$$file 2> /dev/null \ - || cp -p $$d/$$file $(distdir)/$$file; \ - done -info: -dvi: -check: all - $(MAKE) -installcheck: -install-exec: - @$(NORMAL_INSTALL) - -install-data: - @$(NORMAL_INSTALL) - -install: install-exec install-data all - @: - -uninstall: - -install-strip: - $(MAKE) INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' INSTALL_SCRIPT='$(INSTALL_PROGRAM)' install -installdirs: - - -mostlyclean-generic: - -test -z "$(MOSTLYCLEANFILES)" || rm -f $(MOSTLYCLEANFILES) - -clean-generic: - -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) - -distclean-generic: - -rm -f Makefile $(DISTCLEANFILES) - -rm -f config.cache config.log stamp-h stamp-h[0-9]* - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -maintainer-clean-generic: - -test -z "$(MAINTAINERCLEANFILES)" || rm -f $(MAINTAINERCLEANFILES) - -test -z "$(BUILT_SOURCES)" || rm -f $(BUILT_SOURCES) -mostlyclean: mostlyclean-generic - -clean: clean-generic mostlyclean - -distclean: distclean-generic clean - -rm -f config.status - -rm -f libtool - -maintainer-clean: maintainer-clean-generic distclean - @echo "This command is intended for maintainers to use;" - @echo "it deletes files that may require special tools to rebuild." - -.PHONY: tags distdir info dvi installcheck install-exec install-data \ -install uninstall all installdirs mostlyclean-generic distclean-generic \ -clean-generic maintainer-clean-generic clean mostlyclean distclean \ -maintainer-clean - - -# Tell versions [3.59,3.63) of GNU make to not export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: diff --git a/qt/time/README.time b/qt/time/README.time deleted file mode 100644 index 4bb190e18..000000000 --- a/qt/time/README.time +++ /dev/null @@ -1,17 +0,0 @@ -The program `raw', when run in `..' runs the program `run' produced -from `meas.c'. It produces a raw output file (see `../tmp/*.raw'). -`raw' will die with an error if run in the current directory. Note -that some versions of `time' produce output in an unexpected format; -edit them by hand. - -`prim', `init', `cswap' and `go' produce formatted table entries used -in the documentation (in `../doc'). For example, from `..', - - foreach i (tmp/*.raw) - time/prim $i - end - -See notes in the QuickThreads document about the applicability of -these microbenchmark measurements -- in general, you can expect all -QuickThreads operations to be a bit slower when used in a real -application. diff --git a/qt/time/assim b/qt/time/assim deleted file mode 100755 index 6c4c52183..000000000 --- a/qt/time/assim +++ /dev/null @@ -1,42 +0,0 @@ -#! /bin/awk -f - -BEGIN { - nmach = 0; - - init_test = "1"; - abort_test = "6"; - blocki_test = "7"; - block_test = "8"; -} - -{ - mach = $1 - test = $2 - iter = $3 - time = $6 + $8 - - if (machi[mach] == 0) { - machn[nmach] = mach; - machi[mach] = 1; - ++nmach; - } - - us_per_op = time / iter * 1000000 - times[mach "_" test] = us_per_op; -} - - -END { - for (i=0; i<nmach; ++i) { - m = machn[i]; - init = times[m "_" init_test]; - printf ("init %s | %f\n", m, init); - - init_abort_blocki = times[m "_" abort_test]; - abort_blocki = init_abort_blocki - init; - blocki = times[m "_" blocki_test]; - abort = abort_blocki - blocki; - blockf = times[m "_" block_test]; - printf ("swap %s | %f | %f | %f\n", m, abort, blocki, blockf); - } -} diff --git a/qt/time/cswap b/qt/time/cswap deleted file mode 100755 index 0ec811bcd..000000000 --- a/qt/time/cswap +++ /dev/null @@ -1,37 +0,0 @@ -#! /bin/awk -f - -BEGIN { - purpose = "report time used by int only and int+fp cswaps"; - - nmach = 0; - - test_int = "7"; - test_fp = "8"; -} - -{ - mach = $1 - test = $2 - iter = $3 - time = $6 + $8 - - if (machi[mach] == 0) { - machn[nmach] = mach; - machi[mach] = 1; - ++nmach; - } - - us_per_op = time / iter * 1000000 - times[mach "_" test] = us_per_op; -} - - -END { - for (i=0; i<nmach; ++i) { - m = machn[i]; - - integer = times[m "_" test_int]; - fp = times[m "_" test_fp]; - printf ("%s|%3.1f|%3.1f\n", m, integer, fp); - } -} diff --git a/qt/time/go b/qt/time/go deleted file mode 100755 index 489d53882..000000000 --- a/qt/time/go +++ /dev/null @@ -1,43 +0,0 @@ -#! /bin/awk -f - -BEGIN { - purpose = "report times used for init/start/stop"; - - nmach = 0; - - test_single = "6"; - test_v0 = "10"; - test_v2 = "11"; - test_v4 = "12"; - test_v8 = "13"; -} - -{ - mach = $1 - test = $2 - iter = $3 - time = $6 + $8 - - if (machi[mach] == 0) { - machn[nmach] = mach; - machi[mach] = 1; - ++nmach; - } - - us_per_op = time / iter * 1000000 - times[mach "_" test] = us_per_op; -} - - -END { - for (i=0; i<nmach; ++i) { - m = machn[i]; - - single = times[m "_" test_single]; - v0 = times[m "_" test_v0]; - v2 = times[m "_" test_v2]; - v4 = times[m "_" test_v4]; - v8 = times[m "_" test_v8]; - printf ("%s|%3.1f|%3.1f|%3.1f|%3.1f|%3.1f\n", m, single, v0, v2, v4, v8); - } -} diff --git a/qt/time/init b/qt/time/init deleted file mode 100755 index 8bcbf3428..000000000 --- a/qt/time/init +++ /dev/null @@ -1,42 +0,0 @@ -#! /bin/awk -f - -BEGIN { - purpose = "Report time used to initialize a thread." - nmach = 0; - - test_single = "1"; - test_v0 = "14"; - test_v2 = "15"; - test_v4 = "16"; - test_v8 = "17"; -} - -{ - mach = $1 - test = $2 - iter = $3 - time = $6 + $8 - - if (machi[mach] == 0) { - machn[nmach] = mach; - machi[mach] = 1; - ++nmach; - } - - us_per_op = time / iter * 1000000 - times[mach "_" test] = us_per_op; -} - - -END { - for (i=0; i<nmach; ++i) { - m = machn[i]; - - single = times[m "_" test_single]; - v0 = times[m "_" test_v0]; - v2 = times[m "_" test_v2]; - v4 = times[m "_" test_v4]; - v8 = times[m "_" test_v8]; - printf ("%s|%3.1f|%3.1f|%3.1f|%3.1f|%3.1f\n", m, single, v0, v2, v4, v8); - } -} diff --git a/qt/time/prim b/qt/time/prim deleted file mode 100755 index 22b323f6f..000000000 --- a/qt/time/prim +++ /dev/null @@ -1,41 +0,0 @@ -#! /bin/awk -f - -BEGIN { - purpose = "report times for microbenchmarks" - - nmach = 0; - - test_callind = "18"; - test_callimm = "18"; - test_addreg = "20"; - test_loadreg = "21"; -} - -{ - mach = $1 - test = $2 - iter = $3 - time = $6 + $8 - - if (machi[mach] == 0) { - machn[nmach] = mach; - machi[mach] = 1; - ++nmach; - } - - ns_per_op = time / iter * 1000000 - times[mach "_" test] = ns_per_op; -} - - -END { - for (i=0; i<nmach; ++i) { - m = machn[i]; - - ind = times[m "_" test_callind]; - imm = times[m "_" test_callimm]; - add = times[m "_" test_addreg]; - load = times[m "_" test_loadreg]; - printf ("%s|%1.3f|%1.3f|%1.3f|%1.3f\n", m, ind, imm, add, load); - } -} diff --git a/qt/time/raw b/qt/time/raw deleted file mode 100755 index 96ae10ad1..000000000 --- a/qt/time/raw +++ /dev/null @@ -1,58 +0,0 @@ -#! /bin/csh - -rm -f timed - -set init=1 -set runone=6 -set blockint=7 -set blockfloat=8 -set vainit0=14 -set vainit2=15 -set vainit4=16 -set vainit8=17 -set vastart0=10 -set vastart2=11 -set vastart4=12 -set vastart8=13 -set bench_regcall=18 -set bench_immcall=19 -set bench_add=20 -set bench_load=21 - -source configuration - -echo -n $config_machine $init $config_init -/bin/time run $init $config_init -echo -n $config_machine $runone $config_runone -/bin/time run $runone $config_runone -echo -n $config_machine $blockint $config_blockint -/bin/time run $blockint $config_blockint -echo -n $config_machine $blockfloat $config_blockfloat -/bin/time run $blockfloat $config_blockfloat - -echo -n $config_machine $vainit0 $config_vainit0 -/bin/time run $vainit0 $config_vainit0 -echo -n $config_machine $vainit2 $config_vainit2 -/bin/time run $vainit2 $config_vainit2 -echo -n $config_machine $vainit4 $config_vainit4 -/bin/time run $vainit4 $config_vainit4 -echo -n $config_machine $vainit8 $config_vainit8 -/bin/time run $vainit8 $config_vainit8 - -echo -n $config_machine $vastart0 $config_vastart0 -/bin/time run $vastart0 $config_vastart0 -echo -n $config_machine $vastart2 $config_vastart2 -/bin/time run $vastart2 $config_vastart2 -echo -n $config_machine $vastart4 $config_vastart4 -/bin/time run $vastart4 $config_vastart4 -echo -n $config_machine $vastart8 $config_vastart8 -/bin/time run $vastart8 $config_vastart8 - -echo -n $config_machine $bench_regcall $config_bcall_reg -/bin/time run $bench_regcall $config_bcall_reg -echo -n $config_machine $bench_immcall $config_bcall_imm -/bin/time run $bench_immcall $config_bcall_imm -echo -n $config_machine $bench_add $config_b_add -/bin/time run $bench_add $config_b_add -echo -n $config_machine $bench_load $config_b_load -/bin/time run $bench_load $config_b_load diff --git a/qthreads.m4 b/qthreads.m4 deleted file mode 100644 index ca8b4a806..000000000 --- a/qthreads.m4 +++ /dev/null @@ -1,125 +0,0 @@ -dnl Autoconf macros for configuring the QuickThreads package - -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 --- the name of the machine-dependent header file. -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_CPPFLAGS --- set to `-I' flags for thread header files -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, qtmdc_lo 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) - # How can we refer to the qt source directory from within the qt build - # directory? For headers, we can rely on the fact that the qt src - # directory appears in the #include path. - qtsrcdir="`(cd $srcdir; pwd)`/qt" - - changequote(,)dnl We use [ and ] in a regexp in the case - - THREAD_PACKAGE=QT - 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= - ;; - 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 - ;; - *) - 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_CPPFLAGS="-I$qtsrcdir -I../qt" - 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(THREAD_PACKAGE) - AC_SUBST(THREAD_CPPFLAGS) - AC_SUBST(THREAD_LIBS_LOCAL) - AC_SUBST(THREAD_LIBS_INSTALLED) -]) |